home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / oraperl / patch03a next >
Text File  |  1991-11-11  |  59KB  |  2,242 lines
  1. Newsgroups: comp.sources.misc
  2. From: kstock@gouldfr.encore.fr (Kevin Stock)
  3. Subject:  v25i035:  oraperl - Extensions to Perl to access Oracle databases, Patch03a/2
  4. Message-ID: <csm-v25i035=oraperl.113826@sparky.IMD.Sterling.COM>
  5. X-Md4-Signature: 1a78659a7a8b571d548075c05e76fd42
  6. Date: Sun, 10 Nov 1991 17:40:25 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: kstock@gouldfr.encore.fr (Kevin Stock)
  10. Posting-number: Volume 25, Issue 35
  11. Archive-name: oraperl/patch03a
  12. Environment: Perl, Oracle
  13. Patch-To: oraperl: Volume 18, Issue 10
  14.  
  15. This is Patch 03 for Oraperl, a set of usersubs which allow Perl to
  16. access Oracle databases. You need Perl (v3.0.27 or better) and Oracle
  17. (including the Oracle Call Interface) to build Oraperl.
  18.  
  19. Oraperl appeared in comp.sources.misc as follows:
  20.  
  21.     v18i010        original
  22.     v20i097        patch 01
  23.     v22i058        patch 02
  24.  
  25.             Details of Patch 03
  26.             -------------------
  27.  Changes
  28.  -------
  29. Fixed a bug in allocating the data buffers, notably affecting DATE fields
  30. Fixed a bug in not freeing the space for ora_bind parameters
  31. Fixed a bug in creating a "debug" variable when it wasn't needed
  32. Improved debugging output, added support for flag 32 (string/numeric conversion)
  33. Improved handling of $ora_errstr
  34. Added configuration flags for various things to the Makefile
  35. Added targets listing and docs to the Makefile
  36. Added the &ora_version() function, analagous to Perl's -v flag.
  37. Added the &ora_do() function, equivalent to &ora_close(&ora_open(...))
  38. Added handling of NULL values returned from the database
  39. Added an 'oraperl.ph' file
  40.  
  41.  What to do
  42.  ----------
  43. To apply this patch, unshar the shar file which follows. This will
  44. create the following files:
  45.  
  46.     Patch03
  47.     oraperl.ph
  48.     patchlevel.h
  49.  
  50. If for an earlier version of Oraperl you changed str_2mortal() to
  51. str_2static() in oracle.mus (for Perl v3), please change it back!
  52.  
  53. Run the file Patch03 through the patch program.
  54.  
  55. Fix anything you need for your system in the Makefile. Then read
  56. README and run make.
  57.  
  58. Note that the when you do a "make clean" it will demolish the old
  59. PATCHLEVEL file. This is correct.
  60.  
  61.  Acknowledgements
  62.  ----------------
  63. Thanks to Alec Muffett (of "crack" fame), Robert Chansky and others
  64. for helping me to understand the problem with DATEs and NULL fields,
  65. and for pointing out the difference between dsize and dbsize.
  66.  
  67.  A Philosophical Note
  68.  --------------------
  69. When Oraperl was first released, I received mail from two people.
  70. After the first patch, there were four more. After the second, there
  71. were about another eight. Is the value of software _really_ in
  72. exponential proportion to the number of patches :-). Maybe that's why
  73. people like Perl so much!
  74.  
  75.     Kevin
  76.     kstock@gouldfr.encore.fr, kstock@encore.com
  77. --------
  78. #!/bin/sh
  79. # This is a shell archive (produced by shar 3.49)
  80. # To extract the files from this archive, save it to a file, remove
  81. # everything above the "!/bin/sh" line above, and type "sh file_name".
  82. #
  83. # made 11/10/1991 17:31 UTC by kent@sparky.IMD.Sterling.COM
  84. # Source directory /home/kent/mod/csm/queue/Noraperl/repack
  85. #
  86. # existing files will NOT be overwritten unless -c is specified
  87. #
  88. # This is part 1 of a multipart archive                                    
  89. # do not concatenate these parts, unpack them in order with /bin/sh        
  90. #
  91. # This shar contains:
  92. # length  mode       name
  93. # ------ ---------- ------------------------------------------
  94. #  67801 -rw-r--r-- Patch03
  95. #    703 -rw-r--r-- oraperl.ph
  96. #     41 -rw-r--r-- patchlevel.h
  97. #
  98. if test -r _shar_seq_.tmp; then
  99.     echo 'Must unpack archives in sequence!'
  100.     echo Please unpack part `cat _shar_seq_.tmp` next
  101.     exit 1
  102. fi
  103. # ============= Patch03 ==============
  104. if test -f 'Patch03' -a X"$1" != X"-c"; then
  105.     echo 'x - skipping Patch03 (File already exists)'
  106.     rm -f _shar_wnt_.tmp
  107. else
  108. > _shar_wnt_.tmp
  109. echo 'x - extracting Patch03 (Text)'
  110. sed 's/^X//' << 'SHAR_EOF' > 'Patch03' &&
  111. *** ORIG/CHANGES    Mon Oct 28 17:13:00 1991
  112. --- ./CHANGES    Mon Oct 28 15:16:30 1991
  113. ***************
  114. *** 14,16 ****
  115. --- 14,30 ----
  116. X  Added support for dynamically modifiable SQL statements
  117. X  Added a Hints file
  118. X  Corrected an error in the quick-reference sheet
  119. + 
  120. + Patch 03
  121. + ========
  122. + Fixed a bug in allocating the data buffers, notably affecting DATE fields
  123. + Fixed a bug in not freeing the space for ora_bind parameters
  124. + Fixed a bug in creating a "debug" variable when it wasn't needed
  125. + Improved debugging output, added support for flag 32 (string/numeric conversion)
  126. + Improved handling of $ora_errstr
  127. + Added configuration flags for various things to the Makefile
  128. + Added targets listing and docs to the Makefile
  129. + Added the &ora_version() function, analagous to Perl's -v flag.
  130. + Added the &ora_do() function, equivalent to &ora_close(&ora_open(...))
  131. + Added handling of NULL values returned from the database
  132. + Added an 'oraperl.ph' file
  133. *** ORIG/Hints    Mon Oct 28 17:12:29 1991
  134. --- ./Hints    Mon Oct 28 15:22:35 1991
  135. ***************
  136. *** 1,4 ****
  137. - 
  138. X  This file contains hints and tips about Oraperl, dealing with problems which
  139. X  have arisen in the past.
  140. X  
  141. --- 1,3 ----
  142. ***************
  143. *** 6,31 ****
  144. X  Retrieving Dates
  145. X  ================
  146. X  
  147. ! If you want to retrieve a field which is declared as an Oracle DATE, then you
  148. ! must explicitly format it using the SQL*Plus TO_CHAR function, for example:
  149. ! 
  150. !     $csr = &ora_open($lda, "select to_char(sysdate, 'DD/MM/YY') from dual")
  151. ! 
  152. ! Otherwise, Oracle tells Oraperl that the field only occupies seven bytes,
  153. ! and a truncation error occurs when the field is fetched. This causes
  154. ! &ora_fetch() to return an error.
  155. X  
  156. - I hope to correct this in a future patch.
  157. X  
  158. - 
  159. X  Building on a Convex machine
  160. X  ============================
  161. X  
  162. ! The  strtol()  function used at the start of most of the functions in orafns.c
  163. ! and in oracle.mus must be replaced by  strtoul() to allow larger addresses to
  164. ! be converted.
  165. X  
  166. ! The  putenv()  function used in  set_sid()  must be replaced by  setenv() .
  167. X  
  168. X  
  169. X  Using Bind Variables
  170. --- 5,27 ----
  171. X  Retrieving Dates
  172. X  ================
  173. X  
  174. ! Due to a bug in earlier versions of Oraperl, it was not possible to return
  175. ! a DATE field in default format. This has been corrected in patch 3. You may
  176. ! still wish to use Oracle's to_char() function for greater control over the
  177. ! format in which the date is returned.
  178. X  
  179. X  
  180. X  Building on a Convex machine
  181. X  ============================
  182. X  
  183. ! Uncomment the definitions of STRTOL and PUTENV in the Makefile.
  184. ! 
  185. ! 
  186. ! Building with Perl v3
  187. ! =====================
  188. X  
  189. ! Ideally, get hold of v4. However, if you have to work with v3, uncomment
  190. ! the definition of STR_2MORTAL in the Makefile.
  191. X  
  192. X  
  193. X  Using Bind Variables
  194. *** ORIG/Makefile    Mon Oct 28 17:13:00 1991
  195. --- ./Makefile    Mon Oct 28 15:25:35 1991
  196. ***************
  197. *** 3,9 ****
  198. X  # Change these to your ORACLE installation directory and Perl source directory
  199. X  
  200. X  ORACLE_HOME    = /usr/soft/oracle
  201. ! SRC        = /usr/soft/public/perl_4.0.10
  202. X  
  203. X  # Oracle Definitions, taken from proc.mk
  204. X  
  205. --- 3,9 ----
  206. X  # Change these to your ORACLE installation directory and Perl source directory
  207. X  
  208. X  ORACLE_HOME    = /usr/soft/oracle
  209. ! SRC        = /usr/soft/public/perl
  210. X  
  211. X  # Oracle Definitions, taken from proc.mk
  212. X  
  213. ***************
  214. *** 25,38 ****
  215. X  # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
  216. X  
  217. X  DEBUG        = -DPERL_DEBUGGING
  218. - CFLAGS        = $(DEBUG) -I$(SRC) $(GLOBINCS) -O
  219. X  
  220. ! SRCS        = usersub.c oracle.c orafns.c getcursor.c colons.c
  221. X  OBJS        = usersub.o oracle.o orafns.o getcursor.o colons.o
  222. ! HDRS        = orafns.h
  223. X  
  224. X  oraperl: $(SRC)/uperl.o $(OBJS)
  225. !     cc -o oraperl $(SRC)/uperl.o $(OBJS)                \
  226. X            -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS)
  227. X  
  228. X  oracle.c: $(SRC)/usub/mus oracle.mus
  229. --- 25,53 ----
  230. X  # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
  231. X  
  232. X  DEBUG        = -DPERL_DEBUGGING
  233. X  
  234. ! # Some system-specific things
  235. ! #
  236. ! # If you have setenv() instead of putenv(), uncomment the next line
  237. ! # PUTENV    = -Dputenv=setenv
  238. ! #
  239. ! # If you have strtoul(), uncomment the next line
  240. ! # STRTOL    = -Dstrtol=strtoul
  241. ! #
  242. ! # If you are using Perl v3 instead of v4, uncomment the next line
  243. ! # STR_2MORTAL    = -Dstr_2mortal=str_2static
  244. ! 
  245. ! # From here on, you shouldn't need to change anything
  246. ! 
  247. ! SRCS        = usersub.c oracle.mus orafns.c getcursor.c colons.c
  248. X  OBJS        = usersub.o oracle.o orafns.o getcursor.o colons.o
  249. ! HDRS        = patchlevel.h orafns.h
  250. ! DEFS        = $(STRTOL) $(PUTENV) $(STR_2MORTAL)
  251. ! 
  252. ! CFLAGS        = $(DEBUG) -I$(SRC) $(GLOBINCS) $(LOCINCS) $(DEFS) -O
  253. X  
  254. X  oraperl: $(SRC)/uperl.o $(OBJS)
  255. !     $(CC) -o oraperl $(SRC)/uperl.o $(OBJS)                \
  256. X            -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS)
  257. X  
  258. X  oracle.c: $(SRC)/usub/mus oracle.mus
  259. ***************
  260. *** 41,44 ****
  261. X  $(OBJS):    $(HDRS)
  262. X  
  263. X  clean:
  264. !     rm -f nohup.out oraperl *.o oracle.c oraperl.man Print tags out core
  265. --- 56,69 ----
  266. X  $(OBJS):    $(HDRS)
  267. X  
  268. X  clean:
  269. !     rm -f nohup.out oraperl *.o oracle.c oraperl.man oraperl.doc.pr \
  270. !           oraperl.ref.pr listing tags core PATCHLEVEL
  271. ! 
  272. ! listing:
  273. !     pr -fn Makefile $(HDRS) $(SRCS) >listing
  274. ! 
  275. ! docs:
  276. !     nroff -man oraperl.1 >oraperl.man
  277. !     nroff oraperl.doc >oraperl.doc.pr
  278. !     nroff oraperl.ref >oraperl.ref.pr
  279. ! 
  280. *** ORIG/README    Mon Oct 28 17:13:01 1991
  281. --- ./README    Mon Oct 28 15:46:00 1991
  282. ***************
  283. *** 8,28 ****
  284. X  
  285. X      ORACLE_HOME    your Oracle installation directory
  286. X      SRC        your Perl source directory (with the usub directory)
  287. !     OTHERLIBS    \
  288. X      CLIBS         |
  289. X      OCILIB         +- copy these from your proc.mk file
  290. X      NETLIBS         |
  291. X      ORALIBS        /
  292. !     GLOBINCS    \
  293. X      LOCINCS         +- copy these from $SRC/usub/Makefile
  294. X      LIBS        /
  295. X      DEBUG        -DDEBUGGING, -DPERL_DEBUGGING or leave blank;
  296. X              see orafns.h for an explanation
  297. X  
  298. - If your version of Perl is earlier than v4, you will also need to make
  299. - one change to  oracle.mus . The name  str_2mortal()  on line 101 must
  300. - be changed to  str_2static()  with the same arguments.
  301. - 
  302. X  I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
  303. X  using Perl 3.0.34, 4.0.00 4.0.03 and 4.0.10 with Oracle version 6, as I don't
  304. X  have access to any other system with Pro*C. I'd appreciate any comments,
  305. --- 8,27 ----
  306. X  
  307. X      ORACLE_HOME    your Oracle installation directory
  308. X      SRC        your Perl source directory (with the usub directory)
  309. !     OTHERLIBS    \ 
  310. X      CLIBS         |
  311. X      OCILIB         +- copy these from your proc.mk file
  312. X      NETLIBS         |
  313. X      ORALIBS        /
  314. !     GLOBINCS    \ 
  315. X      LOCINCS         +- copy these from $SRC/usub/Makefile
  316. X      LIBS        /
  317. X      DEBUG        -DDEBUGGING, -DPERL_DEBUGGING or leave blank;
  318. X              see orafns.h for an explanation
  319. +     PUTENV        \ 
  320. +     STRTOL         +- system dependent - see Makefile for details
  321. +     STR_2MORTAL    /
  322. X  
  323. X  I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
  324. X  using Perl 3.0.34, 4.0.00 4.0.03 and 4.0.10 with Oracle version 6, as I don't
  325. X  have access to any other system with Pro*C. I'd appreciate any comments,
  326. ***************
  327. *** 32,37 ****
  328. --- 31,37 ----
  329. X  
  330. X  Source Code:
  331. X      Makefile    building instructions
  332. +     patchlevel.h    your Oraperl patch level
  333. X      orafns.h    common declarations
  334. X      oracle.mus    function interface description
  335. X      getcursor.c    functions to deal with the cursor pool
  336. ***************
  337. *** 43,62 ****
  338. X      debug-p        tests to see if debugging is available
  339. X      ex.pl        simple example of using the functions
  340. X      mkdb.pl        more extensive example, showing the use of ora_bind()
  341. X  
  342. X  Documentation
  343. X      oraperl.doc    explains some of the thinking behind Oraperl
  344. !     oraperl.ref    quick reference (troff format)
  345. X      oraperl.1    manual page
  346. -     Hints        notes on using oraperl
  347. -     Oracle-v5    Hints for compiling Oraperl with Oracle v5
  348. X  
  349. X  Miscellaneous
  350. X      CHANGES        Summary of changes to Oraperl
  351. !     PATCHLEVEL    current patchlevel (2)
  352. X  
  353. ! Many thanks to Larry for Perl. Now if only we could get the Camel book
  354. ! into France! Hmm. Any plans for "Le Livre Chameau"?
  355. X  
  356. X      Kevin Stock
  357. X      kstock@gouldfr.encore.fr
  358. --- 43,62 ----
  359. X      debug-p        tests to see if debugging is available
  360. X      ex.pl        simple example of using the functions
  361. X      mkdb.pl        more extensive example, showing the use of ora_bind()
  362. +             and ora_do()
  363. X  
  364. X  Documentation
  365. X      oraperl.doc    explains some of the thinking behind Oraperl
  366. !     oraperl.ref    quick reference - glue it into the perl reference guide
  367. X      oraperl.1    manual page
  368. X  
  369. X  Miscellaneous
  370. X      CHANGES        Summary of changes to Oraperl
  371. !     Hints        notes on using oraperl
  372. !     Oracle-v5    Hints for compiling Oraperl with Oracle v5
  373. !     oraperl.ph    definitions of Oraperl error and debugging codes
  374. X  
  375. ! Many thanks to Larry for Perl.
  376. X  
  377. X      Kevin Stock
  378. X      kstock@gouldfr.encore.fr
  379. *** ORIG/colons.c    Mon Oct 28 17:12:31 1991
  380. --- ./colons.c    Fri Oct 25 14:29:54 1991
  381. ***************
  382. *** 9,19 ****
  383. --- 9,26 ----
  384. X   * Perl kit.
  385. X   */
  386. X  
  387. + #include <stdio.h>
  388. + #include "EXTERN.h"
  389. + #include "orafns.h"
  390. + 
  391. + 
  392. X  int count_colons(s)
  393. X  register char *s;
  394. X  {
  395. X      register int n = 0, c;
  396. X  
  397. +     DEBUG(8, 1, (fprintf(stderr, "count_colons(\"%s\")\n", s)));
  398. + 
  399. X      while (*s != '\0')
  400. X      {
  401. X          if (*s == ':')
  402. ***************
  403. *** 24,29 ****
  404. --- 31,39 ----
  405. X              if (((c = atoi(++s)) <= 0) || (c > n+1))
  406. X              {
  407. X                  /* number too low or out of sequence */
  408. +                 DEBUG(8, -1, (fprintf(stderr,
  409. +                     "count_colons: got %d, expected %d\n",
  410. +                     c, n+1)));
  411. X                  return(-1);
  412. X              }
  413. X              else if (c == n + 1)
  414. ***************
  415. *** 43,47 ****
  416. --- 53,58 ----
  417. X          }
  418. X      }
  419. X  
  420. +     DEBUG(8, -1, (fprintf(stderr, "count_colons: returning %d\n", n)));
  421. X      return(n);
  422. X  }
  423. *** ORIG/getcursor.c    Mon Oct 28 17:13:02 1991
  424. --- ./getcursor.c    Fri Oct 25 16:05:03 1991
  425. ***************
  426. *** 29,39 ****
  427. X  {
  428. X      int i;
  429. X  
  430. !     DEBUG(8, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr)));
  431. X  
  432. X      if (csr->data == NULL)
  433. X      {
  434. !         DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
  435. X          return;
  436. X      }
  437. X  
  438. --- 29,39 ----
  439. X  {
  440. X      int i;
  441. X  
  442. !     DEBUG(8, 1, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr)));
  443. X  
  444. X      if (csr->data == NULL)
  445. X      {
  446. !         DEBUG(8, -1, (fputs("ora_free_data: nothing to do\n", stderr)));
  447. X          return;
  448. X      }
  449. X  
  450. ***************
  451. *** 41,57 ****
  452. X      {
  453. X          if (csr->data[i] != NULL)
  454. X          {
  455. !             DEBUG(128, (fprintf(stderr, "freeing (%d) == %#lx\n",
  456. !                 i, (long) csr->data[i])));
  457. X              free(csr->data[i]);
  458. X          }
  459. X      }
  460. X  
  461. !     DEBUG(128, (fprintf(stderr, "freeing %#lx\n", (long) csr->data)));
  462. X      free(csr->data);
  463. !     csr->data = NULL;
  464. X      csr->nfields = 0;
  465. !     DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
  466. X  }
  467. X  
  468. X  
  469. --- 41,65 ----
  470. X      {
  471. X          if (csr->data[i] != NULL)
  472. X          {
  473. !             DEBUG(128, 0, (fprintf(stderr,
  474. !                 "ora_free_data: freeing field %d at address %#lx\n",
  475. !                 i, (long) csr->data[i])));
  476. X              free(csr->data[i]);
  477. X          }
  478. X      }
  479. X  
  480. !     DEBUG(128, 0, (fprintf(stderr,
  481. !         "ora_free_data: freeing cursor rcode at address %#lx\n",
  482. !         (long) csr->rcode)));
  483. !     free(csr->rcode);
  484. !     csr->rcode = (short *) NULL;
  485. !     DEBUG(128, 0, (fprintf(stderr,
  486. !         "ora_free_data: freeing cursor data at address %#lx\n",
  487. !         (long) csr->data)));
  488. X      free(csr->data);
  489. !     csr->data = (char **) NULL;
  490. X      csr->nfields = 0;
  491. !     DEBUG(8, -1, (fputs("ora_free_data: returning\n", stderr)));
  492. X  }
  493. X  
  494. X  
  495. ***************
  496. *** 66,93 ****
  497. X  {
  498. X      struct cursor *tmp;
  499. X  
  500. !     DEBUG(8, (fputs("ora_getcursor()\n", stderr)));
  501. X  
  502. X      if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL)
  503. X      {
  504. !         DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
  505. !         DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
  506. X          ora_errno = ORAP_NOMEM;
  507. X          return(NULL);
  508. X      }
  509. !     DEBUG(128, (fprintf(stderr,
  510. !         "ora_getcursor: got cursor at %#lx\n", (long) tmp)));
  511. X  
  512. !     if ((tmp->csr = (struct csrdef *) malloc(sizeof(struct csrdef))) == NULL)
  513. X      {
  514. X          free(tmp);
  515. !         DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
  516. !         DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
  517. X          ora_errno = ORAP_NOMEM;
  518. X          return(NULL);
  519. X      }
  520. !     DEBUG(128, (fprintf(stderr,
  521. !         "ora_getcursor: got csr at %#lx\n", tmp->csr)));
  522. X  
  523. X      tmp->hda = NULL;
  524. X      tmp->data = NULL;
  525. --- 74,101 ----
  526. X  {
  527. X      struct cursor *tmp;
  528. X  
  529. !     DEBUG(8, 1, (fputs("ora_getcursor()\n", stderr)));
  530. X  
  531. X      if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL)
  532. X      {
  533. !         DEBUG((8 | 128), -1,
  534. !             (fputs("ora_getcursor: out of memory\n", stderr)));
  535. X          ora_errno = ORAP_NOMEM;
  536. X          return(NULL);
  537. X      }
  538. !     DEBUG(128, 0, (fprintf(stderr,
  539. !         "ora_getcursor: got cursor at %#lx\n", (long) tmp)));
  540. X  
  541. !     if ((tmp->csr = (struct csrdef *)malloc(sizeof(struct csrdef))) == NULL)
  542. X      {
  543. X          free(tmp);
  544. !         DEBUG((8 | 128), -1,
  545. !             (fputs("ora_getcursor: out of memory\n", stderr)));
  546. X          ora_errno = ORAP_NOMEM;
  547. X          return(NULL);
  548. X      }
  549. !     DEBUG(128, 0, (fprintf(stderr,
  550. !         "ora_getcursor: got csr at %#lx\n", tmp->csr)));
  551. X  
  552. X      tmp->hda = NULL;
  553. X      tmp->data = NULL;
  554. ***************
  555. *** 96,102 ****
  556. X      csr_list.next = tmp;
  557. X  
  558. X      ora_errno = 0;
  559. !     DEBUG(8, (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp)));
  560. X      return(tmp);
  561. X  }
  562. X  
  563. --- 104,111 ----
  564. X      csr_list.next = tmp;
  565. X  
  566. X      ora_errno = 0;
  567. !     DEBUG(8, -1,
  568. !         (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp)));
  569. X      return(tmp);
  570. X  }
  571. X  
  572. ***************
  573. *** 111,136 ****
  574. X  {
  575. X      struct cursor *tmp;
  576. X  
  577. !     DEBUG(8, (fputs("ora_getlda()\n", stderr)));
  578. X  
  579. X      if ((tmp = ora_getcursor()) == NULL)
  580. X      {
  581. !         DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
  582. X          return(NULL);
  583. X      }
  584. X  
  585. X      if ((tmp->hda = malloc(256)) == NULL)
  586. X      {
  587. !         DEBUG(128, (fputs("ora_getlda: out of memory\n", stderr)));
  588. X          ora_dropcursor(tmp);
  589. -         DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
  590. X          ora_errno = ORAP_NOMEM;
  591. X          return(NULL);
  592. X      }
  593. !     DEBUG(128, (fprintf(stderr,
  594. !         "ora_getlda: got hda at %#lx\n", tmp->hda)));
  595. X  
  596. !     DEBUG(8, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp)));
  597. X      return(tmp);
  598. X  }
  599. X  
  600. --- 120,145 ----
  601. X  {
  602. X      struct cursor *tmp;
  603. X  
  604. !     DEBUG(8, 1, (fputs("ora_getlda()\n", stderr)));
  605. X  
  606. X      if ((tmp = ora_getcursor()) == NULL)
  607. X      {
  608. !         DEBUG(8, -1, (fputs("ora_getlda: returning NULL\n", stderr)));
  609. X          return(NULL);
  610. X      }
  611. X  
  612. X      if ((tmp->hda = malloc(256)) == NULL)
  613. X      {
  614. !         DEBUG((8 | 128), -1,
  615. !             (fputs("ora_getlda: out of memory\n", stderr)));
  616. X          ora_dropcursor(tmp);
  617. X          ora_errno = ORAP_NOMEM;
  618. X          return(NULL);
  619. X      }
  620. !     DEBUG(128, 0,
  621. !         (fprintf(stderr, "ora_getlda: got hda at %#lx\n", tmp->hda)));
  622. X  
  623. !     DEBUG(8, -1, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp)));
  624. X      return(tmp);
  625. X  }
  626. X  
  627. ***************
  628. *** 147,153 ****
  629. X  
  630. X      tmp = &csr_list;
  631. X  
  632. !     DEBUG(8, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr)));
  633. X  
  634. X      while ((tmp->next != NULL) && (tmp->next != csr))
  635. X      {
  636. --- 156,162 ----
  637. X  
  638. X      tmp = &csr_list;
  639. X  
  640. !     DEBUG(8, 1, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr)));
  641. X  
  642. X      while ((tmp->next != NULL) && (tmp->next != csr))
  643. X      {
  644. ***************
  645. *** 156,162 ****
  646. X  
  647. X      if (tmp->next == NULL)
  648. X      {
  649. !         DEBUG(8, (fputs("ora_dropcursor: invalid\n", stderr)));
  650. X          ora_errno = ORAP_INVCSR;
  651. X          return(0);
  652. X      }
  653. --- 165,172 ----
  654. X  
  655. X      if (tmp->next == NULL)
  656. X      {
  657. !         DEBUG(8, -1,
  658. !             (fprintf(stderr, "ora_dropcursor: not a cursor\n")));
  659. X          ora_errno = ORAP_INVCSR;
  660. X          return(0);
  661. X      }
  662. ***************
  663. *** 165,191 ****
  664. X  
  665. X      if (t->hda != NULL)
  666. X      {
  667. !         DEBUG(128, (fprintf(stderr,
  668. !             "ora_dropcursor: freeing hda at %#lx\n", (long) t->hda)));
  669. X          free(t->hda);
  670. X      }
  671. X      if (t->data != NULL)
  672. X      {
  673. !         DEBUG(128, (fputs("ora_dropcursor: freeing data\n", stderr)));
  674. X          ora_free_data(t);
  675. X      }
  676. X  
  677. !     DEBUG(128, (fprintf(stderr,
  678. !         "ora_dropcursor: freeing csr at %#lx\n", (long) t->csr)));
  679. X      free(t->csr);
  680. X  
  681. X      t = t->next;
  682. !     DEBUG(128, (fprintf(stderr,
  683. !         "ora_dropcursor: freeing cursor at %#lx\n", (long) tmp->next)));
  684. X      free(tmp->next);
  685. X      tmp->next = t;
  686. X  
  687. !     DEBUG(8, (fputs("ora_dropcursor: returning\n", stderr)));
  688. X      return(1);
  689. X  }
  690. X  
  691. --- 175,205 ----
  692. X  
  693. X      if (t->hda != NULL)
  694. X      {
  695. !         DEBUG(128, 0,
  696. !             (fprintf(stderr, "ora_dropcursor: freeing hda at %#lx\n",
  697. !             (long) t->hda)));
  698. X          free(t->hda);
  699. X      }
  700. X      if (t->data != NULL)
  701. X      {
  702. !         DEBUG(128, 0,
  703. !             (fputs("ora_dropcursor: freeing data\n", stderr)));
  704. X          ora_free_data(t);
  705. X      }
  706. X  
  707. !     DEBUG(128, 0,
  708. !         (fprintf(stderr, "ora_dropcursor: freeing csr at %#lx\n",
  709. !         (long) t->csr)));
  710. X      free(t->csr);
  711. X  
  712. X      t = t->next;
  713. !     DEBUG(128, 0,
  714. !         (fprintf(stderr, "ora_dropcursor: freeing cursor at %#lx\n",
  715. !         (long) tmp->next)));
  716. X      free(tmp->next);
  717. X      tmp->next = t;
  718. X  
  719. !     DEBUG(8, -1, (fputs("ora_dropcursor: returning\n", stderr)));
  720. X      return(1);
  721. X  }
  722. X  
  723. ***************
  724. *** 194,207 ****
  725. X   *
  726. X   * This is just here for completeness' sake.
  727. X   * (I suppose we could check the value of hda in dropcursor and droplda
  728. !  * but I don't think it's worth it
  729. X   */
  730. X  
  731. X  int ora_droplda(lda)
  732. X  struct cursor *lda;
  733. X  {
  734. !     DEBUG(8, (fprintf(stderr,
  735. !         "ora_droplda(%#lx): calling ora_dropcursor\n", lda)));
  736. X      return(ora_dropcursor(lda));
  737. X  }
  738. X  
  739. --- 208,222 ----
  740. X   *
  741. X   * This is just here for completeness' sake.
  742. X   * (I suppose we could check the value of hda in dropcursor and droplda
  743. !  * but I don't think it's worth it)
  744. X   */
  745. X  
  746. X  int ora_droplda(lda)
  747. X  struct cursor *lda;
  748. X  {
  749. !     DEBUG(8, 0,
  750. !         (fprintf(stderr, "ora_droplda(%#lx): calling ora_dropcursor\n",
  751. !         lda)));
  752. X      return(ora_dropcursor(lda));
  753. X  }
  754. X  
  755. ***************
  756. *** 218,224 ****
  757. X  
  758. X      tmp = &csr_list;
  759. X  
  760. !     DEBUG(8, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr)));
  761. X  
  762. X      while ((tmp->next != NULL) && (tmp->next != csr))
  763. X      {
  764. --- 233,239 ----
  765. X  
  766. X      tmp = &csr_list;
  767. X  
  768. !     DEBUG(8, 1, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr)));
  769. X  
  770. X      while ((tmp->next != NULL) && (tmp->next != csr))
  771. X      {
  772. ***************
  773. *** 227,237 ****
  774. X  
  775. X      if (tmp->next == NULL)
  776. X      {
  777. !         DEBUG(8, (fputs("ora_findcursor: not valid\n", stderr)));
  778. X          return(0);
  779. X      }
  780. X  
  781. !     DEBUG(8, (fputs("ora_findcursor: valid\n", stderr)));
  782. X      return(1);
  783. X  }
  784. X  
  785. --- 242,252 ----
  786. X  
  787. X      if (tmp->next == NULL)
  788. X      {
  789. !         DEBUG(8, -1, (fputs("ora_findcursor: not a cursor\n", stderr)));
  790. X          return(0);
  791. X      }
  792. X  
  793. !     DEBUG(8, -1, (fputs("ora_findcursor: is a cursor\n", stderr)));
  794. X      return(1);
  795. X  }
  796. X  
  797. ***************
  798. *** 244,259 ****
  799. X   int check_lda(lda)
  800. X   struct cursor *lda;
  801. X   {
  802. !     DEBUG(8, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda)));
  803. X  
  804. X      if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL))
  805. X      {
  806. !         DEBUG(8, (fputs("check_lda: valid\n", stderr)));
  807. X          return (1);
  808. X      }
  809. X      else
  810. X      {
  811. !         DEBUG(8, (fputs("check_lda: invalid\n", stderr)));
  812. X          return (0);
  813. X      }
  814. X  };
  815. --- 259,274 ----
  816. X   int check_lda(lda)
  817. X   struct cursor *lda;
  818. X   {
  819. !     DEBUG(8, 1, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda)));
  820. X  
  821. X      if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL))
  822. X      {
  823. !         DEBUG(8, -1, (fputs("check_lda: is an lda\n", stderr)));
  824. X          return (1);
  825. X      }
  826. X      else
  827. X      {
  828. !         DEBUG(8, -1, (fputs("check_lda: not an lda\n", stderr)));
  829. X          return (0);
  830. X      }
  831. X  };
  832. ***************
  833. *** 267,282 ****
  834. X   int check_csr(csr)
  835. X   struct cursor *csr;
  836. X   {
  837. !     DEBUG(8, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr)));
  838. X  
  839. X      if (ora_findcursor(csr) && (csr->hda == NULL))
  840. X      {
  841. !         DEBUG(8, (fputs("check_csr: valid\n", stderr)));
  842. X          return (1);
  843. X      }
  844. X      else
  845. X      {
  846. !         DEBUG(8, (fputs("check_csr: invalid\n", stderr)));
  847. X          return (0);
  848. X      }
  849. X  };
  850. --- 282,297 ----
  851. X   int check_csr(csr)
  852. X   struct cursor *csr;
  853. X   {
  854. !     DEBUG(8, 1, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr)));
  855. X  
  856. X      if (ora_findcursor(csr) && (csr->hda == NULL))
  857. X      {
  858. !         DEBUG(8, -1, (fputs("check_csr: is a csr\n", stderr)));
  859. X          return (1);
  860. X      }
  861. X      else
  862. X      {
  863. !         DEBUG(8, -1, (fputs("check_csr: not a csr\n", stderr)));
  864. X          return (0);
  865. X      }
  866. X  };
  867. *** ORIG/mkdb.pl    Mon Oct 28 17:12:32 1991
  868. --- ./mkdb.pl    Mon Oct 28 16:47:31 1991
  869. ***************
  870. *** 8,20 ****
  871. X  # Date:        5th August 1991
  872. X  #
  873. X  
  874. ! # let's see what oraperl is doing when it executes this
  875. X  
  876. ! $ora_debug = 136;
  877. X  
  878. X  $CREATE = "create table tryit (name char(10), ext number(3))";
  879. X  $INSERT = "insert into tryit values (:1, :2)";
  880. X  $LIST    = "select * from tryit order by name";
  881. X  $DROP    = "drop table tryit";
  882. X  
  883. X  format top =
  884. --- 8,27 ----
  885. X  # Date:        5th August 1991
  886. X  #
  887. X  
  888. ! # make sure that we really are running oraperl
  889. ! die ("You should use oraperl, not perl\n") unless defined &ora_login;
  890. ! 
  891. ! # get debugging & error codes
  892. ! require('oraperl.ph');
  893. X  
  894. ! # let's see what oraperl is doing when it executes this
  895. ! $ora_debug = $ODBG_EXEC | $ODBG_STRNUM | $ODBG_MALLOC;
  896. X  
  897. + # set these as strings to make the code more readable
  898. X  $CREATE = "create table tryit (name char(10), ext number(3))";
  899. X  $INSERT = "insert into tryit values (:1, :2)";
  900. X  $LIST    = "select * from tryit order by name";
  901. + $DELETE    = "delete from tryit where name = :1";
  902. X  $DROP    = "drop table tryit";
  903. X  
  904. X  format top =
  905. ***************
  906. *** 27,39 ****
  907. X         $name,       $ext
  908. X  .
  909. X  
  910. ! die ("You should use oraperl, not perl\n") unless defined &ora_login;
  911. X  
  912. X  # create the database
  913. X  
  914. X  $lda = &ora_login("t", "kstock", "kstock")    || die $ora_errstr;
  915. ! $csr = &ora_open($lda, $CREATE)            || die $ora_errstr;
  916. ! do ora_close($csr)                || die $ora_errstr;
  917. X  
  918. X  # put some data into it
  919. X  
  920. --- 34,60 ----
  921. X         $name,       $ext
  922. X  .
  923. X  
  924. ! # function to list the database
  925. ! 
  926. ! sub list
  927. ! {
  928. !     local($csr, $name, $ext);
  929. ! 
  930. !     $- = 0;
  931. ! 
  932. !     $csr = &ora_open($lda, $LIST)            || die $ora_errstr;
  933. !     while (($name, $ext) = &ora_fetch($csr))
  934. !     {
  935. !         write;
  936. !     }
  937. !     die $ora_errstr if ($ora_errno != 0);
  938. !     do ora_close($csr)                || die $ora_errstr;
  939. ! }
  940. X  
  941. X  # create the database
  942. X  
  943. X  $lda = &ora_login("t", "kstock", "kstock")    || die $ora_errstr;
  944. ! &ora_do($lda, $CREATE)                || die $ora_errstr;
  945. X  
  946. X  # put some data into it
  947. X  
  948. ***************
  949. *** 45,73 ****
  950. X  }
  951. X  do ora_close($csr)                || die $ora_errstr;
  952. X  
  953. ! # list the result
  954. X  
  955. ! $csr = &ora_open($lda, $LIST)            || die $ora_errstr;
  956. ! while (($name, $ext) = &ora_fetch($csr))
  957. X  {
  958. !     write;
  959. X  }
  960. ! do ora_close($csr)                || die $ora_errstr;
  961. X  
  962. ! # remove the database
  963. X  
  964. ! $csr = &ora_open($lda, $DROP)            || die $ora_errstr;
  965. ! do ora_close($csr)                || die $ora_errstr;
  966. X  do ora_logoff($lda)                || die $ora_errstr;
  967. X  __END__
  968. - david:225
  969. - angela:208
  970. - bruno:302
  971. - albert:294
  972. X  julia:292
  973. ! alison:206
  974. ! arnold:305
  975. X  larry:424
  976. X  catherine:201
  977. X  randall:306
  978. ! susan:307
  979. --- 66,95 ----
  980. X  }
  981. X  do ora_close($csr)                || die $ora_errstr;
  982. X  
  983. ! # check the result
  984. ! do list();
  985. ! 
  986. ! # remove a few lines
  987. X  
  988. ! $csr = &ora_open($lda, $DELETE)            || die $ora_errstr;
  989. ! foreach $name ('catherine', 'angela', 'arnold', 'julia')
  990. X  {
  991. !     &ora_bind($csr, $name)            || die $ora_errstr;
  992. X  }
  993. ! &ora_close($csr)                || die $ora_errstr;
  994. X  
  995. ! # check the result
  996. ! do list();
  997. X  
  998. ! # remove the database and log out
  999. ! $csr = &ora_do($lda, $DROP)            || die $ora_errstr;
  1000. X  do ora_logoff($lda)                || die $ora_errstr;
  1001. + 
  1002. + # This is the data which will go into the database
  1003. X  __END__
  1004. X  julia:292
  1005. ! angela:208
  1006. X  larry:424
  1007. X  catherine:201
  1008. X  randall:306
  1009. ! arnold:305
  1010. *** ORIG/oracle.mus    Mon Oct 28 17:13:02 1991
  1011. --- ./oracle.mus    Mon Oct 28 16:40:49 1991
  1012. ***************
  1013. *** 1,6 ****
  1014. --- 1,9 ----
  1015. X  /* oracle.mus
  1016. X   *
  1017. X   * User subroutine interface to Oracle functions
  1018. +  *
  1019. +  * NOTE: Do not modify oracle.c as it is created automagically from oracle.mus.
  1020. +  *     Modify oracle.mus instead, or your changes will be lost.
  1021. X   */
  1022. X  /* Copyright 1991 Kevin Stock.
  1023. X   *
  1024. ***************
  1025. *** 23,33 ****
  1026. --- 26,38 ----
  1027. X  };
  1028. X  
  1029. X  static enum usersubs {
  1030. +     US_ora_version,
  1031. X      US_ora_login,
  1032. X      US_ora_open,
  1033. X      US_ora_bind,
  1034. X      US_ora_fetch,
  1035. X      US_ora_close,
  1036. +     US_ora_do,
  1037. X      US_ora_logoff,
  1038. X  };
  1039. X  
  1040. ***************
  1041. *** 52,62 ****
  1042. --- 57,69 ----
  1043. X      MAGICVAR("ora_errno",    UV_ora_errno);
  1044. X      MAGICVAR("ora_errstr",    UV_ora_errstr);
  1045. X  
  1046. +     make_usub("ora_version",    US_ora_version,    usersub, filename);
  1047. X      make_usub("ora_login",    US_ora_login,    usersub, filename);
  1048. X      make_usub("ora_open",    US_ora_open,    usersub, filename);
  1049. X      make_usub("ora_bind",    US_ora_bind,    usersub, filename);
  1050. X      make_usub("ora_fetch",    US_ora_fetch,    usersub, filename);
  1051. X      make_usub("ora_close",    US_ora_close,    usersub, filename);
  1052. +     make_usub("ora_do",        US_ora_do,    usersub, filename);
  1053. X      make_usub("ora_logoff",    US_ora_logoff,    usersub, filename);
  1054. X  };
  1055. X  
  1056. ***************
  1057. *** 74,79 ****
  1058. --- 81,89 ----
  1059. X  
  1060. X      switch (ix) {
  1061. X  
  1062. + CASE    void    ora_version
  1063. + END
  1064. + 
  1065. X  CASE    char *    ora_login
  1066. X  I    char *    database
  1067. X  I    char *    name
  1068. ***************
  1069. *** 86,94 ****
  1070. X  END
  1071. X  
  1072. X      case US_ora_fetch:
  1073. !     if (items != 1)
  1074. !         fatal("Usage: @array = &ora_fetch($csr)");
  1075. !     else {
  1076. X          char *csr        = (char *) str_get(st[1]);
  1077. X  
  1078. X          if (curcsv->wantarray) {    /* in array context, return the data */
  1079. --- 96,107 ----
  1080. X  END
  1081. X  
  1082. X      case US_ora_fetch:
  1083. !     if (items != 1) {
  1084. !         if (curcsv->wantarray)
  1085. !             fatal("Usage: @array = &ora_fetch($csr)");
  1086. !         else
  1087. !             fatal("Usage: $nfields = &ora_fetch($csr)");
  1088. !     } else {
  1089. X          char *csr        = (char *) str_get(st[1]);
  1090. X  
  1091. X          if (curcsv->wantarray) {    /* in array context, return the data */
  1092. ***************
  1093. *** 137,142 ****
  1094. --- 150,156 ----
  1095. X              vars[i] = (char *) str_get(st[i+2]);
  1096. X          }
  1097. X          retval = ora_bind(csr, vars, items - 1);
  1098. +         free(vars);
  1099. X          }
  1100. X  
  1101. X          str_numset(st[0], (double) retval);
  1102. ***************
  1103. *** 143,148 ****
  1104. --- 157,167 ----
  1105. X      }
  1106. X      return sp;
  1107. X  
  1108. + CASE    char *    ora_do
  1109. + I    char *    lda
  1110. + I    char *    stmt
  1111. + END
  1112. + 
  1113. X  CASE    char *    ora_close
  1114. X  I    char *    csr
  1115. X  END
  1116. ***************
  1117. *** 182,187 ****
  1118. --- 201,223 ----
  1119. X  }
  1120. X  
  1121. X  
  1122. + /* ora_errlist[] contains error messages corresponding to Oraperl's own
  1123. +  * error codes. These do not include Oracle errors.
  1124. +  */
  1125. + 
  1126. + char *ora_errlist[] =
  1127. + {
  1128. +     "",    /* not used */
  1129. +     "insufficient memory",
  1130. +     "invalid cursor",
  1131. +     "invalid login data area",
  1132. +     "couldn't set ORACLE_SID",
  1133. +     "bad colon variable sequence",
  1134. +     "wrong number of variables",
  1135. +     "statement does not return data",
  1136. + };
  1137. + 
  1138. + 
  1139. X  static int
  1140. X  userval(ix, str)
  1141. X  int ix;
  1142. ***************
  1143. *** 212,254 ****
  1144. X              }
  1145. X              str_set(str, ertxt);
  1146. X          }
  1147. X          else
  1148. X          {
  1149. !             switch (ora_errno)
  1150. !             {
  1151. !             case ORAP_NOMEM:
  1152. !                 str_set(str, "insufficient memory");
  1153. !                 break;
  1154. ! 
  1155. !             case ORAP_INVCSR:
  1156. !                 str_set(str, "invalid cursor");
  1157. !                 break;
  1158. ! 
  1159. !             case ORAP_INVLDA:
  1160. !                 str_set(str, "invalid login data area");
  1161. !                 break;
  1162. ! 
  1163. !             case ORAP_NOSID:
  1164. !                 str_set(str, "couldn't set ORACLE_SID");
  1165. !                 break;
  1166. ! 
  1167. !             case ORAP_BADVAR:
  1168. !                 str_set(str, "bad colon variable sequence");
  1169. !                 break;
  1170. ! 
  1171. !             case ORAP_NUMVARS:
  1172. !                 str_set(str, "wrong number of variables");
  1173. !                 break;
  1174. ! 
  1175. !             default:
  1176. !                 {
  1177. !                 char tmp[30];
  1178. ! 
  1179. !                 sprintf(tmp, "unknown oraperl error %d",
  1180. !                     ora_errno);
  1181. !                 str_set(str, tmp);
  1182. !                 }
  1183. !             }
  1184. X          }
  1185. X      }
  1186. X      break;
  1187. --- 248,261 ----
  1188. X              }
  1189. X              str_set(str, ertxt);
  1190. X          }
  1191. +         else if((ora_errno == ORAP_ERRMIN) || (ora_errno > ORAP_ERRMAX))
  1192. +         {
  1193. +             sprintf(ertxt, "unknown error %d", ora_errno);
  1194. +             str_set(str, ertxt);
  1195. +         }
  1196. X          else
  1197. X          {
  1198. !             str_set(str, ora_errlist[ora_errno - ORAP_ERRMIN]);
  1199. X          }
  1200. X      }
  1201. X      break;
  1202. *** ORIG/orafns.c    Mon Oct 28 17:13:02 1991
  1203. --- ./orafns.c    Mon Oct 28 16:46:10 1991
  1204. ***************
  1205. *** 13,20 ****
  1206. --- 13,35 ----
  1207. X  #include    <stdio.h>
  1208. X  #include    <ctype.h>
  1209. X  #include    "orafns.h"
  1210. + #include    "patchlevel.h"
  1211. X  
  1212. X  
  1213. + /* void    ora_version()
  1214. +  *
  1215. +  * Print out information about Oraperl
  1216. +  */
  1217. + 
  1218. + void    ora_version()
  1219. + {
  1220. +     printf("\nThis is Oraperl, version 1, patch level %d\n\n", PATCHLEVEL);
  1221. +     puts("Perl is copyright by Larry Wall; type oraperl -v for details.");
  1222. +     puts("Modifications for Oraperl: Copyright 1991, Kevin Stock.\n");
  1223. +     puts("Oraperl may be distributed under the same conditions as Perl.");
  1224. + }
  1225. + 
  1226. + 
  1227. X  /* address[] is used to return cursor addresses to the perl program
  1228. X   * it is used so that we can get the addresses exactly right, without
  1229. X   * worrying about rounding errors or playing with oracle.mus
  1230. ***************
  1231. *** 42,49 ****
  1232. X      static    char    *oldsid = NULL,
  1233. X              *newsid = NULL;
  1234. X  
  1235. !     DEBUG(8, (fprintf(stderr, "set_sid(%s)\n",
  1236. !         (database == NULL) ? "<NULL>" : database)));
  1237. X  
  1238. X      if (database != NULL)
  1239. X      {
  1240. --- 57,65 ----
  1241. X      static    char    *oldsid = NULL,
  1242. X              *newsid = NULL;
  1243. X  
  1244. !     DEBUG(8, 1, (fprintf(stderr,
  1245. !         "set_sid(\"%s\")\n",
  1246. !         (database == NULL) ? "<NULL>" : database)));
  1247. X  
  1248. X      if (database != NULL)
  1249. X      {
  1250. ***************
  1251. *** 53,127 ****
  1252. X          {
  1253. X              if  (oldsid != NULL)
  1254. X              {
  1255. !                 DEBUG(128, (fprintf(stderr,
  1256. !                     "set_sid: freeing oldsid (%#lx)\n",
  1257. !                     (long) oldsid)));
  1258. X                  free(oldsid);
  1259. X              }
  1260. X              if ((oldsid = malloc(strlen(sid) + 1)) == NULL)
  1261. X              {
  1262. !                 DEBUG(128, (fputs("set_sid: out of memory\n",
  1263. !                     stderr)));
  1264. !                 DEBUG(8, (fputs("set_sid: returning NOSID\n",
  1265. !                     stderr)));
  1266. X                  ora_errno = ORAP_NOMEM;
  1267. X                  return(NOSID);
  1268. X              }
  1269. !             DEBUG(128, (fprintf(stderr,
  1270. !                 "set_sid: got oldsid at %#lx\n", (long) oldsid)));
  1271. X              strcpy(oldsid, sid);
  1272. X          }
  1273. X  
  1274. X          if (newsid != NULL)
  1275. X          {
  1276. !             DEBUG(128, (fprintf(stderr,
  1277. !                 "set_sid: freeing newsid (%#lx)\n",
  1278. !                 (long) newsid)));
  1279. X              free(newsid);
  1280. X          }
  1281. X          if ((newsid = malloc(strlen(database) + 12)) == NULL)
  1282. X          {
  1283. !             DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
  1284. !             DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
  1285. X              ora_errno = ORAP_NOMEM;
  1286. X              return(NOSID);
  1287. X          }
  1288. !         DEBUG(128, (fprintf(stderr,
  1289. !             "set_sid: got newsid at %#lx\n", (long) newsid)));
  1290. X          strcpy(newsid, "ORACLE_SID=");
  1291. X          strcat(newsid, database);
  1292. X  
  1293. !         DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
  1294. !         return (putenv(newsid)) ? oldsid : NULL;
  1295. X      }
  1296. X      else
  1297. X      {
  1298. X          if (oldsid == NULL)
  1299. X          {
  1300. !             DEBUG(8, (fputs("set_sid: oldsid not set\n", stderr)));
  1301. X              return(NULL);
  1302. X          }
  1303. X  
  1304. X          if (newsid != NULL)
  1305. X          {
  1306. !             DEBUG(128, (fprintf(stderr,
  1307. !                 "set_sid: freeing newsid (%#lx)\n", (long)newsid)));
  1308. X              free(newsid);
  1309. X          }
  1310. X          if ((newsid = malloc(strlen(oldsid) + 12)) == NULL)
  1311. X          {
  1312. !             DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
  1313. !             DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
  1314. X              ora_errno = ORAP_NOMEM;
  1315. X              return(NOSID);
  1316. X          }
  1317. !         DEBUG(128, (fprintf(stderr,
  1318. !             "set_sid: got newsid at %#lx\n", (long) newsid)));
  1319. X          strcpy(newsid, "ORACLE_SID=");
  1320. X          strcat(newsid, oldsid);
  1321. X  
  1322. !         DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
  1323. !         return (putenv(newsid)) ? oldsid : NULL;
  1324. X      }
  1325. X  
  1326. X      /* NOTREACHED */
  1327. --- 69,170 ----
  1328. X          {
  1329. X              if  (oldsid != NULL)
  1330. X              {
  1331. !                 DEBUG(128, 0, (fprintf(stderr,
  1332. !                     "set_sid: freeing oldsid (%#lx)\n",
  1333. !                     (long) oldsid)));
  1334. X                  free(oldsid);
  1335. X              }
  1336. X              if ((oldsid = malloc(strlen(sid) + 1)) == NULL)
  1337. X              {
  1338. !                 DEBUG((8 | 128), -1, (fputs(
  1339. !                     "set_sid: out of memory\n", stderr)));
  1340. X                  ora_errno = ORAP_NOMEM;
  1341. X                  return(NOSID);
  1342. X              }
  1343. !             DEBUG(128, 0, (fprintf(stderr,
  1344. !                 "set_sid: got oldsid %d bytes at %#lx\n",
  1345. !                 strlen(sid) + 1, (long) oldsid)));
  1346. X              strcpy(oldsid, sid);
  1347. X          }
  1348. X  
  1349. X          if (newsid != NULL)
  1350. X          {
  1351. !             DEBUG(128, 0, (fprintf(stderr,
  1352. !                 "set_sid: freeing newsid (%#lx)\n",
  1353. !                 (long) newsid)));
  1354. X              free(newsid);
  1355. X          }
  1356. X          if ((newsid = malloc(strlen(database) + 12)) == NULL)
  1357. X          {
  1358. !             DEBUG((8 | 128), -1, (fputs(
  1359. !                 "set_sid: out of memory\n", stderr)));
  1360. X              ora_errno = ORAP_NOMEM;
  1361. X              return(NOSID);
  1362. X          }
  1363. !         DEBUG(128, 0, (fprintf(stderr,
  1364. !             "set_sid: got newsid %d bytes at %#lx\n",
  1365. !             strlen(database) + 12, (long) newsid)));
  1366. X          strcpy(newsid, "ORACLE_SID=");
  1367. X          strcat(newsid, database);
  1368. X  
  1369. !         DEBUG(8, 0, (fprintf(stderr, "set_sid: setting %s\n",newsid)));
  1370. !         if (putenv(newsid) != 0)
  1371. !         {
  1372. !             DEBUG(8, -1, (fputs(
  1373. !                 "set_sid: putenv() failed\n", stderr)));
  1374. !             ora_errno = ORAP_NOMEM;
  1375. !             return(NOSID);
  1376. !         }
  1377. !         else
  1378. !         {
  1379. !             DEBUG(8, -1, (fprintf(stderr,
  1380. !                 "set_sid: returning \"%s\"\n", oldsid)));
  1381. !             return(oldsid);
  1382. !         }
  1383. X      }
  1384. X      else
  1385. X      {
  1386. X          if (oldsid == NULL)
  1387. X          {
  1388. !             DEBUG(8, -1, (fputs(
  1389. !                 "set_sid: oldsid not set\n", stderr)));
  1390. X              return(NULL);
  1391. X          }
  1392. X  
  1393. X          if (newsid != NULL)
  1394. X          {
  1395. !             DEBUG(128, 0, (fprintf(stderr,
  1396. !                 "set_sid: freeing newsid (%#lx)\n",
  1397. !                 (long)newsid)));
  1398. X              free(newsid);
  1399. X          }
  1400. X          if ((newsid = malloc(strlen(oldsid) + 12)) == NULL)
  1401. X          {
  1402. !             DEBUG((8 | 128), -1, (fputs(
  1403. !                 "set_sid: out of memory\n", stderr)));
  1404. X              ora_errno = ORAP_NOMEM;
  1405. X              return(NOSID);
  1406. X          }
  1407. !         DEBUG(128, 0, (fprintf(stderr,
  1408. !             "set_sid: got newsid %d bytes at %#lx\n",
  1409. !             strlen(oldsid) + 12, (long) newsid)));
  1410. X          strcpy(newsid, "ORACLE_SID=");
  1411. X          strcat(newsid, oldsid);
  1412. X  
  1413. !         DEBUG(8, 0, (fprintf(stderr, "set_sid: setting %s\n",newsid)));
  1414. !         if (putenv(newsid) != 0)
  1415. !         {
  1416. !             DEBUG(8, -1, (fputs(
  1417. !                 "set_sid: putenv() failed\n", stderr)));
  1418. !             ora_errno = ORAP_NOMEM;
  1419. !             return(NOSID);
  1420. !         }
  1421. !         else
  1422. !         {
  1423. !             DEBUG(8, -1, (fprintf(stderr,
  1424. !                 "set_sid: returning \"%s\"\n", oldsid)));
  1425. !             return(oldsid);
  1426. !         }
  1427. X      }
  1428. X  
  1429. X      /* NOTREACHED */
  1430. ***************
  1431. *** 140,164 ****
  1432. X      char *tmp;
  1433. X      struct cursor *lda;
  1434. X  
  1435. !     DEBUG(8, (fprintf(stderr,
  1436. !         "ora_login(%s, %s, %s)\n", database, name, password)));
  1437. X  
  1438. X      if ((lda = ora_getlda()) == NULL)
  1439. X      {
  1440. !         DEBUG(8, (fputs("ora_login: couldn't get an lda\n", stderr)));
  1441. X          return(NULL);
  1442. X      }
  1443. X  
  1444. X      if (set_sid(database) == NOSID)
  1445. X      {
  1446. !         DEBUG(8, (fputs("ora_login: couldn't set database\n", stderr)));
  1447. X          ora_dropcursor(lda);
  1448. X          return(NULL);
  1449. X      }
  1450. X      else if (strcmp(database, getenv("ORACLE_SID")) != 0)
  1451. X      {
  1452. !         DEBUG(8, (fprintf(stderr,"ora_login: ORACLE_SID misset to %s\n",
  1453. !             (tmp = getenv("ORACLE_SID")) ? tmp : NULL)));
  1454. X          ora_dropcursor(lda);
  1455. X          ora_errno = ORAP_NOSID;
  1456. X          return(NULL);
  1457. --- 183,210 ----
  1458. X      char *tmp;
  1459. X      struct cursor *lda;
  1460. X  
  1461. !     DEBUG(8, 1, (fprintf(stderr,
  1462. !         "ora_login(\"%s\", \"%s\", \"%s\")\n", database, name, password)));
  1463. X  
  1464. X      if ((lda = ora_getlda()) == NULL)
  1465. X      {
  1466. !         DEBUG(8, -1, (fputs(
  1467. !             "ora_login: couldn't get an lda\n", stderr)));
  1468. X          return(NULL);
  1469. X      }
  1470. X  
  1471. X      if (set_sid(database) == NOSID)
  1472. X      {
  1473. !         DEBUG(8, -1, (fputs(
  1474. !             "ora_login: couldn't select database\n", stderr)));
  1475. X          ora_dropcursor(lda);
  1476. X          return(NULL);
  1477. X      }
  1478. X      else if (strcmp(database, getenv("ORACLE_SID")) != 0)
  1479. X      {
  1480. !         DEBUG(8, -1, (fprintf(stderr,
  1481. !             "ora_login: ORACLE_SID misset to %s\n",
  1482. !             (tmp = getenv("ORACLE_SID")) ? tmp : "<NULL>")));
  1483. X          ora_dropcursor(lda);
  1484. X          ora_errno = ORAP_NOSID;
  1485. X          return(NULL);
  1486. ***************
  1487. *** 170,177 ****
  1488. X      if (logged == 0)
  1489. X      {
  1490. X          sprintf(address, "%#lx", (long) lda);
  1491. !         DEBUG(8, (fprintf(stderr,
  1492. !             "ora_login: returning lda %s\n", address)));
  1493. X          ora_errno = 0;
  1494. X          return(address);
  1495. X      }
  1496. --- 216,226 ----
  1497. X      if (logged == 0)
  1498. X      {
  1499. X          sprintf(address, "%#lx", (long) lda);
  1500. !         DEBUG(32, 0, (fprintf(stderr,
  1501. !             "ora_login: lda %#lx converted to string \"%s\"\n",
  1502. !             lda, address)));
  1503. !         DEBUG(8, -1, (fprintf(stderr,
  1504. !             "ora_login: returning lda %s\n", address)));
  1505. X          ora_errno = 0;
  1506. X          return(address);
  1507. X      }
  1508. ***************
  1509. *** 179,186 ****
  1510. X      {
  1511. X          ora_errno = lda->csr->csrrc;
  1512. X          ora_droplda(lda);
  1513. !         DEBUG(8, (fprintf(stderr,
  1514. !             "ora_login: failed (error %d)\n", ora_errno)));
  1515. X          return((char *) NULL);
  1516. X      }
  1517. X  }
  1518. --- 228,235 ----
  1519. X      {
  1520. X          ora_errno = lda->csr->csrrc;
  1521. X          ora_droplda(lda);
  1522. !         DEBUG(8, -1, (fprintf(stderr,
  1523. !             "ora_login: failed (error %d)\n", ora_errno)));
  1524. X          return((char *) NULL);
  1525. X      }
  1526. X  }
  1527. ***************
  1528. *** 198,210 ****
  1529. X      int i;
  1530. X      struct cursor *csr;
  1531. X      struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  1532. !     short dbsize;
  1533. X  
  1534. !     DEBUG(8, (fprintf(stderr, "ora_open(%#lx, %s)\n", (long) lda, stmt)));
  1535. X  
  1536. X      if (check_lda(lda) == 0)
  1537. X      {
  1538. !         DEBUG(8, (fputs("ora_open: returning NULL\n", stderr)));
  1539. X          ora_errno = ORAP_INVLDA;
  1540. X          return((char *) NULL);
  1541. X      }
  1542. --- 247,263 ----
  1543. X      int i;
  1544. X      struct cursor *csr;
  1545. X      struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  1546. !     short dsize;
  1547. X  
  1548. !     DEBUG(8, 1, (fprintf(stderr,
  1549. !         "ora_open(%s, \"%s\")\n", lda_s, stmt)));
  1550. !     DEBUG(32, 0, (fprintf(stderr,
  1551. !         "ora_open: string \"%s\" converted to lda %#lx\n",
  1552. !         lda_s, lda)));
  1553. X  
  1554. X      if (check_lda(lda) == 0)
  1555. X      {
  1556. !         DEBUG(8, -1, (fputs("ora_open: invalid lda\n", stderr)));
  1557. X          ora_errno = ORAP_INVLDA;
  1558. X          return((char *) NULL);
  1559. X      }
  1560. ***************
  1561. *** 211,218 ****
  1562. X  
  1563. X      if ((csr = ora_getcursor()) == NULL)
  1564. X      {
  1565. !         /* ora_errno is set by ora_getcursor */
  1566. !         DEBUG(8, (fprintf(stderr, "ora_open: can't get a cursor\n")));
  1567. X          return((char *) NULL);
  1568. X      }
  1569. X  
  1570. --- 264,271 ----
  1571. X  
  1572. X      if ((csr = ora_getcursor()) == NULL)
  1573. X      {
  1574. !         DEBUG(8, -1, (fprintf(stderr,
  1575. !             "ora_open: can't get a cursor\n")));
  1576. X          return((char *) NULL);
  1577. X      }
  1578. X  
  1579. ***************
  1580. *** 221,234 ****
  1581. X       */
  1582. X      if ((csr->varfields = count_colons(stmt)) < 0)
  1583. X      {
  1584. !         DEBUG(8, (fputs("ora_open: invalid variable sequence\n",
  1585. !             stderr)));
  1586. X          ora_errno = ORAP_BADVAR;
  1587. X          return((char *) NULL);
  1588. X      }
  1589. X  
  1590. !     DEBUG(8, (fprintf(stderr,
  1591. !         "ora_open: statement contains %d colons\n", csr->varfields)));
  1592. X  
  1593. X      if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0)
  1594. X          || (osql3(csr->csr, stmt, -1) != 0)
  1595. --- 274,287 ----
  1596. X       */
  1597. X      if ((csr->varfields = count_colons(stmt)) < 0)
  1598. X      {
  1599. !         DEBUG(8, -1, (fputs(
  1600. !             "ora_open: invalid variable sequence\n", stderr)));
  1601. X          ora_errno = ORAP_BADVAR;
  1602. X          return((char *) NULL);
  1603. X      }
  1604. X  
  1605. !     DEBUG(8, 0, (fprintf(stderr,
  1606. !         "ora_open: statement contains %d colons\n", csr->varfields)));
  1607. X  
  1608. X      if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0)
  1609. X          || (osql3(csr->csr, stmt, -1) != 0)
  1610. ***************
  1611. *** 236,243 ****
  1612. X      {
  1613. X          ora_errno = csr->csr->csrrc;
  1614. X          ora_dropcursor(csr);
  1615. !         DEBUG(8, (fprintf(stderr,
  1616. !             "couldn't run SQL statement (error %d)\n", ora_errno)));
  1617. X          return((char *) NULL);
  1618. X      }
  1619. X  
  1620. --- 289,297 ----
  1621. X      {
  1622. X          ora_errno = csr->csr->csrrc;
  1623. X          ora_dropcursor(csr);
  1624. !         DEBUG(8, -1, (fprintf(stderr,
  1625. !             "ora_open: couldn't run SQL statement (error %d)\n",
  1626. !             ora_errno)));
  1627. X          return((char *) NULL);
  1628. X      }
  1629. X  
  1630. ***************
  1631. *** 257,304 ****
  1632. X      {
  1633. X          if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
  1634. X          {
  1635. !             DEBUG(128, (fputs("ora_open: out of memory\n",stderr)));
  1636. !             DEBUG(8, (fputs("ora_open: returning NOMEM\n",stderr)));
  1637. X              ora_errno = ORAP_NOMEM;
  1638. X              ora_dropcursor(csr);
  1639. !             return(0);
  1640. X          }
  1641. !         DEBUG(128, (fprintf(stderr,
  1642. !             "ora_open: got data at %#lx\n",csr->data)));
  1643. X          csr->nfields = i;
  1644. X  
  1645. X          for (i = 0 ; i < csr->nfields ; i++)
  1646. X          {
  1647. !             odsc(csr->csr, i + 1, &dbsize, (short *) 0, (short *) 0,
  1648. !                 (short *) 0, (char *) 0, (short *) 0, (short *) 0);
  1649. X  
  1650. !             if ((csr->data[i] = (char *) malloc(dbsize+1)) == NULL)
  1651. X              {
  1652. X                  csr->nfields = i;
  1653. X                  ora_dropcursor(csr);
  1654. !                 DEBUG(128, (fputs("ora_open: out of memory\n",
  1655. !                     stderr)));
  1656. !                 DEBUG(8, (fputs("ora_open: returning NOMEM\n",
  1657. !                     stderr)));
  1658. X                  ora_errno = ORAP_NOMEM;
  1659. X                  return((char *) NULL);
  1660. X              }
  1661. !             DEBUG(128, (fprintf(stderr,
  1662. !                 "ora_open: got field %d at %#lx\n",
  1663. !                 i, csr->data[i])));
  1664. !             odefin(csr->csr, i + 1, csr->data[i], dbsize + 1, 5, 0,
  1665. X                  (short *) 0, (char *) 0, 0, 0, (short *) 0,
  1666. !                 (char *) 0);
  1667. X          }
  1668. X      }
  1669. X      else
  1670. X      {
  1671. !         DEBUG(128, (fputs("ora_open: no data to return\n", stderr)));
  1672. X          csr->data = NULL;
  1673. X      }
  1674. X  
  1675. X      sprintf(address, "%#lx", (long) csr);
  1676. !     DEBUG(8, (fprintf(stderr, "ora_open: returning csr %s\n", address)));
  1677. X      return(address);
  1678. X  }
  1679. X  
  1680. --- 311,377 ----
  1681. X      {
  1682. X          if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
  1683. X          {
  1684. !             ora_dropcursor(csr);
  1685. !             DEBUG((8 | 128), -1, (fputs(
  1686. !                 "ora_open: out of memory\n", stderr)));
  1687. X              ora_errno = ORAP_NOMEM;
  1688. +             return((char *) NULL);
  1689. +         }
  1690. +         DEBUG(128, 0, (fprintf(stderr,
  1691. +             "ora_open: got data array %d items %d bytes at %#lx\n",
  1692. +             i, i * sizeof(char *), (long) csr->data)));
  1693. + 
  1694. +         if ((csr->rcode = (short *) malloc(i * sizeof(short))) == NULL)
  1695. +         {
  1696. X              ora_dropcursor(csr);
  1697. !             DEBUG((8 | 128), -1, (fputs(
  1698. !                 "ora_open: out of memory\n", stderr)));
  1699. !             ora_errno = ORAP_NOMEM;
  1700. !             return((char *) NULL);
  1701. X          }
  1702. !         DEBUG(128, 0, (fprintf(stderr,
  1703. !             "ora_open: got rcode array %d items %d bytes at %#lx\n",
  1704. !             i, i * sizeof(short), (long) csr->rcode)));
  1705. ! 
  1706. X          csr->nfields = i;
  1707. X  
  1708. X          for (i = 0 ; i < csr->nfields ; i++)
  1709. X          {
  1710. !             odsc(csr->csr, i + 1, (short *) 0, (short *) 0,
  1711. !                 (short *) 0, (short *) 0, (char *) 0, (short *) 0,
  1712. !                 &dsize);
  1713. X  
  1714. !             if ((csr->data[i] = (char *) malloc(dsize+1)) == NULL)
  1715. X              {
  1716. X                  csr->nfields = i;
  1717. X                  ora_dropcursor(csr);
  1718. !                 DEBUG((8 | 128), -1, (fputs(
  1719. !                     "ora_open: out of memory\n", stderr)));
  1720. X                  ora_errno = ORAP_NOMEM;
  1721. X                  return((char *) NULL);
  1722. X              }
  1723. !             DEBUG(128, 0, (fprintf(stderr,
  1724. !                 "ora_open: got field %d, %d bytes at %#lx\n",
  1725. !                 i, dsize + 1, csr->data[i])));
  1726. ! 
  1727. !             odefin(csr->csr, i + 1, csr->data[i], dsize + 1, 5, 0,
  1728. X                  (short *) 0, (char *) 0, 0, 0, (short *) 0,
  1729. !                 &(csr->rcode[i]));
  1730. X          }
  1731. X      }
  1732. X      else
  1733. X      {
  1734. !         DEBUG(8, 0, (fputs(
  1735. !             "ora_open: statement returns no data\n", stderr)));
  1736. X          csr->data = NULL;
  1737. X      }
  1738. X  
  1739. X      sprintf(address, "%#lx", (long) csr);
  1740. !     DEBUG(32, 0, (fprintf(stderr,
  1741. !         "ora_open: csr %#lx converted to string \"%s\"\n",
  1742. !         csr, address)));
  1743. !     DEBUG(8, -1, (fprintf(stderr,
  1744. !         "ora_open: returning csr \"%s\"\n", address)));
  1745. X      return(address);
  1746. X  }
  1747. X  
  1748. ***************
  1749. *** 311,339 ****
  1750. X  int ora_fetch(csr_s)
  1751. X  char *csr_s;
  1752. X  {
  1753. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1754. X  
  1755. !     DEBUG(8, (fprintf(stderr, "ora_fetch(%#lx)\n", (long) csr)));
  1756. X  
  1757. X      if (check_csr(csr) == 0)
  1758. X      {
  1759. !         DEBUG(8, (fputs("ora_fetch: returning NULL\n", stderr)));
  1760. X          ora_errno = ORAP_INVCSR;
  1761. !         return(NULL);
  1762. X      }
  1763. X  
  1764. !     if ((csr->nfields == 0) || (ofetch(csr->csr) != 0))
  1765. X      {
  1766. !         DEBUG(8, (fputs("ora_fetch: ofetch failed, returing 0\n",
  1767. !             stderr)));
  1768. !         ora_result = NULL;
  1769. !         ora_errno = csr->csr->csrrc;
  1770. X          return(0);
  1771. X      }
  1772. X  
  1773. X      ora_result = csr->data;
  1774. X      ora_errno = 0;
  1775. -     DEBUG(8, (fprintf(stderr,"ora_fetch: returning <%d>\n", csr->nfields)));
  1776. X      return(csr->nfields);
  1777. X  }
  1778. X  
  1779. --- 384,472 ----
  1780. X  int ora_fetch(csr_s)
  1781. X  char *csr_s;
  1782. X  {
  1783. +     int i;
  1784. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1785. X  
  1786. !     DEBUG(8, 1, (fprintf(stderr,
  1787. !         "ora_fetch(%s)\n", csr_s)));
  1788. !     DEBUG(32, 0, (fprintf(stderr,
  1789. !         "ora_fetch: string \"%s\" converted to csr %#lx\n",
  1790. !         csr_s, csr)));
  1791. X  
  1792. X      if (check_csr(csr) == 0)
  1793. X      {
  1794. !         DEBUG(8, -1, (fputs("ora_fetch: not a csr\n", stderr)));
  1795. X          ora_errno = ORAP_INVCSR;
  1796. !         return(0);
  1797. X      }
  1798. +     else if (csr->nfields == 0)
  1799. +     {
  1800. +         DEBUG(8, -1, (fputs("ora_fetch: no data to return\n", stderr)));
  1801. +         ora_errno = ORAP_NODATA;
  1802. +         return(0);
  1803. +     }
  1804. X  
  1805. !     if ((i = ofetch(csr->csr)) == 4)
  1806. X      {
  1807. !         DEBUG(8, -1, (fputs("ora_fetch: end of data\n", stderr)));
  1808. !         ora_errno = 0;
  1809. X          return(0);
  1810. X      }
  1811. +     else if (i != 0)
  1812. +     {
  1813. +         for (i = 0 ; i < csr->nfields ; i++)
  1814. +         {
  1815. +             switch (csr->rcode[i])
  1816. +             {
  1817. +             case 0:        /* no problem */
  1818. +                 break;
  1819. + 
  1820. +             case 1405:
  1821. +                 DEBUG(8, 0, (fprintf(stderr,
  1822. +                     "ora_fetch: field %d was NULL\n", i)));
  1823. +                 *csr->data[i] = '\0';
  1824. +                 break;
  1825. + 
  1826. +             case 1406:
  1827. +                 DEBUG(8, -1, (fprintf(stderr,
  1828. +                     "ora_fetch: field %d was truncated\n", i)));
  1829. +                 ora_errno = csr->csr->csrrc;
  1830. +                 return(0);
  1831. + 
  1832. +             default:    /* others should not happen */
  1833. +                 DEBUG(8, -1, (fprintf(stderr,
  1834. +                     "ora_fetch: ofetch error %d on field %d\n",
  1835. +                     csr->rcode[i], i)));
  1836. +                 ora_errno = csr->csr->csrrc;
  1837. +                 return(0);
  1838. +             }
  1839. +         }
  1840. + 
  1841. +         /* if we fall out here, all errors were corrected */
  1842. +     }
  1843. X  
  1844. + #ifdef    DEBUGGING
  1845. +     /* NOTE: use the DEBUG macro for printing even here in case
  1846. +      *     the debug output format is changed later
  1847. +      */
  1848. + 
  1849. +     if (ora_debug & 8)
  1850. +     {
  1851. +         int i;
  1852. + 
  1853. +         DEBUG(8, 0, (fputs("ora_fetch: returning data:\n", stderr)));
  1854. +         for (i = 0 ; i < csr->nfields ; i++)
  1855. +         {
  1856. +             DEBUG(8, 0, (fprintf(stderr,
  1857. +                 "ora_fetch: field %4d data \"%s\"\n",
  1858. +                 i, csr->data[i])));
  1859. +         }
  1860. +     }
  1861. + #endif
  1862. +     DEBUG(8, -1, (fprintf(stderr,
  1863. +         "ora_fetch: returning %d items\n", csr->nfields)));
  1864. X      ora_result = csr->data;
  1865. X      ora_errno = 0;
  1866. X      return(csr->nfields);
  1867. X  }
  1868. X  
  1869. ***************
  1870. *** 350,369 ****
  1871. X      int i, ret;
  1872. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1873. X  
  1874. !     DEBUG(8, (fprintf(stderr, "ora_bind(%#lx, %#lx, %d)\n",
  1875. !         (long) csr, (long) vars, nitems)));
  1876. X  
  1877. X      if (check_csr(csr) == 0)
  1878. X      {
  1879. !         DEBUG(8, (fputs("ora_bind: returning 0\n", stderr)));
  1880. X          ora_errno = ORAP_INVCSR;
  1881. X          return(0);
  1882. X      }
  1883. ! 
  1884. !     if (csr->varfields != nitems)
  1885. X      {
  1886. !         DEBUG(8, (fprintf("ora_bind: expected %d items, got %d\n",
  1887. !             csr->varfields, nitems)));
  1888. X          ora_errno = ORAP_NUMVARS;
  1889. X          return(0);
  1890. X      }
  1891. --- 483,504 ----
  1892. X      int i, ret;
  1893. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1894. X  
  1895. !     DEBUG(8, 1, (fprintf(stderr,
  1896. !         "ora_bind(%s, %#lx, %d)\n", csr_s, (long) vars, nitems)));
  1897. !     DEBUG(32, 0, (fprintf(stderr,
  1898. !         "ora_bind: string \"%s\" converted to csr %#lx\n", csr_s,csr)));
  1899. X  
  1900. X      if (check_csr(csr) == 0)
  1901. X      {
  1902. !         DEBUG(8, -1, (fputs("ora_bind: not a csr\n", stderr)));
  1903. X          ora_errno = ORAP_INVCSR;
  1904. X          return(0);
  1905. X      }
  1906. !     else if (csr->varfields != nitems)
  1907. X      {
  1908. !         DEBUG(8, -1, (fprintf(
  1909. !             "ora_bind: expected %d items, got %d\n",
  1910. !             csr->varfields, nitems)));
  1911. X          ora_errno = ORAP_NUMVARS;
  1912. X          return(0);
  1913. X      }
  1914. ***************
  1915. *** 373,401 ****
  1916. X          if ((ret = obndrn(csr->csr, i+1, vars[i], strlen(vars[i])+1,
  1917. X              5, -1, (short *) -1, (char *) -1, 0, 0)) != 0)
  1918. X          {
  1919. X              ora_errno = csr->csr->csrrc;
  1920. -             DEBUG(8, (fputs("ora_bind: returning 0\n", stderr)));
  1921. X              return(0);
  1922. X          }
  1923. X  
  1924. !         DEBUG(8, (fprintf(stderr, "ora_bind: obndrv %d %s OK\n",
  1925. !             i + 1, vars[i])));
  1926. X      }
  1927. X  
  1928. X      if (oexec(csr->csr) != 0)
  1929. X      {
  1930. X          ora_errno = csr->csr->csrrc;
  1931. -         DEBUG(8, (fputs("ora_bind: returning 0\n", stderr)));
  1932. X          return(0);
  1933. X      }
  1934. X  
  1935. !     DEBUG(8, (fputs("ora_bind: oexec successful\n", stderr)));
  1936. !     DEBUG(8, (fputs("ora_bind: returning 1\n", stderr)));
  1937. X      return(1);
  1938. X  }
  1939. X  
  1940. X  
  1941. ! char    *OK    = "OK";        /* valid return from ora_close, ora_logoff */
  1942. X  
  1943. X  /* ora_close(csr)
  1944. X   *
  1945. --- 508,572 ----
  1946. X          if ((ret = obndrn(csr->csr, i+1, vars[i], strlen(vars[i])+1,
  1947. X              5, -1, (short *) -1, (char *) -1, 0, 0)) != 0)
  1948. X          {
  1949. +             DEBUG(8, -1, (fprintf(stderr,
  1950. +                 "ora_bind: obndrn failed on field %d, \"%s\"\n",
  1951. +                 i + 1, vars[i])));
  1952. X              ora_errno = csr->csr->csrrc;
  1953. X              return(0);
  1954. X          }
  1955. X  
  1956. !         DEBUG(8, 0, (fprintf(stderr,
  1957. !             "ora_bind: obndrn %d, \"%s\" OK\n", i + 1, vars[i])));
  1958. X      }
  1959. X  
  1960. X      if (oexec(csr->csr) != 0)
  1961. X      {
  1962. +         DEBUG(8, -1, (fputs("ora_bind: oexec failed\n", stderr)));
  1963. X          ora_errno = csr->csr->csrrc;
  1964. X          return(0);
  1965. X      }
  1966. X  
  1967. !     DEBUG(8, -1, (fputs("ora_bind: returning\n", stderr)));
  1968. X      return(1);
  1969. X  }
  1970. X  
  1971. X  
  1972. ! char    *OK    = "OK";        /* valid return from ora_close/do/logoff */
  1973. ! 
  1974. ! 
  1975. ! /* ora_do(lda, stmt)
  1976. !  *
  1977. !  * sets and executes the specified sql statement, without leaving a cursor open
  1978. !  */
  1979. ! 
  1980. ! char *ora_do(lda_s, stmt)
  1981. ! char *lda_s;
  1982. ! char *stmt;
  1983. ! {
  1984. !     char *csr_s;
  1985. ! 
  1986. !     DEBUG(8, 1, (fprintf(stderr,
  1987. !         "ora_do(%s, \"%s\")\n", lda_s, stmt)));
  1988. ! 
  1989. !     if ((csr_s = ora_open(lda_s, stmt)) == NULL)
  1990. !     {
  1991. !         DEBUG(8, -1, (fprintf(stderr, "ora_do: ora_open failed\n")));
  1992. !         return(NULL);
  1993. !     }
  1994. !     else if (ora_close(csr_s) == NULL)
  1995. !     {
  1996. !         DEBUG(8, -1, (fprintf(stderr, "ora_do: ora_close failed\n")));
  1997. !         return(NULL);
  1998. !     }
  1999. !     else
  2000. !     {
  2001. !         DEBUG(8, -1, (fprintf(stderr, "ora_do: successful\n")));
  2002. !         return(OK);
  2003. !     }
  2004. ! 
  2005. !     /* NOTREACHED */
  2006. ! }
  2007. ! 
  2008. X  
  2009. X  /* ora_close(csr)
  2010. X   *
  2011. ***************
  2012. *** 407,417 ****
  2013. X  {
  2014. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  2015. X  
  2016. !     DEBUG(8, (fprintf(stderr, "ora_close(%#lx)\n", (long) csr)));
  2017. X  
  2018. X      if (check_csr(csr) == 0)
  2019. X      {
  2020. !         DEBUG(8, (fputs("ora_close: returning NULL\n", stderr)));
  2021. X          ora_errno = ORAP_INVCSR;
  2022. X          return(NULL);
  2023. X      }
  2024. --- 578,592 ----
  2025. X  {
  2026. X      struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  2027. X  
  2028. ! 
  2029. !     DEBUG(8, 1, (fprintf(stderr, "ora_close(%s)\n", csr_s)));
  2030. !     DEBUG(32, 0, (fprintf(stderr,
  2031. !         "ora_close: string \"%s\" converted to csr %#lx\n",
  2032. !         csr_s, csr)));
  2033. X  
  2034. X      if (check_csr(csr) == 0)
  2035. X      {
  2036. !         DEBUG(8, -1, (fputs("ora_close: not a csr\n", stderr)));
  2037. X          ora_errno = ORAP_INVCSR;
  2038. X          return(NULL);
  2039. X      }
  2040. ***************
  2041. *** 420,426 ****
  2042. X      ora_errno = csr->csr->csrrc;
  2043. X      ora_dropcursor(csr);
  2044. X  
  2045. !     DEBUG(8, (fputs("ora_close: returning OK\n", stderr)));
  2046. X      return(OK);
  2047. X  }
  2048. X  
  2049. --- 595,601 ----
  2050. X      ora_errno = csr->csr->csrrc;
  2051. X      ora_dropcursor(csr);
  2052. X  
  2053. !     DEBUG(8, -1, (fputs("ora_close: returning OK\n", stderr)));
  2054. X      return(OK);
  2055. X  }
  2056. X  
  2057. ***************
  2058. *** 435,445 ****
  2059. X  {
  2060. X      struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  2061. X  
  2062. !     DEBUG(8, (fprintf(stderr, "ora_logoff(%#lx)\n", (long) lda)));
  2063. X  
  2064. X      if (check_lda(lda) == 0)
  2065. X      {
  2066. !         DEBUG(8, (fputs("ora_logoff: returning NULL\n", stderr)));
  2067. X          ora_errno = ORAP_INVLDA;
  2068. X          return(NULL);
  2069. X      }
  2070. --- 610,623 ----
  2071. X  {
  2072. X      struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  2073. X  
  2074. !     DEBUG(8, 1, (fprintf(stderr, "ora_logoff(%s)\n", lda_s)));
  2075. !     DEBUG(32, 0, (fprintf(stderr,
  2076. !         "ora_logoff: string \"%s\" converted to lda %#lx\n",
  2077. !         lda_s, lda)));
  2078. X  
  2079. X      if (check_lda(lda) == 0)
  2080. X      {
  2081. !         DEBUG(8, -1, (fputs("ora_logoff: not an lda\n", stderr)));
  2082. X          ora_errno = ORAP_INVLDA;
  2083. X          return(NULL);
  2084. X      }
  2085. ***************
  2086. *** 448,453 ****
  2087. X      ora_errno = lda->csr->csrrc;
  2088. X      ora_droplda(lda);
  2089. X  
  2090. !     DEBUG(8, (fputs("ora_logoff: returning OK\n", stderr)));
  2091. X      return(OK);
  2092. X  }
  2093. --- 626,631 ----
  2094. X      ora_errno = lda->csr->csrrc;
  2095. X      ora_droplda(lda);
  2096. X  
  2097. !     DEBUG(8, -1, (fputs("ora_logoff: returning OK\n", stderr)));
  2098. X      return(OK);
  2099. X  }
  2100. *** ORIG/orafns.h    Mon Oct 28 17:13:03 1991
  2101. --- ./orafns.h    Mon Oct 28 16:38:53 1991
  2102. ***************
  2103. *** 15,20 ****
  2104. --- 15,21 ----
  2105. X  char        *ora_login(),
  2106. X          *ora_open(),
  2107. X          *ora_close(),
  2108. +         *ora_do(),
  2109. X          *ora_logoff();
  2110. X  
  2111. X  int        ora_bind(),
  2112. ***************
  2113. *** 67,72 ****
  2114. --- 68,74 ----
  2115. X      struct    csrdef    *csr;
  2116. X      char        *hda,        /* used if this cursor is an lda     */
  2117. X              **data;        /* used to receive database contents */
  2118. +     short        *rcode;        /* used to receive fetch error codes */
  2119. X      int        nfields,    /* number of fields to retrieve         */
  2120. X              varfields;    /* number of modifiable variables    */
  2121. X      struct    cursor    *next;        /* list pointer                 */
  2122. ***************
  2123. *** 99,105 ****
  2124. --- 101,112 ----
  2125. X   *
  2126. X   * At present, the only flags used are:
  2127. X   *       8    program execution - report function entry and exit
  2128. +  *      32    conversion between strings and numbers
  2129. +  *        (in this case, the numbers are cursor addresses)
  2130. X   *     128    use of malloc/free
  2131. +  *
  2132. +  * My apologies if you dislike the DEBUG macro, but I wanted to improve the
  2133. +  * readability of the debugging traces that came out.
  2134. X   */
  2135. X  
  2136. X  #ifdef    PERL_DEBUGGING
  2137. ***************
  2138. *** 109,122 ****
  2139. X  #endif
  2140. X  
  2141. X  #ifdef    DEBUGGING
  2142. ! #    define    DEBUG(flag, stmt)    { if (ora_debug & flag) { (stmt); } }
  2143. X  #    ifdef    PERL_DEBUGGING
  2144. !         extern    int    debug;    /* exists in uperl.o        */
  2145. ! #    else
  2146. !         EXT    int    debug;    /* need to create it ourselves    */
  2147. X  #    endif
  2148. X  #else
  2149. ! #    define    DEBUG(flag, stmt)
  2150. X  #endif
  2151. X  
  2152. X  
  2153. --- 116,141 ----
  2154. X  #endif
  2155. X  
  2156. X  #ifdef    DEBUGGING
  2157. !     EXT    int    __debug_level__        INIT(1);
  2158. ! 
  2159. ! #    define    DEBUG(flag, change, stmt)                \
  2160. !     {                                \
  2161. !         if ((ora_debug & 8) && ((change) > 0))            \
  2162. !             { __debug_level__ += 2 * (change); }        \
  2163. !         if (ora_debug & (flag))                    \
  2164. !         {                            \
  2165. !             fprintf(stderr, "OP:%*s", __debug_level__, "");    \
  2166. !             (stmt);                        \
  2167. !         }                            \
  2168. !         if ((ora_debug & 8) && ((change) < 0))            \
  2169. !             { __debug_level__ += 2 * (change); }        \
  2170. !     }
  2171. ! 
  2172. X  #    ifdef    PERL_DEBUGGING
  2173. !         extern    int    debug;    /* -D flag from uperl.o        */
  2174. X  #    endif
  2175. X  #else
  2176. ! #    define    DEBUG(flag, change, stmt)    /* nothing */
  2177. X  #endif
  2178. X  
  2179. X  
  2180. ***************
  2181. *** 134,136 ****
  2182. --- 153,158 ----
  2183. X  #define    ORAP_NOSID    100004    /* couldn't set ORACLE_SID        */
  2184. X  #define    ORAP_BADVAR    100005    /* bad colon variable sequence        */
  2185. X  #define    ORAP_NUMVARS    100006    /* wrong number of colon variables    */
  2186. + #define    ORAP_NODATA    100007    /* statement does not return data    */
  2187. + 
  2188. + #define    ORAP_ERRMAX    ORAP_NODATA    /* highest value actually used    */
  2189. *** ORIG/oraperl.1    Mon Oct 28 17:13:03 1991
  2190. --- ./oraperl.1    Mon Oct 28 14:22:43 1991
  2191. ***************
  2192. *** 6,16 ****
  2193. --- 6,19 ----
  2194. X  oraperl \- Perl access to Oracle databases
  2195. X  .SH SYNOPSIS
  2196. X  .nf
  2197. + &ora_version
  2198. + 
  2199. X  $lda = &ora_login($database, $name, $password)
  2200. X  $csr = &ora_open($lda, $stmt)
  2201. X  &ora_bind($csr, $var, ...)
  2202. X  &ora_fetch($csr)
  2203. X  &ora_close($csr)
  2204. + &ora_do($lda, $stmt)
  2205. X  &ora_logoff($lda)
  2206. X  
  2207. X  $ora_debug
  2208. ***************
  2209. *** 22,27 ****
  2210. --- 25,33 ----
  2211. X  which has been extended (through the \fIusersubs\fP feature)
  2212. X  to allow access to \fIOracle\fP databases.
  2213. X  .SH Functions
  2214. + The \fIora_version\fP function
  2215. + prints the version number and copyright information concerning Oraperl.
  2216. + 
  2217. X  Any program wishing to access an \fIOracle\fP database
  2218. X  must first log in to \fIOracle\fP
  2219. X  using \fIora_login\fP.
  2220. ***************
  2221. *** 32,48 ****
  2222. X  (an \fIORACLE Login Data Area\fP).
  2223. X  
  2224. X  To specify the \fISQL\fP statement to be executed,
  2225. ! the program must call \fIora_open\fP.
  2226. ! This function takes two parameters:
  2227. X  a login identifier (obtained from \fIora_login\fP)
  2228. X  and the \fISQL\fP statement to be executed.
  2229. SHAR_EOF
  2230. true || echo 'restore of Patch03 failed'
  2231. fi
  2232. echo 'End of  part 1'
  2233. echo 'File Patch03 is continued in part 2'
  2234. echo 2 > _shar_seq_.tmp
  2235. exit 0
  2236. exit 0 # Just in case...
  2237. -- 
  2238. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  2239. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  2240. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  2241. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  2242.