home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume32 / oraperl-v2 / patch02 next >
Text File  |  1992-10-06  |  26KB  |  879 lines

  1. Newsgroups: comp.sources.misc
  2. From: Kevin Stock <kstock@encore.com>
  3. Subject:  v32i093:  oraperl-v2 - Extensions to Perl to access Oracle database, Patch02
  4. Message-ID: <1992Oct4.163750.3822@sparky.imd.sterling.com>
  5. X-Md4-Signature: dc9a01c833e18d5a5baffd716da392b7
  6. Date: Sun, 4 Oct 1992 16:37:50 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: Kevin Stock <kstock@encore.com>
  10. Posting-number: Volume 32, Issue 93
  11. Archive-name: oraperl-v2/patch02
  12. Environment: Perl, Oracle with OCI, optionally Curses
  13. Patch-To: oraperl-v2: Volume 30, Issue 87-91,99
  14.  
  15. This is patch 2 to version 2 of Oraperl, a set of usersubs which
  16. allow Perl to access Oracle databases. You need Perl (v3.0.27 or
  17. better) and Oracle (including the Oracle Call Interface) to build
  18. Oraperl. If you can build Larry's Curseperl, then you can also
  19. build Coraperl, which is Oraperl with Curses.
  20.  
  21. Oraperl version 2 appeared as 5 postings in comp.sources.misc
  22. volume 30, issues 87 to 91. Patch 01 appeared shortly afterwards
  23. as issue 99.
  24.  
  25.  
  26.   Principal changes:
  27.   ------------------
  28. Oraperl can now deal with NULL fields properly. &ora_fetch() will
  29. return undef for any field which was NULL, and supplying undef as
  30. a parameter to &ora_bind() will result in a NULL being bound.
  31.  
  32. This change should not cause any problems when printing fetched
  33. values, since Perl will automatically convert them into blank
  34. strings. However, if you have a script which binds undefined
  35. values, they will now become NULL instead of a string containing
  36. exactly one space.
  37.  
  38. See ex.pl and mkdb.pl in the examples subdirectory for a simple
  39. example of NULL handling.
  40.  
  41. The &ora_titles() function now takes an optional second parameter
  42. which indicates whether the titles should be truncated to the width
  43. of the data. For compatibility, the default action is to truncate.
  44. If the second parameter is supplied and is zero, then the titles will
  45. not be truncated.
  46.  
  47. Thanks to Cynthia Mumford and Dave Hollen for pushing me to fix these
  48. and to Larry for telling me how!
  49.  
  50.   Directions
  51.   ----------
  52. Save this file in your Oraperl source directory, and type:
  53.  
  54.     patch -p0 <this-file
  55.  
  56. Then make, make test, make install.
  57.  
  58. Feel free to mail me if you have any problems with or questions about
  59. Oraperl.
  60.  
  61.     Kevin
  62.     kstock@encore.com, kstock@encore.fr
  63.  
  64.  
  65. ----cut here-----
  66. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/patchlevel.h ./patchlevel.h
  67. *** /user/mis/kstock/tmp/oraperl-v2.1/patchlevel.h    Fri Sep 25 14:39:48 1992
  68. --- ./patchlevel.h    Tue Sep 22 12:17:00 1992
  69. ***************
  70. *** 1,4 ****
  71.   /* patchlevel.h */
  72.   
  73.   #define    VERSION        2
  74. ! #define    PATCHLEVEL    1
  75. --- 1,4 ----
  76.   /* patchlevel.h */
  77.   
  78.   #define    VERSION        2
  79. ! #define    PATCHLEVEL    2
  80. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/Changes ./Changes
  81. *** /user/mis/kstock/tmp/oraperl-v2.1/Changes    Fri Sep 25 14:38:41 1992
  82. --- ./Changes    Fri Sep 25 14:21:30 1992
  83. ***************
  84. *** 4,9 ****
  85. --- 4,21 ----
  86.   Version 2
  87.   =========
  88.   
  89. + Patch 02
  90. + ========
  91. + Added a BUGS section to the manual page
  92. + Fixed &ora_titles so that it can return the entire title without truncation
  93. + Fixed &ora_fetch so that it returns undef for a NULL field
  94. + Fixed &ora_bind so that it accepts undef to bind a NULL value
  95. + Patch 01
  96. + ========
  97. + Fixed a bug in testdir/mkdb.pl
  98. + Added a hint about building coraperl with bsdcurses.mus
  99.   Patchlevel 0:
  100.   =============
  101.   Replaced my debugging code with Fred Fish' DBUG package
  102. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/Readme ./Readme
  103. *** /user/mis/kstock/tmp/oraperl-v2.1/Readme    Fri Sep 25 14:38:44 1992
  104. --- ./Readme    Wed Aug 26 09:12:28 1992
  105. ***************
  106. *** 51,58 ****
  107.   each release (covers the range 3.0.34 to 4.0.35, excluding 4.0.33) with
  108.   Oracle version 6, as I don't have access to any other system with Pro*C.
  109.   However, other people have compiled and used it on a range of different
  110. ! systems including Convex, Cray, NeXT, Pyramid, Sun and Ultrix, using Oracle
  111. ! versions 5 and 6. I'd appreciate any comments, bug-reports, improvements, etc.
  112.   
  113.   In addition to this README, the package contains the following files:
  114.   
  115. --- 51,59 ----
  116.   each release (covers the range 3.0.34 to 4.0.35, excluding 4.0.33) with
  117.   Oracle version 6, as I don't have access to any other system with Pro*C.
  118.   However, other people have compiled and used it on a range of different
  119. ! systems including Amdahl, Convex, Cray, NeXT, Pyramid, Sun and Ultrix,
  120. ! using Oracle versions 5 and 6. I'd appreciate any comments, bug-reports,
  121. ! improvements, etc.
  122.   
  123.   In addition to this README, the package contains the following files:
  124.   
  125. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/doc/Makefile ./doc/Makefile
  126. *** /user/mis/kstock/tmp/oraperl-v2.1/doc/Makefile    Fri Sep 25 14:38:59 1992
  127. --- ./doc/Makefile    Fri Sep 25 15:16:03 1992
  128. ***************
  129. *** 8,11 ****
  130.       $(NROFF) -man ../examples/sql >sql.man
  131.   
  132.   clobber:
  133. !     rm -f oraperl.man oraperl.ref.pr sql.man
  134. --- 8,11 ----
  135.       $(NROFF) -man ../examples/sql >sql.man
  136.   
  137.   clobber:
  138. !     rm -f oraperl.man oraperl.ref.pr sql.man nohup.out
  139. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/doc/oraperl.1 ./doc/oraperl.1
  140. *** /user/mis/kstock/tmp/oraperl-v2.1/doc/oraperl.1    Fri Sep 25 14:38:37 1992
  141. --- ./doc/oraperl.1    Fri Sep 25 15:39:10 1992
  142. ***************
  143. *** 18,24 ****
  144.   
  145.   &ora_do($lda, $stmt)
  146.   
  147. ! &ora_titles($csr)
  148.   &ora_lengths($csr)
  149.   &ora_types($csr)
  150.   &ora_commit($lda)
  151. --- 18,24 ----
  152.   
  153.   &ora_do($lda, $stmt)
  154.   
  155. ! &ora_titles($csr [, $truncate])
  156.   &ora_lengths($csr)
  157.   &ora_types($csr)
  158.   &ora_commit($lda)
  159. ***************
  160. *** 160,165 ****
  161. --- 160,174 ----
  162.   &ora_bind($csr, 50, 'management', 'Paris');
  163.   .if t .ft P
  164.   
  165. + A \fBNULL\fP value (in the \fIOracle\fP sense)
  166. + may be bound by specifying an \fBundef\fPined value as a parameter.
  167. + For example:
  168. + .ti +.5i
  169. + .if t .ft CW
  170. + &ora_bind($csr, 70, 'marketing', undef);
  171. + .if t .fi P
  172.   This function is equivalent to the \fIOCI obndrn\fP and \fIoexec\fP statements.
  173.   
  174.   The \fIOCI obndrn\fP function does not allow empty strings to be bound.
  175. ***************
  176. *** 166,172 ****
  177.   As distributed, \fI$ora_bind\fP therefore replaces empty strings
  178.   with a single space.
  179.   However, a compilation option allows this substitution to be suppressed,
  180. ! causing \fI&ora_bind()\fP to fail.
  181.   The output from the \fI&ora_version()\fP function
  182.   specifies which is the case at your installation.
  183.   .\"
  184. --- 175,181 ----
  185.   As distributed, \fI$ora_bind\fP therefore replaces empty strings
  186.   with a single space.
  187.   However, a compilation option allows this substitution to be suppressed,
  188. ! causing \fI&ora_bind()\fP to fail in this case.
  189.   The output from the \fI&ora_version()\fP function
  190.   specifies which is the case at your installation.
  191.   .\"
  192. ***************
  193. *** 195,200 ****
  194. --- 204,212 ----
  195.   
  196.   Used in an array context,
  197.   the value returned is an array containing the data, one element per field.
  198. + If any field was \fBNULL\fP (in the \fIOracle\fP sense)
  199. + the corresponding data value will be \fBundef\fPined.
  200. + This may be tested using \fIPerl\fP's \fBdefined()\fP operator.
  201.   
  202.   An optional second parameter may be supplied
  203.   to indicate whether the truncation of a \fBLONG\fP or \fBLONGRAW\fP field
  204. ***************
  205. *** 222,228 ****
  206.   while (($deptno, $dname, $loc) = &ora_fetch($csr, 1))
  207.   {
  208.   .in +.5i
  209. ! warn "Truncated!!!" if $ora_errstr == 1406;
  210.   # do something with the data
  211.   .in -.5i
  212.   }
  213. --- 234,240 ----
  214.   while (($deptno, $dname, $loc) = &ora_fetch($csr, 1))
  215.   {
  216.   .in +.5i
  217. ! warn "Truncated!!!" if $ora_errno == 1406;
  218.   # do something with the data
  219.   .in -.5i
  220.   }
  221. ***************
  222. *** 290,306 ****
  223.   See, for example, the sample program \fBsql\fP
  224.   which is supplied with \fIOraperl\fP and may have been installed at your site.
  225.   .\"
  226. ! .SH "@titles = &ora_titles($csr)"
  227.   .\"
  228.   A program may determine the field titles of an executed query
  229.   by calling \fI&ora_titles()\fP.
  230. ! This function takes a single parameter,
  231.   a statement identifier (obtained from \fI&ora_open()\fP)
  232.   indicating the query for which the titles are required.
  233.   The titles are returned as an array of strings, one for each column.
  234.   
  235.   Titles are truncated to the length of the field,
  236. ! as reported by the \fI&ora_lengths()\fP function.
  237.   
  238.   This function is equivalent to the \fIOCI oname\fP function.
  239.   .\"
  240. --- 302,319 ----
  241.   See, for example, the sample program \fBsql\fP
  242.   which is supplied with \fIOraperl\fP and may have been installed at your site.
  243.   .\"
  244. ! .SH "@titles = &ora_titles($csr [, $truncate])"
  245.   .\"
  246.   A program may determine the field titles of an executed query
  247.   by calling \fI&ora_titles()\fP.
  248. ! This function takes one mandatory parameter,
  249.   a statement identifier (obtained from \fI&ora_open()\fP)
  250.   indicating the query for which the titles are required.
  251.   The titles are returned as an array of strings, one for each column.
  252.   
  253.   Titles are truncated to the length of the field,
  254. ! as reported by the \fI&ora_lengths()\fP function,
  255. ! unless the optional \fI$truncate\fP parameter is supplied and is zero.
  256.   
  257.   This function is equivalent to the \fIOCI oname\fP function.
  258.   .\"
  259. ***************
  260. *** 666,672 ****
  261.   not those performed on the data retrieved from the database.
  262.   .SH SEE ALSO
  263.   .nf
  264. ! Oracle Documentation:
  265.   .in +.5i
  266.   \fISQL Language Reference Manual\fP
  267.   \fIProgrammer's Guide to the Oracle Call Interfaces\fP
  268. --- 679,685 ----
  269.   not those performed on the data retrieved from the database.
  270.   .SH SEE ALSO
  271.   .nf
  272. ! \fIOracle\fP Documentation:
  273.   .in +.5i
  274.   \fISQL Language Reference Manual\fP
  275.   \fIProgrammer's Guide to the Oracle Call Interfaces\fP
  276. ***************
  277. *** 677,684 ****
  278.   \fIperl(1)\fP
  279.   .in -.5i
  280.   .fi
  281.   .SH AUTHORS
  282. ! \fIORACLE\fP by Oracle Corporation, California.
  283.   .br
  284.   \fIPerl\fP and \fICurseperl\fP by Larry Wall, Netlabs
  285.   .if t .ft C
  286. --- 690,700 ----
  287.   \fIperl(1)\fP
  288.   .in -.5i
  289.   .fi
  290. + .SH BUGS
  291. + "\fIOraperl\fP sounds like a denture cleaner."
  292. + (Buzz Moschetti in comp.lang.perl)
  293.   .SH AUTHORS
  294. ! \fIOracle\fP by Oracle Corporation, California.
  295.   .br
  296.   \fIPerl\fP and \fICurseperl\fP by Larry Wall, Netlabs
  297.   .if t .ft C
  298. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/doc/oraperl.ref ./doc/oraperl.ref
  299. *** /user/mis/kstock/tmp/oraperl-v2.1/doc/oraperl.ref    Fri Sep 25 14:38:46 1992
  300. --- ./doc/oraperl.ref    Tue Sep 22 10:50:07 1992
  301. ***************
  302. *** 56,63 ****
  303.   .in +2m
  304.   
  305.   .ti -2m
  306. ! \fB@ary = &ora_titles($csr)\fP
  307.   Returns the column names associated with the query.
  308.   
  309.   .ti -2m
  310.   \fB@ary = &ora_lengths($csr)\fP
  311. --- 56,64 ----
  312.   .in +2m
  313.   
  314.   .ti -2m
  315. ! \fB@ary = &ora_titles($csr [, $truncate])\fP
  316.   Returns the column names associated with the query.
  317. + Names are truncated unless \fI$truncate\fP is supplied and is zero.
  318.   
  319.   .ti -2m
  320.   \fB@ary = &ora_lengths($csr)\fP
  321. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/examples/Readme ./examples/Readme
  322. *** /user/mis/kstock/tmp/oraperl-v2.1/examples/Readme    Fri Sep 25 14:38:59 1992
  323. --- ./examples/Readme    Fri Sep 25 14:35:26 1992
  324. ***************
  325. *** 9,21 ****
  326.   
  327.   commit.pl    Demonstrates the use of &ora_commit() and &ora_rollback()
  328.   
  329. ! ex.pl        This was my first ever Oraperl script. I probably wrote it
  330.           before writing Oraperl! It reads data from a table and prints
  331. !         it using a format.
  332.   
  333.   mkdb.pl        Creates a database, puts some data into it, drops it. The nice
  334.           thing about this is that it detects whether it is running under
  335. !         Oraperl or Coraperl, and changes its output accordingly.
  336.   
  337.   oradump.pl    Dumps the contents of an Oracle table into a set of insert
  338.           statements.
  339. --- 9,24 ----
  340.   
  341.   commit.pl    Demonstrates the use of &ora_commit() and &ora_rollback()
  342.   
  343. ! ex.pl        This was my first ever Oraperl script. I think I wrote it even
  344.           before writing Oraperl! It reads data from a table and prints
  345. !         it using a format. It also illustrates how to recognise NULL
  346. !         fields.
  347.   
  348.   mkdb.pl        Creates a database, puts some data into it, drops it. The nice
  349.           thing about this is that it detects whether it is running under
  350. !         Oraperl or Coraperl, and changes its output accordingly. It
  351. !         also illustrates handling of NULL fields, with both &ora_bind()
  352. !         and &ora_fetch().
  353.   
  354.   oradump.pl    Dumps the contents of an Oracle table into a set of insert
  355.           statements.
  356. ***************
  357. *** 23,25 ****
  358. --- 26,32 ----
  359.   sql        This was written in response to a posting on the net, asking
  360.           whether there was a tool which would execute an SQL statement
  361.           specified on the command line. Manual page built-in.
  362. + tabinfo.pl    Displays the structure of the specified table.
  363. +         This is mainly to show the use of &ora_lengths, &ora_titles
  364. +         and &ora_types.
  365. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/examples/ex.pl ./examples/ex.pl
  366. *** /user/mis/kstock/tmp/oraperl-v2.1/examples/ex.pl    Fri Sep 25 14:39:01 1992
  367. --- ./examples/ex.pl    Tue Sep 22 12:26:44 1992
  368. ***************
  369. *** 24,29 ****
  370. --- 24,31 ----
  371.   
  372.   while (($name, $phone) = &ora_fetch($csr))
  373.   {
  374. +     # mark any NULL fields found
  375. +     grep(defined || ($_ = '<NULL>'), $name, $phone);
  376.       write;
  377.   }
  378.   
  379. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/examples/mkdb.pl ./examples/mkdb.pl
  380. *** /user/mis/kstock/tmp/oraperl-v2.1/examples/mkdb.pl    Fri Sep 25 14:38:48 1992
  381. --- ./examples/mkdb.pl    Fri Sep 25 12:35:10 1992
  382. ***************
  383. *** 9,14 ****
  384. --- 9,17 ----
  385.   #
  386.   # Date:        15th November 1991
  387.   #
  388. + # Modified to demonstrate NULL handling in &ora_bind and &ora_fetch()
  389. + #
  390. + # Date:        25th September 1992
  391.   
  392.   # First make sure that we are running under some form of perl.
  393.   
  394. ***************
  395. *** 102,107 ****
  396. --- 105,112 ----
  397.       $csr = &ora_open($lda, $LIST)            || die $ora_errstr;
  398.       while (($name, $ext) = &ora_fetch($csr))
  399.       {
  400. +         $name = '<-NULL->' unless defined($name);
  401. +         $ext = '<-NULL->' unless defined($ext);
  402.           do during();
  403.       }
  404.       die $ora_errstr if ($ora_errno != 0);
  405. ***************
  406. *** 115,120 ****
  407. --- 120,126 ----
  408.   $INSERT = "insert into tryit values (:1, :2)";
  409.   $LIST    = "select * from tryit order by name";
  410.   $DELETE    = "delete from tryit where name = :1";
  411. + $DELETE_NULL    = "delete from tryit where name is null";
  412.   $DROP    = "drop table tryit";
  413.   
  414.   # create the database
  415. ***************
  416. *** 127,134 ****
  417.   $csr = &ora_open($lda, $INSERT)            || die $ora_errstr;
  418.   while (<DATA>)
  419.   {
  420. !     m/([a-z]+):([0-9]+)/;
  421. !     do ora_bind($csr, $1, $2);
  422.   }
  423.   do ora_close($csr)                || die $ora_errstr;
  424.   
  425. --- 133,142 ----
  426.   $csr = &ora_open($lda, $INSERT)            || die $ora_errstr;
  427.   while (<DATA>)
  428.   {
  429. !     m/(.*):(.*)/;
  430. !     $name = ($1 eq 'NULL') ? undef : $1;
  431. !     $ext = ($2 eq 'NULL') ? undef : $2;
  432. !     do ora_bind($csr, $name, $ext);
  433.   }
  434.   do ora_close($csr)                || die $ora_errstr;
  435.   
  436. ***************
  437. *** 143,148 ****
  438. --- 151,157 ----
  439.       &ora_bind($csr, $name)            || die $ora_errstr;
  440.   }
  441.   &ora_close($csr)                || die $ora_errstr;
  442. + &ora_do($lda, $DELETE_NULL)            || die $ora_errstr;
  443.   
  444.   # check the result
  445.   do list();
  446. ***************
  447. *** 157,163 ****
  448. --- 166,175 ----
  449.   __END__
  450.   julia:292
  451.   angela:208
  452. + NULL:999
  453.   larry:424
  454.   catherine:201
  455. + nonumber:NULL
  456.   randal:306
  457.   arnold:305
  458. + NULL:NULL
  459. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/examples/tabinfo.pl ./examples/tabinfo.pl
  460. *** /user/mis/kstock/tmp/oraperl-v2.1/examples/tabinfo.pl    Fri Sep 25 14:38:38 1992
  461. --- ./examples/tabinfo.pl    Tue Sep 22 12:29:38 1992
  462. ***************
  463. *** 40,46 ****
  464.   $lda = &ora_login($base, $user, $pass) || die $ora_errstr . "\n";
  465.   $csr = &ora_open($lda, "select * from $table") || die $ora_errstr . "\n";
  466.   
  467. ! (@name = &ora_titles($csr)) || die $ora_errstr . "\n";
  468.   (@length = &ora_lengths($csr)) || die $ora_errstr . "\n";
  469.   (@type = &ora_types($csr)) || die $ora_errstr . "\n";
  470.   
  471. --- 40,46 ----
  472.   $lda = &ora_login($base, $user, $pass) || die $ora_errstr . "\n";
  473.   $csr = &ora_open($lda, "select * from $table") || die $ora_errstr . "\n";
  474.   
  475. ! (@name = &ora_titles($csr, 0)) || die $ora_errstr . "\n";
  476.   (@length = &ora_lengths($csr)) || die $ora_errstr . "\n";
  477.   (@type = &ora_types($csr)) || die $ora_errstr . "\n";
  478.   
  479. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/oracle.mus ./oracle.mus
  480. *** /user/mis/kstock/tmp/oraperl-v2.1/oracle.mus    Fri Sep 25 14:38:32 1992
  481. --- ./oracle.mus    Fri Sep 25 11:52:00 1992
  482. ***************
  483. *** 110,118 ****
  484.   END
  485.   
  486.       case US_ora_open:
  487. !     if ((items < 2) || (items > 3))
  488.           fatal("Usage: &ora_open($lda, $stmt [, $cache])");
  489. !     else {
  490.           char * retval;
  491.           char * lda              = (char *) str_get(st[1]);
  492.           char * stmt              = (char *) str_get(st[2]);
  493. --- 110,118 ----
  494.   END
  495.   
  496.       case US_ora_open:
  497. !     if ((items < 2) || (items > 3)) {
  498.           fatal("Usage: &ora_open($lda, $stmt [, $cache])");
  499. !     } else {
  500.           char * retval;
  501.           char * lda              = (char *) str_get(st[1]);
  502.           char * stmt              = (char *) str_get(st[2]);
  503. ***************
  504. *** 125,137 ****
  505.       return sp;
  506.   
  507.       case US_ora_titles:
  508. !     if (items != 1) {
  509. !         fatal("Usage: @array = &ora_titles($csr)");
  510.       } else {
  511. !         char *csr              = (char *) str_get(st[1]);
  512.           int  retval;
  513.   
  514. !         retval = ora_titles(csr);
  515.           astore(stack, sp + retval, Nullstr);
  516.           st = stack->ary_array + sp;
  517.           for (i = 0 ; i < retval ; i++) {
  518. --- 125,138 ----
  519.       return sp;
  520.   
  521.       case US_ora_titles:
  522. !     if ((items < 1) || (items > 2)) {
  523. !         fatal("Usage: @array = &ora_titles($csr [, $truncate])");
  524.       } else {
  525. !         char *csr                  = (char *) str_get(st[1]);
  526. !         int   truncate = (items == 1) ? 1 : (int)    str_gnum(st[2]);
  527.           int  retval;
  528.   
  529. !         retval = ora_titles(csr, truncate);
  530.           astore(stack, sp + retval, Nullstr);
  531.           st = stack->ary_array + sp;
  532.           for (i = 0 ; i < retval ; i++) {
  533. ***************
  534. *** 198,205 ****
  535. --- 199,210 ----
  536.           astore(stack, sp + retval, Nullstr);
  537.           st = stack->ary_array + sp;
  538.           for (i = 0 ; i < retval ; i++) {
  539. +             if (ora_result[i] == NULL) {
  540. +             st[i] = str_2mortal(&str_undef);
  541. +             } else {
  542.               tmps = ora_result[i];
  543.               st[i] = str_2mortal(str_make(tmps, strlen(tmps)));
  544. +             }
  545.           }
  546.           return sp + retval - 1;
  547.           } else {    /* in scalar context, return the number of fields */
  548. ***************
  549. *** 233,239 ****
  550.           {
  551.           for (i = 0 ; i < items - 1 ; i++)
  552.           {
  553. !             vars[i] = (char *) str_get(st[i+2]);
  554.           }
  555.           retval = ora_bind(csr, vars, items - 1);
  556.           free(vars);
  557. --- 238,252 ----
  558.           {
  559.           for (i = 0 ; i < items - 1 ; i++)
  560.           {
  561. !             if (st[i+2]->str_pok || st[i+2]->str_nok)
  562. !             {
  563. !                 vars[i] = (char *) str_get(st[i+2]);
  564. !             }
  565. !             else
  566. !             {
  567. !             /* we got an undef */
  568. !             vars[i] = NULL;
  569. !             }
  570.           }
  571.           retval = ora_bind(csr, vars, items - 1);
  572.           free(vars);
  573. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/orafns.c ./orafns.c
  574. *** /user/mis/kstock/tmp/oraperl-v2.1/orafns.c    Fri Sep 25 14:38:40 1992
  575. --- ./orafns.c    Fri Sep 25 15:32:24 1992
  576. ***************
  577. *** 263,269 ****
  578.   
  579.       /* set up csr->data  to receive the information when we do a fetch
  580.        *      csr->rcode to receive the column return codes
  581. !      *      csr->len   with the data lengths (principally for ora_titles)
  582.        */
  583.   
  584.       if (cache < 1)
  585. --- 263,269 ----
  586.   
  587.       /* set up csr->data  to receive the information when we do a fetch
  588.        *      csr->rcode to receive the column return codes
  589. !      *      csr->len   with the data lengths
  590.        */
  591.   
  592.       if (cache < 1)
  593. ***************
  594. *** 430,446 ****
  595.    *
  596.    * returns the column headers for the query referenced by csr
  597.    *
  598. !  * overwrites the first position in each data array,
  599. !  * but this is acceptable since these values have always been returned.
  600.    */
  601.   
  602. ! int ora_titles(csr_s)
  603.   char *csr_s;
  604.   {
  605.       int i;
  606.       short len;
  607.       struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0);
  608.   
  609.       DBUG_ENTER("ora_titles");
  610.       DBUG_PRINT("entry", ("ora_titles(%s)", csr_s));
  611.       DBUG_PRINT("conv", ("string \"%s\" converted to csr %#lx", csr_s, csr));
  612. --- 430,453 ----
  613.    *
  614.    * returns the column headers for the query referenced by csr
  615.    *
  616. !  * As of version 2, patch 2, the column titles are written into a locally
  617. !  * allocated data area. This allows the entire name to be returned without
  618. !  * truncation. If the truncate flag is set, however, then the title is
  619. !  * truncated to the length of the data, to allow compatibility with the
  620. !  * old form.
  621.    */
  622.   
  623. ! int ora_titles(csr_s, truncate)
  624.   char *csr_s;
  625. + int truncate;
  626.   {
  627.       int i;
  628.       short len;
  629.       struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0);
  630.   
  631. +     static    int     n_titles    = 0;
  632. +     static    char    *titles        = NULL;
  633.       DBUG_ENTER("ora_titles");
  634.       DBUG_PRINT("entry", ("ora_titles(%s)", csr_s));
  635.       DBUG_PRINT("conv", ("string \"%s\" converted to csr %#lx", csr_s, csr));
  636. ***************
  637. *** 464,477 ****
  638.           DBUG_RETURN(0);
  639.       }
  640.   
  641.       for (i = 0 ; i < csr->nfields ; i++)
  642.       {
  643. !         len = csr->len[i];
  644.           oname(csr->csr, i + 1, (char *) -1, (short *) -1,
  645. !               csr->data[i], &len);
  646. !         ora_result[i] = csr->data[i];
  647.           DBUG_PRINT("info", ("field %4d (%lx) title \"%s\"",
  648. !             i, (long) csr->data[i], csr->data[i]));
  649.       }
  650.   
  651.       ora_errno = 0;
  652. --- 471,518 ----
  653.           DBUG_RETURN(0);
  654.       }
  655.   
  656. +     if (n_titles < csr->nfields)
  657. +     {
  658. +         n_titles = csr->nfields;
  659. +         /* we use free/malloc rather than realloc because we don't
  660. +          * need to preserve the contents of titles
  661. +          */
  662. +         if (titles != NULL)
  663. +         {
  664. +             DBUG_PRINT("free", ("freeing titles %lx",(long)titles));
  665. +             free(titles);
  666. +         }
  667. +         /* according to the manual, the title is a maximum of 240
  668. +          * characters. Here we allocate 256, which may lead to better
  669. +          * blocking?
  670. +          */
  671. +         if ((titles = (char *) malloc(256 * n_titles)) == NULL)
  672. +         {
  673. +             n_titles = 0;
  674. +             DBUG_PRINT("malloc",("insufficient memory for titles"));
  675. +             DBUG_PRINT("exit", ("returning 0"));
  676. +             DBUG_RETURN(0);
  677. +         }
  678. +         else
  679. +         {
  680. +             DBUG_PRINT("malloc", ("got titles %d bytes at %lx",
  681. +                 (256 * n_titles), (long) titles));
  682. +         }
  683. +     }
  684.       for (i = 0 ; i < csr->nfields ; i++)
  685.       {
  686. !         len = (truncate) ? csr->len[i] : 256;
  687.           oname(csr->csr, i + 1, (char *) -1, (short *) -1,
  688. !               &titles[256 * i], &len);
  689. !         ora_result[i] = &titles[256 * i];
  690. !         ora_result[i][len] = '\0';
  691.           DBUG_PRINT("info", ("field %4d (%lx) title \"%s\"",
  692. !             i, (long) ora_result[i], ora_result[i]));
  693.       }
  694.   
  695.       ora_errno = 0;
  696. ***************
  697. *** 677,684 ****
  698.               break;
  699.   
  700.           case 1405:
  701. !             DBUG_PRINT("info", ("field %d was NULL", i));
  702. !             *ora_result[i] = '\0';
  703.               break;
  704.   
  705.           case 1406:
  706. --- 718,724 ----
  707.               break;
  708.   
  709.           case 1405:
  710. !             ora_result[i] = NULL;
  711.               break;
  712.   
  713.           case 1406:
  714. ***************
  715. *** 710,716 ****
  716.           }
  717.   
  718.           DBUG_PRINT("info", ("field %4d (%lx) data \"%s\"",
  719. !             i, (long) ora_result[i], ora_result[i]));
  720.       }
  721.   
  722.       ++csr->next_entry;
  723. --- 750,757 ----
  724.           }
  725.   
  726.           DBUG_PRINT("info", ("field %4d (%lx) data \"%s\"",
  727. !             i, (long) ora_result[i],
  728. !             ora_result[i] ? ora_result[i] : "<NULL>"));
  729.       }
  730.   
  731.       ++csr->next_entry;
  732. ***************
  733. *** 731,736 ****
  734. --- 772,778 ----
  735.   int nitems;
  736.   {
  737.       int i;
  738. +     short null_flag = -1;
  739.   #ifndef    NO_BIND_PADDING
  740.       static char small_buf[2] = " ";
  741.   #endif
  742. ***************
  743. *** 757,762 ****
  744. --- 799,819 ----
  745.   
  746.       for (i = 0 ; i < nitems ; i++)
  747.       {
  748. +         if (vars[i] == NULL)
  749. +         {
  750. +         if ((obndrn(csr->csr, i+1, (char *) -1, 0,
  751. +             5, -1, &null_flag, (char *) -1, 0, 0)) != 0)
  752. +         {
  753. +             ora_errno = csr->csr->csrrc;
  754. +             DBUG_PRINT("exit", ("obndrn failed on field %d, <NULL>",
  755. +                 i + 1));
  756. +             DBUG_RETURN(0);
  757. +         }
  758. +         DBUG_PRINT("info", ("obndrn %d, <NULL> OK", (i + 1), vars[i]));
  759. +         }
  760. +         else
  761. +         {
  762.   #ifndef    NO_BIND_PADDING
  763.           if (vars[i][0] == '\0')
  764.           {
  765. ***************
  766. *** 774,779 ****
  767. --- 831,837 ----
  768.           }
  769.   
  770.           DBUG_PRINT("info", ("obndrn %d, \"%s\" OK", (i + 1), vars[i]));
  771. +         }
  772.       }
  773.   
  774.       if (oexec(csr->csr) != 0)
  775. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/testdir/Standard-Results ./testdir/Standard-Results
  776. *** /user/mis/kstock/tmp/oraperl-v2.1/testdir/Standard-Results    Fri Sep 25 14:39:04 1992
  777. --- ./testdir/Standard-Results    Fri Sep 25 15:35:58 1992
  778. ***************
  779. *** 12,17 ****
  780. --- 12,18 ----
  781.   2 3 5 7 11 
  782.   2 fields, lengths 10, 40
  783.       types 1, 2
  784. +     names NAME, EXT
  785.          Name         Ext
  786.          ====         ===
  787.          angela       208
  788. ***************
  789. *** 19,28 ****
  790. --- 20,34 ----
  791.          catherine    201
  792.          julia        292
  793.          larry        424
  794. +        nonumber     <-N
  795.          randal       306
  796. +        <-NULL->     999
  797. +        <-NULL->     <-N
  798.   2 fields, lengths 10, 40
  799.       types 1, 2
  800. +     names NAME, EXT
  801.           Name         Ext
  802.          ====         ===
  803.          larry        424
  804. +        nonumber     <-N
  805.          randal       306
  806. diff -cr /user/mis/kstock/tmp/oraperl-v2.1/testdir/mkdb.pl ./testdir/mkdb.pl
  807. *** /user/mis/kstock/tmp/oraperl-v2.1/testdir/mkdb.pl    Fri Sep 25 14:39:58 1992
  808. --- ./testdir/mkdb.pl    Fri Sep 25 15:35:44 1992
  809. ***************
  810. *** 28,36 ****
  811. --- 28,38 ----
  812.       $nfields = &ora_fetch($csr)            || die $ora_errstr;
  813.       print "$nfields fields, lengths ", join(', ', &ora_lengths($csr)), "\n";
  814.       print "\ttypes ", join(', ', &ora_types($csr)), "\n";
  815. +     print "\tnames ", join(', ', &ora_titles($csr, 0)), "\n";
  816.   
  817.       while (($name, $ext) = &ora_fetch($csr))
  818.       {
  819. +         grep(defined || ($_ = '<-NULL->'), $name, $ext);
  820.           write;
  821.       }
  822.       die $ora_errstr if ($ora_errno != 0);
  823. ***************
  824. *** 53,60 ****
  825.   $csr = &ora_open($lda, $INSERT)            || die $ora_errstr;
  826.   while (<DATA>)
  827.   {
  828. !     m/([a-z]+):([0-9]+)/;
  829. !     do ora_bind($csr, $1, $2);
  830.   }
  831.   do ora_close($csr)                || die $ora_errstr;
  832.   
  833. --- 55,66 ----
  834.   $csr = &ora_open($lda, $INSERT)            || die $ora_errstr;
  835.   while (<DATA>)
  836.   {
  837. !     chop;
  838. !     ($name, $telno) = split(':', $_);
  839. !     undef $name if $name eq 'NULL';
  840. !     undef $telno if $telno eq 'NULL';
  841. !     do ora_bind($csr, $name, $telno);
  842.   }
  843.   do ora_close($csr)                || die $ora_errstr;
  844.   
  845. ***************
  846. *** 69,74 ****
  847. --- 75,81 ----
  848.       &ora_bind($csr, $name)            || die $ora_errstr;
  849.   }
  850.   &ora_close($csr)                || die $ora_errstr;
  851. + &ora_do($lda, 'delete from tryit where name is null')    || die $ora_errstr;
  852.   
  853.   # check the result
  854.   do list();
  855. ***************
  856. *** 85,87 ****
  857. --- 92,97 ----
  858.   catherine:201
  859.   randal:306
  860.   arnold:305
  861. + NULL:999
  862. + nonumber:NULL
  863. + NULL:NULL
  864.  
  865. exit 0 # Just in case...
  866.