Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / oraperl / patch03a next >

Wrap

Text File | 1991-11-11 | 57.4 KB | 2,242 lines

Newsgroups: comp.sources.misc From: kstock@gouldfr.encore.fr (Kevin Stock) Subject: v25i035: oraperl - Extensions to Perl to access Oracle databases, Patch03a/2 Message-ID: <csm-v25i035=oraperl.113826@sparky.IMD.Sterling.COM> X-Md4-Signature: 1a78659a7a8b571d548075c05e76fd42 Date: Sun, 10 Nov 1991 17:40:25 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: kstock@gouldfr.encore.fr (Kevin Stock) Posting-number: Volume 25, Issue 35 Archive-name: oraperl/patch03a Environment: Perl, Oracle Patch-To: oraperl: Volume 18, Issue 10 This is Patch 03 for Oraperl, a set of usersubs which allow Perl to access Oracle databases. You need Perl (v3.0.27 or better) and Oracle (including the Oracle Call Interface) to build Oraperl. Oraperl appeared in comp.sources.misc as follows: v18i010 original v20i097 patch 01 v22i058 patch 02 Details of Patch 03 ------------------- Changes ------- Fixed a bug in allocating the data buffers, notably affecting DATE fields Fixed a bug in not freeing the space for ora_bind parameters Fixed a bug in creating a "debug" variable when it wasn't needed Improved debugging output, added support for flag 32 (string/numeric conversion) Improved handling of $ora_errstr Added configuration flags for various things to the Makefile Added targets listing and docs to the Makefile Added the &ora_version() function, analagous to Perl's -v flag. Added the &ora_do() function, equivalent to &ora_close(&ora_open(...)) Added handling of NULL values returned from the database Added an 'oraperl.ph' file What to do ---------- To apply this patch, unshar the shar file which follows. This will create the following files: Patch03 oraperl.ph patchlevel.h If for an earlier version of Oraperl you changed str_2mortal() to str_2static() in oracle.mus (for Perl v3), please change it back! Run the file Patch03 through the patch program. Fix anything you need for your system in the Makefile. Then read README and run make. Note that the when you do a "make clean" it will demolish the old PATCHLEVEL file. This is correct. Acknowledgements ---------------- Thanks to Alec Muffett (of "crack" fame), Robert Chansky and others for helping me to understand the problem with DATEs and NULL fields, and for pointing out the difference between dsize and dbsize. A Philosophical Note -------------------- When Oraperl was first released, I received mail from two people. After the first patch, there were four more. After the second, there were about another eight. Is the value of software _really_ in exponential proportion to the number of patches :-). Maybe that's why people like Perl so much! Kevin kstock@gouldfr.encore.fr, kstock@encore.com -------- #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 11/10/1991 17:31 UTC by kent@sparky.IMD.Sterling.COM # Source directory /home/kent/mod/csm/queue/Noraperl/repack # # existing files will NOT be overwritten unless -c is specified # # This is part 1 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 67801 -rw-r--r-- Patch03 # 703 -rw-r--r-- oraperl.ph # 41 -rw-r--r-- patchlevel.h # if test -r _shar_seq_.tmp; then echo 'Must unpack archives in sequence!' echo Please unpack part `cat _shar_seq_.tmp` next exit 1 fi # ============= Patch03 ============== if test -f 'Patch03' -a X"$1" != X"-c"; then echo 'x - skipping Patch03 (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting Patch03 (Text)' sed 's/^X//' << 'SHAR_EOF' > 'Patch03' && *** ORIG/CHANGES Mon Oct 28 17:13:00 1991 --- ./CHANGES Mon Oct 28 15:16:30 1991 *************** *** 14,16 **** --- 14,30 ---- X Added support for dynamically modifiable SQL statements X Added a Hints file X Corrected an error in the quick-reference sheet + + Patch 03 + ======== + Fixed a bug in allocating the data buffers, notably affecting DATE fields + Fixed a bug in not freeing the space for ora_bind parameters + Fixed a bug in creating a "debug" variable when it wasn't needed + Improved debugging output, added support for flag 32 (string/numeric conversion) + Improved handling of $ora_errstr + Added configuration flags for various things to the Makefile + Added targets listing and docs to the Makefile + Added the &ora_version() function, analagous to Perl's -v flag. + Added the &ora_do() function, equivalent to &ora_close(&ora_open(...)) + Added handling of NULL values returned from the database + Added an 'oraperl.ph' file *** ORIG/Hints Mon Oct 28 17:12:29 1991 --- ./Hints Mon Oct 28 15:22:35 1991 *************** *** 1,4 **** - X This file contains hints and tips about Oraperl, dealing with problems which X have arisen in the past. X --- 1,3 ---- *************** *** 6,31 **** X Retrieving Dates X ================ X ! If you want to retrieve a field which is declared as an Oracle DATE, then you ! must explicitly format it using the SQL*Plus TO_CHAR function, for example: ! ! $csr = &ora_open($lda, "select to_char(sysdate, 'DD/MM/YY') from dual") ! ! Otherwise, Oracle tells Oraperl that the field only occupies seven bytes, ! and a truncation error occurs when the field is fetched. This causes ! &ora_fetch() to return an error. X - I hope to correct this in a future patch. X - X Building on a Convex machine X ============================ X ! The strtol() function used at the start of most of the functions in orafns.c ! and in oracle.mus must be replaced by strtoul() to allow larger addresses to ! be converted. X ! The putenv() function used in set_sid() must be replaced by setenv() . X X X Using Bind Variables --- 5,27 ---- X Retrieving Dates X ================ X ! Due to a bug in earlier versions of Oraperl, it was not possible to return ! a DATE field in default format. This has been corrected in patch 3. You may ! still wish to use Oracle's to_char() function for greater control over the ! format in which the date is returned. X X X Building on a Convex machine X ============================ X ! Uncomment the definitions of STRTOL and PUTENV in the Makefile. ! ! ! Building with Perl v3 ! ===================== X ! Ideally, get hold of v4. However, if you have to work with v3, uncomment ! the definition of STR_2MORTAL in the Makefile. X X X Using Bind Variables *** ORIG/Makefile Mon Oct 28 17:13:00 1991 --- ./Makefile Mon Oct 28 15:25:35 1991 *************** *** 3,9 **** X # Change these to your ORACLE installation directory and Perl source directory X X ORACLE_HOME = /usr/soft/oracle ! SRC = /usr/soft/public/perl_4.0.10 X X # Oracle Definitions, taken from proc.mk X --- 3,9 ---- X # Change these to your ORACLE installation directory and Perl source directory X X ORACLE_HOME = /usr/soft/oracle ! SRC = /usr/soft/public/perl X X # Oracle Definitions, taken from proc.mk X *************** *** 25,38 **** X # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h) X X DEBUG = -DPERL_DEBUGGING - CFLAGS = $(DEBUG) -I$(SRC) $(GLOBINCS) -O X ! SRCS = usersub.c oracle.c orafns.c getcursor.c colons.c X OBJS = usersub.o oracle.o orafns.o getcursor.o colons.o ! HDRS = orafns.h X X oraperl: $(SRC)/uperl.o $(OBJS) ! cc -o oraperl $(SRC)/uperl.o $(OBJS) \ X -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS) X X oracle.c: $(SRC)/usub/mus oracle.mus --- 25,53 ---- X # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h) X X DEBUG = -DPERL_DEBUGGING X ! # Some system-specific things ! # ! # If you have setenv() instead of putenv(), uncomment the next line ! # PUTENV = -Dputenv=setenv ! # ! # If you have strtoul(), uncomment the next line ! # STRTOL = -Dstrtol=strtoul ! # ! # If you are using Perl v3 instead of v4, uncomment the next line ! # STR_2MORTAL = -Dstr_2mortal=str_2static ! ! # From here on, you shouldn't need to change anything ! ! SRCS = usersub.c oracle.mus orafns.c getcursor.c colons.c X OBJS = usersub.o oracle.o orafns.o getcursor.o colons.o ! HDRS = patchlevel.h orafns.h ! DEFS = $(STRTOL) $(PUTENV) $(STR_2MORTAL) ! ! CFLAGS = $(DEBUG) -I$(SRC) $(GLOBINCS) $(LOCINCS) $(DEFS) -O X X oraperl: $(SRC)/uperl.o $(OBJS) ! $(CC) -o oraperl $(SRC)/uperl.o $(OBJS) \ X -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS) X X oracle.c: $(SRC)/usub/mus oracle.mus *************** *** 41,44 **** X $(OBJS): $(HDRS) X X clean: ! rm -f nohup.out oraperl *.o oracle.c oraperl.man Print tags out core --- 56,69 ---- X $(OBJS): $(HDRS) X X clean: ! rm -f nohup.out oraperl *.o oracle.c oraperl.man oraperl.doc.pr \ ! oraperl.ref.pr listing tags core PATCHLEVEL ! ! listing: ! pr -fn Makefile $(HDRS) $(SRCS) >listing ! ! docs: ! nroff -man oraperl.1 >oraperl.man ! nroff oraperl.doc >oraperl.doc.pr ! nroff oraperl.ref >oraperl.ref.pr ! *** ORIG/README Mon Oct 28 17:13:01 1991 --- ./README Mon Oct 28 15:46:00 1991 *************** *** 8,28 **** X X ORACLE_HOME your Oracle installation directory X SRC your Perl source directory (with the usub directory) ! OTHERLIBS \ X CLIBS | X OCILIB +- copy these from your proc.mk file X NETLIBS | X ORALIBS / ! GLOBINCS \ X LOCINCS +- copy these from $SRC/usub/Makefile X LIBS / X DEBUG -DDEBUGGING, -DPERL_DEBUGGING or leave blank; X see orafns.h for an explanation X - If your version of Perl is earlier than v4, you will also need to make - one change to oracle.mus . The name str_2mortal() on line 101 must - be changed to str_2static() with the same arguments. - X I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2), X using Perl 3.0.34, 4.0.00 4.0.03 and 4.0.10 with Oracle version 6, as I don't X have access to any other system with Pro*C. I'd appreciate any comments, --- 8,27 ---- X X ORACLE_HOME your Oracle installation directory X SRC your Perl source directory (with the usub directory) ! OTHERLIBS \ X CLIBS | X OCILIB +- copy these from your proc.mk file X NETLIBS | X ORALIBS / ! GLOBINCS \ X LOCINCS +- copy these from $SRC/usub/Makefile X LIBS / X DEBUG -DDEBUGGING, -DPERL_DEBUGGING or leave blank; X see orafns.h for an explanation + PUTENV \ + STRTOL +- system dependent - see Makefile for details + STR_2MORTAL / X X I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2), X using Perl 3.0.34, 4.0.00 4.0.03 and 4.0.10 with Oracle version 6, as I don't X have access to any other system with Pro*C. I'd appreciate any comments, *************** *** 32,37 **** --- 31,37 ---- X X Source Code: X Makefile building instructions + patchlevel.h your Oraperl patch level X orafns.h common declarations X oracle.mus function interface description X getcursor.c functions to deal with the cursor pool *************** *** 43,62 **** X debug-p tests to see if debugging is available X ex.pl simple example of using the functions X mkdb.pl more extensive example, showing the use of ora_bind() X X Documentation X oraperl.doc explains some of the thinking behind Oraperl ! oraperl.ref quick reference (troff format) X oraperl.1 manual page - Hints notes on using oraperl - Oracle-v5 Hints for compiling Oraperl with Oracle v5 X X Miscellaneous X CHANGES Summary of changes to Oraperl ! PATCHLEVEL current patchlevel (2) X ! Many thanks to Larry for Perl. Now if only we could get the Camel book ! into France! Hmm. Any plans for "Le Livre Chameau"? X X Kevin Stock X kstock@gouldfr.encore.fr --- 43,62 ---- X debug-p tests to see if debugging is available X ex.pl simple example of using the functions X mkdb.pl more extensive example, showing the use of ora_bind() + and ora_do() X X Documentation X oraperl.doc explains some of the thinking behind Oraperl ! oraperl.ref quick reference - glue it into the perl reference guide X oraperl.1 manual page X X Miscellaneous X CHANGES Summary of changes to Oraperl ! Hints notes on using oraperl ! Oracle-v5 Hints for compiling Oraperl with Oracle v5 ! oraperl.ph definitions of Oraperl error and debugging codes X ! Many thanks to Larry for Perl. X X Kevin Stock X kstock@gouldfr.encore.fr *** ORIG/colons.c Mon Oct 28 17:12:31 1991 --- ./colons.c Fri Oct 25 14:29:54 1991 *************** *** 9,19 **** --- 9,26 ---- X * Perl kit. X */ X + #include <stdio.h> + #include "EXTERN.h" + #include "orafns.h" + + X int count_colons(s) X register char *s; X { X register int n = 0, c; X + DEBUG(8, 1, (fprintf(stderr, "count_colons(\"%s\")\n", s))); + X while (*s != '\0') X { X if (*s == ':') *************** *** 24,29 **** --- 31,39 ---- X if (((c = atoi(++s)) <= 0) || (c > n+1)) X { X /* number too low or out of sequence */ + DEBUG(8, -1, (fprintf(stderr, + "count_colons: got %d, expected %d\n", + c, n+1))); X return(-1); X } X else if (c == n + 1) *************** *** 43,47 **** --- 53,58 ---- X } X } X + DEBUG(8, -1, (fprintf(stderr, "count_colons: returning %d\n", n))); X return(n); X } *** ORIG/getcursor.c Mon Oct 28 17:13:02 1991 --- ./getcursor.c Fri Oct 25 16:05:03 1991 *************** *** 29,39 **** X { X int i; X ! DEBUG(8, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr))); X X if (csr->data == NULL) X { ! DEBUG(8, (fputs("ora_free_data: returning\n", stderr))); X return; X } X --- 29,39 ---- X { X int i; X ! DEBUG(8, 1, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr))); X X if (csr->data == NULL) X { ! DEBUG(8, -1, (fputs("ora_free_data: nothing to do\n", stderr))); X return; X } X *************** *** 41,57 **** X { X if (csr->data[i] != NULL) X { ! DEBUG(128, (fprintf(stderr, "freeing (%d) == %#lx\n", ! i, (long) csr->data[i]))); X free(csr->data[i]); X } X } X ! DEBUG(128, (fprintf(stderr, "freeing %#lx\n", (long) csr->data))); X free(csr->data); ! csr->data = NULL; X csr->nfields = 0; ! DEBUG(8, (fputs("ora_free_data: returning\n", stderr))); X } X X --- 41,65 ---- X { X if (csr->data[i] != NULL) X { ! DEBUG(128, 0, (fprintf(stderr, ! "ora_free_data: freeing field %d at address %#lx\n", ! i, (long) csr->data[i]))); X free(csr->data[i]); X } X } X ! DEBUG(128, 0, (fprintf(stderr, ! "ora_free_data: freeing cursor rcode at address %#lx\n", ! (long) csr->rcode))); ! free(csr->rcode); ! csr->rcode = (short *) NULL; ! DEBUG(128, 0, (fprintf(stderr, ! "ora_free_data: freeing cursor data at address %#lx\n", ! (long) csr->data))); X free(csr->data); ! csr->data = (char **) NULL; X csr->nfields = 0; ! DEBUG(8, -1, (fputs("ora_free_data: returning\n", stderr))); X } X X *************** *** 66,93 **** X { X struct cursor *tmp; X ! DEBUG(8, (fputs("ora_getcursor()\n", stderr))); X X if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL) X { ! DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr))); ! DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, (fprintf(stderr, ! "ora_getcursor: got cursor at %#lx\n", (long) tmp))); X ! if ((tmp->csr = (struct csrdef *) malloc(sizeof(struct csrdef))) == NULL) X { X free(tmp); ! DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr))); ! DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, (fprintf(stderr, ! "ora_getcursor: got csr at %#lx\n", tmp->csr))); X X tmp->hda = NULL; X tmp->data = NULL; --- 74,101 ---- X { X struct cursor *tmp; X ! DEBUG(8, 1, (fputs("ora_getcursor()\n", stderr))); X X if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL) X { ! DEBUG((8 | 128), -1, ! (fputs("ora_getcursor: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, 0, (fprintf(stderr, ! "ora_getcursor: got cursor at %#lx\n", (long) tmp))); X ! if ((tmp->csr = (struct csrdef *)malloc(sizeof(struct csrdef))) == NULL) X { X free(tmp); ! DEBUG((8 | 128), -1, ! (fputs("ora_getcursor: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, 0, (fprintf(stderr, ! "ora_getcursor: got csr at %#lx\n", tmp->csr))); X X tmp->hda = NULL; X tmp->data = NULL; *************** *** 96,102 **** X csr_list.next = tmp; X X ora_errno = 0; ! DEBUG(8, (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp))); X return(tmp); X } X --- 104,111 ---- X csr_list.next = tmp; X X ora_errno = 0; ! DEBUG(8, -1, ! (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp))); X return(tmp); X } X *************** *** 111,136 **** X { X struct cursor *tmp; X ! DEBUG(8, (fputs("ora_getlda()\n", stderr))); X X if ((tmp = ora_getcursor()) == NULL) X { ! DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr))); X return(NULL); X } X X if ((tmp->hda = malloc(256)) == NULL) X { ! DEBUG(128, (fputs("ora_getlda: out of memory\n", stderr))); X ora_dropcursor(tmp); - DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, (fprintf(stderr, ! "ora_getlda: got hda at %#lx\n", tmp->hda))); X ! DEBUG(8, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp))); X return(tmp); X } X --- 120,145 ---- X { X struct cursor *tmp; X ! DEBUG(8, 1, (fputs("ora_getlda()\n", stderr))); X X if ((tmp = ora_getcursor()) == NULL) X { ! DEBUG(8, -1, (fputs("ora_getlda: returning NULL\n", stderr))); X return(NULL); X } X X if ((tmp->hda = malloc(256)) == NULL) X { ! DEBUG((8 | 128), -1, ! (fputs("ora_getlda: out of memory\n", stderr))); X ora_dropcursor(tmp); X ora_errno = ORAP_NOMEM; X return(NULL); X } ! DEBUG(128, 0, ! (fprintf(stderr, "ora_getlda: got hda at %#lx\n", tmp->hda))); X ! DEBUG(8, -1, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp))); X return(tmp); X } X *************** *** 147,153 **** X X tmp = &csr_list; X ! DEBUG(8, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr))); X X while ((tmp->next != NULL) && (tmp->next != csr)) X { --- 156,162 ---- X X tmp = &csr_list; X ! DEBUG(8, 1, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr))); X X while ((tmp->next != NULL) && (tmp->next != csr)) X { *************** *** 156,162 **** X X if (tmp->next == NULL) X { ! DEBUG(8, (fputs("ora_dropcursor: invalid\n", stderr))); X ora_errno = ORAP_INVCSR; X return(0); X } --- 165,172 ---- X X if (tmp->next == NULL) X { ! DEBUG(8, -1, ! (fprintf(stderr, "ora_dropcursor: not a cursor\n"))); X ora_errno = ORAP_INVCSR; X return(0); X } *************** *** 165,191 **** X X if (t->hda != NULL) X { ! DEBUG(128, (fprintf(stderr, ! "ora_dropcursor: freeing hda at %#lx\n", (long) t->hda))); X free(t->hda); X } X if (t->data != NULL) X { ! DEBUG(128, (fputs("ora_dropcursor: freeing data\n", stderr))); X ora_free_data(t); X } X ! DEBUG(128, (fprintf(stderr, ! "ora_dropcursor: freeing csr at %#lx\n", (long) t->csr))); X free(t->csr); X X t = t->next; ! DEBUG(128, (fprintf(stderr, ! "ora_dropcursor: freeing cursor at %#lx\n", (long) tmp->next))); X free(tmp->next); X tmp->next = t; X ! DEBUG(8, (fputs("ora_dropcursor: returning\n", stderr))); X return(1); X } X --- 175,205 ---- X X if (t->hda != NULL) X { ! DEBUG(128, 0, ! (fprintf(stderr, "ora_dropcursor: freeing hda at %#lx\n", ! (long) t->hda))); X free(t->hda); X } X if (t->data != NULL) X { ! DEBUG(128, 0, ! (fputs("ora_dropcursor: freeing data\n", stderr))); X ora_free_data(t); X } X ! DEBUG(128, 0, ! (fprintf(stderr, "ora_dropcursor: freeing csr at %#lx\n", ! (long) t->csr))); X free(t->csr); X X t = t->next; ! DEBUG(128, 0, ! (fprintf(stderr, "ora_dropcursor: freeing cursor at %#lx\n", ! (long) tmp->next))); X free(tmp->next); X tmp->next = t; X ! DEBUG(8, -1, (fputs("ora_dropcursor: returning\n", stderr))); X return(1); X } X *************** *** 194,207 **** X * X * This is just here for completeness' sake. X * (I suppose we could check the value of hda in dropcursor and droplda ! * but I don't think it's worth it X */ X X int ora_droplda(lda) X struct cursor *lda; X { ! DEBUG(8, (fprintf(stderr, ! "ora_droplda(%#lx): calling ora_dropcursor\n", lda))); X return(ora_dropcursor(lda)); X } X --- 208,222 ---- X * X * This is just here for completeness' sake. X * (I suppose we could check the value of hda in dropcursor and droplda ! * but I don't think it's worth it) X */ X X int ora_droplda(lda) X struct cursor *lda; X { ! DEBUG(8, 0, ! (fprintf(stderr, "ora_droplda(%#lx): calling ora_dropcursor\n", ! lda))); X return(ora_dropcursor(lda)); X } X *************** *** 218,224 **** X X tmp = &csr_list; X ! DEBUG(8, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr))); X X while ((tmp->next != NULL) && (tmp->next != csr)) X { --- 233,239 ---- X X tmp = &csr_list; X ! DEBUG(8, 1, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr))); X X while ((tmp->next != NULL) && (tmp->next != csr)) X { *************** *** 227,237 **** X X if (tmp->next == NULL) X { ! DEBUG(8, (fputs("ora_findcursor: not valid\n", stderr))); X return(0); X } X ! DEBUG(8, (fputs("ora_findcursor: valid\n", stderr))); X return(1); X } X --- 242,252 ---- X X if (tmp->next == NULL) X { ! DEBUG(8, -1, (fputs("ora_findcursor: not a cursor\n", stderr))); X return(0); X } X ! DEBUG(8, -1, (fputs("ora_findcursor: is a cursor\n", stderr))); X return(1); X } X *************** *** 244,259 **** X int check_lda(lda) X struct cursor *lda; X { ! DEBUG(8, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda))); X X if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL)) X { ! DEBUG(8, (fputs("check_lda: valid\n", stderr))); X return (1); X } X else X { ! DEBUG(8, (fputs("check_lda: invalid\n", stderr))); X return (0); X } X }; --- 259,274 ---- X int check_lda(lda) X struct cursor *lda; X { ! DEBUG(8, 1, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda))); X X if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL)) X { ! DEBUG(8, -1, (fputs("check_lda: is an lda\n", stderr))); X return (1); X } X else X { ! DEBUG(8, -1, (fputs("check_lda: not an lda\n", stderr))); X return (0); X } X }; *************** *** 267,282 **** X int check_csr(csr) X struct cursor *csr; X { ! DEBUG(8, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr))); X X if (ora_findcursor(csr) && (csr->hda == NULL)) X { ! DEBUG(8, (fputs("check_csr: valid\n", stderr))); X return (1); X } X else X { ! DEBUG(8, (fputs("check_csr: invalid\n", stderr))); X return (0); X } X }; --- 282,297 ---- X int check_csr(csr) X struct cursor *csr; X { ! DEBUG(8, 1, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr))); X X if (ora_findcursor(csr) && (csr->hda == NULL)) X { ! DEBUG(8, -1, (fputs("check_csr: is a csr\n", stderr))); X return (1); X } X else X { ! DEBUG(8, -1, (fputs("check_csr: not a csr\n", stderr))); X return (0); X } X }; *** ORIG/mkdb.pl Mon Oct 28 17:12:32 1991 --- ./mkdb.pl Mon Oct 28 16:47:31 1991 *************** *** 8,20 **** X # Date: 5th August 1991 X # X ! # let's see what oraperl is doing when it executes this X ! $ora_debug = 136; X X $CREATE = "create table tryit (name char(10), ext number(3))"; X $INSERT = "insert into tryit values (:1, :2)"; X $LIST = "select * from tryit order by name"; X $DROP = "drop table tryit"; X X format top = --- 8,27 ---- X # Date: 5th August 1991 X # X ! # make sure that we really are running oraperl ! die ("You should use oraperl, not perl\n") unless defined &ora_login; ! ! # get debugging & error codes ! require('oraperl.ph'); X ! # let's see what oraperl is doing when it executes this ! $ora_debug = $ODBG_EXEC | $ODBG_STRNUM | $ODBG_MALLOC; X + # set these as strings to make the code more readable X $CREATE = "create table tryit (name char(10), ext number(3))"; X $INSERT = "insert into tryit values (:1, :2)"; X $LIST = "select * from tryit order by name"; + $DELETE = "delete from tryit where name = :1"; X $DROP = "drop table tryit"; X X format top = *************** *** 27,39 **** X $name, $ext X . X ! die ("You should use oraperl, not perl\n") unless defined &ora_login; X X # create the database X X $lda = &ora_login("t", "kstock", "kstock") || die $ora_errstr; ! $csr = &ora_open($lda, $CREATE) || die $ora_errstr; ! do ora_close($csr) || die $ora_errstr; X X # put some data into it X --- 34,60 ---- X $name, $ext X . X ! # function to list the database ! ! sub list ! { ! local($csr, $name, $ext); ! ! $- = 0; ! ! $csr = &ora_open($lda, $LIST) || die $ora_errstr; ! while (($name, $ext) = &ora_fetch($csr)) ! { ! write; ! } ! die $ora_errstr if ($ora_errno != 0); ! do ora_close($csr) || die $ora_errstr; ! } X X # create the database X X $lda = &ora_login("t", "kstock", "kstock") || die $ora_errstr; ! &ora_do($lda, $CREATE) || die $ora_errstr; X X # put some data into it X *************** *** 45,73 **** X } X do ora_close($csr) || die $ora_errstr; X ! # list the result X ! $csr = &ora_open($lda, $LIST) || die $ora_errstr; ! while (($name, $ext) = &ora_fetch($csr)) X { ! write; X } ! do ora_close($csr) || die $ora_errstr; X ! # remove the database X ! $csr = &ora_open($lda, $DROP) || die $ora_errstr; ! do ora_close($csr) || die $ora_errstr; X do ora_logoff($lda) || die $ora_errstr; X __END__ - david:225 - angela:208 - bruno:302 - albert:294 X julia:292 ! alison:206 ! arnold:305 X larry:424 X catherine:201 X randall:306 ! susan:307 --- 66,95 ---- X } X do ora_close($csr) || die $ora_errstr; X ! # check the result ! do list(); ! ! # remove a few lines X ! $csr = &ora_open($lda, $DELETE) || die $ora_errstr; ! foreach $name ('catherine', 'angela', 'arnold', 'julia') X { ! &ora_bind($csr, $name) || die $ora_errstr; X } ! &ora_close($csr) || die $ora_errstr; X ! # check the result ! do list(); X ! # remove the database and log out ! $csr = &ora_do($lda, $DROP) || die $ora_errstr; X do ora_logoff($lda) || die $ora_errstr; + + # This is the data which will go into the database X __END__ X julia:292 ! angela:208 X larry:424 X catherine:201 X randall:306 ! arnold:305 *** ORIG/oracle.mus Mon Oct 28 17:13:02 1991 --- ./oracle.mus Mon Oct 28 16:40:49 1991 *************** *** 1,6 **** --- 1,9 ---- X /* oracle.mus X * X * User subroutine interface to Oracle functions + * + * NOTE: Do not modify oracle.c as it is created automagically from oracle.mus. + * Modify oracle.mus instead, or your changes will be lost. X */ X /* Copyright 1991 Kevin Stock. X * *************** *** 23,33 **** --- 26,38 ---- X }; X X static enum usersubs { + US_ora_version, X US_ora_login, X US_ora_open, X US_ora_bind, X US_ora_fetch, X US_ora_close, + US_ora_do, X US_ora_logoff, X }; X *************** *** 52,62 **** --- 57,69 ---- X MAGICVAR("ora_errno", UV_ora_errno); X MAGICVAR("ora_errstr", UV_ora_errstr); X + make_usub("ora_version", US_ora_version, usersub, filename); X make_usub("ora_login", US_ora_login, usersub, filename); X make_usub("ora_open", US_ora_open, usersub, filename); X make_usub("ora_bind", US_ora_bind, usersub, filename); X make_usub("ora_fetch", US_ora_fetch, usersub, filename); X make_usub("ora_close", US_ora_close, usersub, filename); + make_usub("ora_do", US_ora_do, usersub, filename); X make_usub("ora_logoff", US_ora_logoff, usersub, filename); X }; X *************** *** 74,79 **** --- 81,89 ---- X X switch (ix) { X + CASE void ora_version + END + X CASE char * ora_login X I char * database X I char * name *************** *** 86,94 **** X END X X case US_ora_fetch: ! if (items != 1) ! fatal("Usage: @array = &ora_fetch($csr)"); ! else { X char *csr = (char *) str_get(st[1]); X X if (curcsv->wantarray) { /* in array context, return the data */ --- 96,107 ---- X END X X case US_ora_fetch: ! if (items != 1) { ! if (curcsv->wantarray) ! fatal("Usage: @array = &ora_fetch($csr)"); ! else ! fatal("Usage: $nfields = &ora_fetch($csr)"); ! } else { X char *csr = (char *) str_get(st[1]); X X if (curcsv->wantarray) { /* in array context, return the data */ *************** *** 137,142 **** --- 150,156 ---- X vars[i] = (char *) str_get(st[i+2]); X } X retval = ora_bind(csr, vars, items - 1); + free(vars); X } X X str_numset(st[0], (double) retval); *************** *** 143,148 **** --- 157,167 ---- X } X return sp; X + CASE char * ora_do + I char * lda + I char * stmt + END + X CASE char * ora_close X I char * csr X END *************** *** 182,187 **** --- 201,223 ---- X } X X + /* ora_errlist[] contains error messages corresponding to Oraperl's own + * error codes. These do not include Oracle errors. + */ + + char *ora_errlist[] = + { + "", /* not used */ + "insufficient memory", + "invalid cursor", + "invalid login data area", + "couldn't set ORACLE_SID", + "bad colon variable sequence", + "wrong number of variables", + "statement does not return data", + }; + + X static int X userval(ix, str) X int ix; *************** *** 212,254 **** X } X str_set(str, ertxt); X } X else X { ! switch (ora_errno) ! { ! case ORAP_NOMEM: ! str_set(str, "insufficient memory"); ! break; ! ! case ORAP_INVCSR: ! str_set(str, "invalid cursor"); ! break; ! ! case ORAP_INVLDA: ! str_set(str, "invalid login data area"); ! break; ! ! case ORAP_NOSID: ! str_set(str, "couldn't set ORACLE_SID"); ! break; ! ! case ORAP_BADVAR: ! str_set(str, "bad colon variable sequence"); ! break; ! ! case ORAP_NUMVARS: ! str_set(str, "wrong number of variables"); ! break; ! ! default: ! { ! char tmp[30]; ! ! sprintf(tmp, "unknown oraperl error %d", ! ora_errno); ! str_set(str, tmp); ! } ! } X } X } X break; --- 248,261 ---- X } X str_set(str, ertxt); X } + else if((ora_errno == ORAP_ERRMIN) || (ora_errno > ORAP_ERRMAX)) + { + sprintf(ertxt, "unknown error %d", ora_errno); + str_set(str, ertxt); + } X else X { ! str_set(str, ora_errlist[ora_errno - ORAP_ERRMIN]); X } X } X break; *** ORIG/orafns.c Mon Oct 28 17:13:02 1991 --- ./orafns.c Mon Oct 28 16:46:10 1991 *************** *** 13,20 **** --- 13,35 ---- X #include <stdio.h> X #include <ctype.h> X #include "orafns.h" + #include "patchlevel.h" X X + /* void ora_version() + * + * Print out information about Oraperl + */ + + void ora_version() + { + printf("\nThis is Oraperl, version 1, patch level %d\n\n", PATCHLEVEL); + puts("Perl is copyright by Larry Wall; type oraperl -v for details."); + puts("Modifications for Oraperl: Copyright 1991, Kevin Stock.\n"); + puts("Oraperl may be distributed under the same conditions as Perl."); + } + + X /* address[] is used to return cursor addresses to the perl program X * it is used so that we can get the addresses exactly right, without X * worrying about rounding errors or playing with oracle.mus *************** *** 42,49 **** X static char *oldsid = NULL, X *newsid = NULL; X ! DEBUG(8, (fprintf(stderr, "set_sid(%s)\n", ! (database == NULL) ? "<NULL>" : database))); X X if (database != NULL) X { --- 57,65 ---- X static char *oldsid = NULL, X *newsid = NULL; X ! DEBUG(8, 1, (fprintf(stderr, ! "set_sid(\"%s\")\n", ! (database == NULL) ? "<NULL>" : database))); X X if (database != NULL) X { *************** *** 53,127 **** X { X if (oldsid != NULL) X { ! DEBUG(128, (fprintf(stderr, ! "set_sid: freeing oldsid (%#lx)\n", ! (long) oldsid))); X free(oldsid); X } X if ((oldsid = malloc(strlen(sid) + 1)) == NULL) X { ! DEBUG(128, (fputs("set_sid: out of memory\n", ! stderr))); ! DEBUG(8, (fputs("set_sid: returning NOSID\n", ! stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, (fprintf(stderr, ! "set_sid: got oldsid at %#lx\n", (long) oldsid))); X strcpy(oldsid, sid); X } X X if (newsid != NULL) X { ! DEBUG(128, (fprintf(stderr, ! "set_sid: freeing newsid (%#lx)\n", ! (long) newsid))); X free(newsid); X } X if ((newsid = malloc(strlen(database) + 12)) == NULL) X { ! DEBUG(128, (fputs("set_sid: out of memory\n", stderr))); ! DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, (fprintf(stderr, ! "set_sid: got newsid at %#lx\n", (long) newsid))); X strcpy(newsid, "ORACLE_SID="); X strcat(newsid, database); X ! DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid))); ! return (putenv(newsid)) ? oldsid : NULL; X } X else X { X if (oldsid == NULL) X { ! DEBUG(8, (fputs("set_sid: oldsid not set\n", stderr))); X return(NULL); X } X X if (newsid != NULL) X { ! DEBUG(128, (fprintf(stderr, ! "set_sid: freeing newsid (%#lx)\n", (long)newsid))); X free(newsid); X } X if ((newsid = malloc(strlen(oldsid) + 12)) == NULL) X { ! DEBUG(128, (fputs("set_sid: out of memory\n", stderr))); ! DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, (fprintf(stderr, ! "set_sid: got newsid at %#lx\n", (long) newsid))); X strcpy(newsid, "ORACLE_SID="); X strcat(newsid, oldsid); X ! DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid))); ! return (putenv(newsid)) ? oldsid : NULL; X } X X /* NOTREACHED */ --- 69,170 ---- X { X if (oldsid != NULL) X { ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: freeing oldsid (%#lx)\n", ! (long) oldsid))); X free(oldsid); X } X if ((oldsid = malloc(strlen(sid) + 1)) == NULL) X { ! DEBUG((8 | 128), -1, (fputs( ! "set_sid: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: got oldsid %d bytes at %#lx\n", ! strlen(sid) + 1, (long) oldsid))); X strcpy(oldsid, sid); X } X X if (newsid != NULL) X { ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: freeing newsid (%#lx)\n", ! (long) newsid))); X free(newsid); X } X if ((newsid = malloc(strlen(database) + 12)) == NULL) X { ! DEBUG((8 | 128), -1, (fputs( ! "set_sid: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: got newsid %d bytes at %#lx\n", ! strlen(database) + 12, (long) newsid))); X strcpy(newsid, "ORACLE_SID="); X strcat(newsid, database); X ! DEBUG(8, 0, (fprintf(stderr, "set_sid: setting %s\n",newsid))); ! if (putenv(newsid) != 0) ! { ! DEBUG(8, -1, (fputs( ! "set_sid: putenv() failed\n", stderr))); ! ora_errno = ORAP_NOMEM; ! return(NOSID); ! } ! else ! { ! DEBUG(8, -1, (fprintf(stderr, ! "set_sid: returning \"%s\"\n", oldsid))); ! return(oldsid); ! } X } X else X { X if (oldsid == NULL) X { ! DEBUG(8, -1, (fputs( ! "set_sid: oldsid not set\n", stderr))); X return(NULL); X } X X if (newsid != NULL) X { ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: freeing newsid (%#lx)\n", ! (long)newsid))); X free(newsid); X } X if ((newsid = malloc(strlen(oldsid) + 12)) == NULL) X { ! DEBUG((8 | 128), -1, (fputs( ! "set_sid: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return(NOSID); X } ! DEBUG(128, 0, (fprintf(stderr, ! "set_sid: got newsid %d bytes at %#lx\n", ! strlen(oldsid) + 12, (long) newsid))); X strcpy(newsid, "ORACLE_SID="); X strcat(newsid, oldsid); X ! DEBUG(8, 0, (fprintf(stderr, "set_sid: setting %s\n",newsid))); ! if (putenv(newsid) != 0) ! { ! DEBUG(8, -1, (fputs( ! "set_sid: putenv() failed\n", stderr))); ! ora_errno = ORAP_NOMEM; ! return(NOSID); ! } ! else ! { ! DEBUG(8, -1, (fprintf(stderr, ! "set_sid: returning \"%s\"\n", oldsid))); ! return(oldsid); ! } X } X X /* NOTREACHED */ *************** *** 140,164 **** X char *tmp; X struct cursor *lda; X ! DEBUG(8, (fprintf(stderr, ! "ora_login(%s, %s, %s)\n", database, name, password))); X X if ((lda = ora_getlda()) == NULL) X { ! DEBUG(8, (fputs("ora_login: couldn't get an lda\n", stderr))); X return(NULL); X } X X if (set_sid(database) == NOSID) X { ! DEBUG(8, (fputs("ora_login: couldn't set database\n", stderr))); X ora_dropcursor(lda); X return(NULL); X } X else if (strcmp(database, getenv("ORACLE_SID")) != 0) X { ! DEBUG(8, (fprintf(stderr,"ora_login: ORACLE_SID misset to %s\n", ! (tmp = getenv("ORACLE_SID")) ? tmp : NULL))); X ora_dropcursor(lda); X ora_errno = ORAP_NOSID; X return(NULL); --- 183,210 ---- X char *tmp; X struct cursor *lda; X ! DEBUG(8, 1, (fprintf(stderr, ! "ora_login(\"%s\", \"%s\", \"%s\")\n", database, name, password))); X X if ((lda = ora_getlda()) == NULL) X { ! DEBUG(8, -1, (fputs( ! "ora_login: couldn't get an lda\n", stderr))); X return(NULL); X } X X if (set_sid(database) == NOSID) X { ! DEBUG(8, -1, (fputs( ! "ora_login: couldn't select database\n", stderr))); X ora_dropcursor(lda); X return(NULL); X } X else if (strcmp(database, getenv("ORACLE_SID")) != 0) X { ! DEBUG(8, -1, (fprintf(stderr, ! "ora_login: ORACLE_SID misset to %s\n", ! (tmp = getenv("ORACLE_SID")) ? tmp : "<NULL>"))); X ora_dropcursor(lda); X ora_errno = ORAP_NOSID; X return(NULL); *************** *** 170,177 **** X if (logged == 0) X { X sprintf(address, "%#lx", (long) lda); ! DEBUG(8, (fprintf(stderr, ! "ora_login: returning lda %s\n", address))); X ora_errno = 0; X return(address); X } --- 216,226 ---- X if (logged == 0) X { X sprintf(address, "%#lx", (long) lda); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_login: lda %#lx converted to string \"%s\"\n", ! lda, address))); ! DEBUG(8, -1, (fprintf(stderr, ! "ora_login: returning lda %s\n", address))); X ora_errno = 0; X return(address); X } *************** *** 179,186 **** X { X ora_errno = lda->csr->csrrc; X ora_droplda(lda); ! DEBUG(8, (fprintf(stderr, ! "ora_login: failed (error %d)\n", ora_errno))); X return((char *) NULL); X } X } --- 228,235 ---- X { X ora_errno = lda->csr->csrrc; X ora_droplda(lda); ! DEBUG(8, -1, (fprintf(stderr, ! "ora_login: failed (error %d)\n", ora_errno))); X return((char *) NULL); X } X } *************** *** 198,210 **** X int i; X struct cursor *csr; X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0); ! short dbsize; X ! DEBUG(8, (fprintf(stderr, "ora_open(%#lx, %s)\n", (long) lda, stmt))); X X if (check_lda(lda) == 0) X { ! DEBUG(8, (fputs("ora_open: returning NULL\n", stderr))); X ora_errno = ORAP_INVLDA; X return((char *) NULL); X } --- 247,263 ---- X int i; X struct cursor *csr; X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0); ! short dsize; X ! DEBUG(8, 1, (fprintf(stderr, ! "ora_open(%s, \"%s\")\n", lda_s, stmt))); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_open: string \"%s\" converted to lda %#lx\n", ! lda_s, lda))); X X if (check_lda(lda) == 0) X { ! DEBUG(8, -1, (fputs("ora_open: invalid lda\n", stderr))); X ora_errno = ORAP_INVLDA; X return((char *) NULL); X } *************** *** 211,218 **** X X if ((csr = ora_getcursor()) == NULL) X { ! /* ora_errno is set by ora_getcursor */ ! DEBUG(8, (fprintf(stderr, "ora_open: can't get a cursor\n"))); X return((char *) NULL); X } X --- 264,271 ---- X X if ((csr = ora_getcursor()) == NULL) X { ! DEBUG(8, -1, (fprintf(stderr, ! "ora_open: can't get a cursor\n"))); X return((char *) NULL); X } X *************** *** 221,234 **** X */ X if ((csr->varfields = count_colons(stmt)) < 0) X { ! DEBUG(8, (fputs("ora_open: invalid variable sequence\n", ! stderr))); X ora_errno = ORAP_BADVAR; X return((char *) NULL); X } X ! DEBUG(8, (fprintf(stderr, ! "ora_open: statement contains %d colons\n", csr->varfields))); X X if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0) X || (osql3(csr->csr, stmt, -1) != 0) --- 274,287 ---- X */ X if ((csr->varfields = count_colons(stmt)) < 0) X { ! DEBUG(8, -1, (fputs( ! "ora_open: invalid variable sequence\n", stderr))); X ora_errno = ORAP_BADVAR; X return((char *) NULL); X } X ! DEBUG(8, 0, (fprintf(stderr, ! "ora_open: statement contains %d colons\n", csr->varfields))); X X if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0) X || (osql3(csr->csr, stmt, -1) != 0) *************** *** 236,243 **** X { X ora_errno = csr->csr->csrrc; X ora_dropcursor(csr); ! DEBUG(8, (fprintf(stderr, ! "couldn't run SQL statement (error %d)\n", ora_errno))); X return((char *) NULL); X } X --- 289,297 ---- X { X ora_errno = csr->csr->csrrc; X ora_dropcursor(csr); ! DEBUG(8, -1, (fprintf(stderr, ! "ora_open: couldn't run SQL statement (error %d)\n", ! ora_errno))); X return((char *) NULL); X } X *************** *** 257,304 **** X { X if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL) X { ! DEBUG(128, (fputs("ora_open: out of memory\n",stderr))); ! DEBUG(8, (fputs("ora_open: returning NOMEM\n",stderr))); X ora_errno = ORAP_NOMEM; X ora_dropcursor(csr); ! return(0); X } ! DEBUG(128, (fprintf(stderr, ! "ora_open: got data at %#lx\n",csr->data))); X csr->nfields = i; X X for (i = 0 ; i < csr->nfields ; i++) X { ! odsc(csr->csr, i + 1, &dbsize, (short *) 0, (short *) 0, ! (short *) 0, (char *) 0, (short *) 0, (short *) 0); X ! if ((csr->data[i] = (char *) malloc(dbsize+1)) == NULL) X { X csr->nfields = i; X ora_dropcursor(csr); ! DEBUG(128, (fputs("ora_open: out of memory\n", ! stderr))); ! DEBUG(8, (fputs("ora_open: returning NOMEM\n", ! stderr))); X ora_errno = ORAP_NOMEM; X return((char *) NULL); X } ! DEBUG(128, (fprintf(stderr, ! "ora_open: got field %d at %#lx\n", ! i, csr->data[i]))); ! odefin(csr->csr, i + 1, csr->data[i], dbsize + 1, 5, 0, X (short *) 0, (char *) 0, 0, 0, (short *) 0, ! (char *) 0); X } X } X else X { ! DEBUG(128, (fputs("ora_open: no data to return\n", stderr))); X csr->data = NULL; X } X X sprintf(address, "%#lx", (long) csr); ! DEBUG(8, (fprintf(stderr, "ora_open: returning csr %s\n", address))); X return(address); X } X --- 311,377 ---- X { X if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL) X { ! ora_dropcursor(csr); ! DEBUG((8 | 128), -1, (fputs( ! "ora_open: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; + return((char *) NULL); + } + DEBUG(128, 0, (fprintf(stderr, + "ora_open: got data array %d items %d bytes at %#lx\n", + i, i * sizeof(char *), (long) csr->data))); + + if ((csr->rcode = (short *) malloc(i * sizeof(short))) == NULL) + { X ora_dropcursor(csr); ! DEBUG((8 | 128), -1, (fputs( ! "ora_open: out of memory\n", stderr))); ! ora_errno = ORAP_NOMEM; ! return((char *) NULL); X } ! DEBUG(128, 0, (fprintf(stderr, ! "ora_open: got rcode array %d items %d bytes at %#lx\n", ! i, i * sizeof(short), (long) csr->rcode))); ! X csr->nfields = i; X X for (i = 0 ; i < csr->nfields ; i++) X { ! odsc(csr->csr, i + 1, (short *) 0, (short *) 0, ! (short *) 0, (short *) 0, (char *) 0, (short *) 0, ! &dsize); X ! if ((csr->data[i] = (char *) malloc(dsize+1)) == NULL) X { X csr->nfields = i; X ora_dropcursor(csr); ! DEBUG((8 | 128), -1, (fputs( ! "ora_open: out of memory\n", stderr))); X ora_errno = ORAP_NOMEM; X return((char *) NULL); X } ! DEBUG(128, 0, (fprintf(stderr, ! "ora_open: got field %d, %d bytes at %#lx\n", ! i, dsize + 1, csr->data[i]))); ! ! odefin(csr->csr, i + 1, csr->data[i], dsize + 1, 5, 0, X (short *) 0, (char *) 0, 0, 0, (short *) 0, ! &(csr->rcode[i])); X } X } X else X { ! DEBUG(8, 0, (fputs( ! "ora_open: statement returns no data\n", stderr))); X csr->data = NULL; X } X X sprintf(address, "%#lx", (long) csr); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_open: csr %#lx converted to string \"%s\"\n", ! csr, address))); ! DEBUG(8, -1, (fprintf(stderr, ! "ora_open: returning csr \"%s\"\n", address))); X return(address); X } X *************** *** 311,339 **** X int ora_fetch(csr_s) X char *csr_s; X { X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! DEBUG(8, (fprintf(stderr, "ora_fetch(%#lx)\n", (long) csr))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, (fputs("ora_fetch: returning NULL\n", stderr))); X ora_errno = ORAP_INVCSR; ! return(NULL); X } X ! if ((csr->nfields == 0) || (ofetch(csr->csr) != 0)) X { ! DEBUG(8, (fputs("ora_fetch: ofetch failed, returing 0\n", ! stderr))); ! ora_result = NULL; ! ora_errno = csr->csr->csrrc; X return(0); X } X X ora_result = csr->data; X ora_errno = 0; - DEBUG(8, (fprintf(stderr,"ora_fetch: returning <%d>\n", csr->nfields))); X return(csr->nfields); X } X --- 384,472 ---- X int ora_fetch(csr_s) X char *csr_s; X { + int i; X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! DEBUG(8, 1, (fprintf(stderr, ! "ora_fetch(%s)\n", csr_s))); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_fetch: string \"%s\" converted to csr %#lx\n", ! csr_s, csr))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, -1, (fputs("ora_fetch: not a csr\n", stderr))); X ora_errno = ORAP_INVCSR; ! return(0); X } + else if (csr->nfields == 0) + { + DEBUG(8, -1, (fputs("ora_fetch: no data to return\n", stderr))); + ora_errno = ORAP_NODATA; + return(0); + } X ! if ((i = ofetch(csr->csr)) == 4) X { ! DEBUG(8, -1, (fputs("ora_fetch: end of data\n", stderr))); ! ora_errno = 0; X return(0); X } + else if (i != 0) + { + for (i = 0 ; i < csr->nfields ; i++) + { + switch (csr->rcode[i]) + { + case 0: /* no problem */ + break; + + case 1405: + DEBUG(8, 0, (fprintf(stderr, + "ora_fetch: field %d was NULL\n", i))); + *csr->data[i] = '\0'; + break; + + case 1406: + DEBUG(8, -1, (fprintf(stderr, + "ora_fetch: field %d was truncated\n", i))); + ora_errno = csr->csr->csrrc; + return(0); + + default: /* others should not happen */ + DEBUG(8, -1, (fprintf(stderr, + "ora_fetch: ofetch error %d on field %d\n", + csr->rcode[i], i))); + ora_errno = csr->csr->csrrc; + return(0); + } + } + + /* if we fall out here, all errors were corrected */ + } X + #ifdef DEBUGGING + /* NOTE: use the DEBUG macro for printing even here in case + * the debug output format is changed later + */ + + if (ora_debug & 8) + { + int i; + + DEBUG(8, 0, (fputs("ora_fetch: returning data:\n", stderr))); + for (i = 0 ; i < csr->nfields ; i++) + { + DEBUG(8, 0, (fprintf(stderr, + "ora_fetch: field %4d data \"%s\"\n", + i, csr->data[i]))); + } + } + #endif + DEBUG(8, -1, (fprintf(stderr, + "ora_fetch: returning %d items\n", csr->nfields))); X ora_result = csr->data; X ora_errno = 0; X return(csr->nfields); X } X *************** *** 350,369 **** X int i, ret; X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! DEBUG(8, (fprintf(stderr, "ora_bind(%#lx, %#lx, %d)\n", ! (long) csr, (long) vars, nitems))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, (fputs("ora_bind: returning 0\n", stderr))); X ora_errno = ORAP_INVCSR; X return(0); X } ! ! if (csr->varfields != nitems) X { ! DEBUG(8, (fprintf("ora_bind: expected %d items, got %d\n", ! csr->varfields, nitems))); X ora_errno = ORAP_NUMVARS; X return(0); X } --- 483,504 ---- X int i, ret; X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! DEBUG(8, 1, (fprintf(stderr, ! "ora_bind(%s, %#lx, %d)\n", csr_s, (long) vars, nitems))); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_bind: string \"%s\" converted to csr %#lx\n", csr_s,csr))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, -1, (fputs("ora_bind: not a csr\n", stderr))); X ora_errno = ORAP_INVCSR; X return(0); X } ! else if (csr->varfields != nitems) X { ! DEBUG(8, -1, (fprintf( ! "ora_bind: expected %d items, got %d\n", ! csr->varfields, nitems))); X ora_errno = ORAP_NUMVARS; X return(0); X } *************** *** 373,401 **** X if ((ret = obndrn(csr->csr, i+1, vars[i], strlen(vars[i])+1, X 5, -1, (short *) -1, (char *) -1, 0, 0)) != 0) X { X ora_errno = csr->csr->csrrc; - DEBUG(8, (fputs("ora_bind: returning 0\n", stderr))); X return(0); X } X ! DEBUG(8, (fprintf(stderr, "ora_bind: obndrv %d %s OK\n", ! i + 1, vars[i]))); X } X X if (oexec(csr->csr) != 0) X { X ora_errno = csr->csr->csrrc; - DEBUG(8, (fputs("ora_bind: returning 0\n", stderr))); X return(0); X } X ! DEBUG(8, (fputs("ora_bind: oexec successful\n", stderr))); ! DEBUG(8, (fputs("ora_bind: returning 1\n", stderr))); X return(1); X } X X ! char *OK = "OK"; /* valid return from ora_close, ora_logoff */ X X /* ora_close(csr) X * --- 508,572 ---- X if ((ret = obndrn(csr->csr, i+1, vars[i], strlen(vars[i])+1, X 5, -1, (short *) -1, (char *) -1, 0, 0)) != 0) X { + DEBUG(8, -1, (fprintf(stderr, + "ora_bind: obndrn failed on field %d, \"%s\"\n", + i + 1, vars[i]))); X ora_errno = csr->csr->csrrc; X return(0); X } X ! DEBUG(8, 0, (fprintf(stderr, ! "ora_bind: obndrn %d, \"%s\" OK\n", i + 1, vars[i]))); X } X X if (oexec(csr->csr) != 0) X { + DEBUG(8, -1, (fputs("ora_bind: oexec failed\n", stderr))); X ora_errno = csr->csr->csrrc; X return(0); X } X ! DEBUG(8, -1, (fputs("ora_bind: returning\n", stderr))); X return(1); X } X X ! char *OK = "OK"; /* valid return from ora_close/do/logoff */ ! ! ! /* ora_do(lda, stmt) ! * ! * sets and executes the specified sql statement, without leaving a cursor open ! */ ! ! char *ora_do(lda_s, stmt) ! char *lda_s; ! char *stmt; ! { ! char *csr_s; ! ! DEBUG(8, 1, (fprintf(stderr, ! "ora_do(%s, \"%s\")\n", lda_s, stmt))); ! ! if ((csr_s = ora_open(lda_s, stmt)) == NULL) ! { ! DEBUG(8, -1, (fprintf(stderr, "ora_do: ora_open failed\n"))); ! return(NULL); ! } ! else if (ora_close(csr_s) == NULL) ! { ! DEBUG(8, -1, (fprintf(stderr, "ora_do: ora_close failed\n"))); ! return(NULL); ! } ! else ! { ! DEBUG(8, -1, (fprintf(stderr, "ora_do: successful\n"))); ! return(OK); ! } ! ! /* NOTREACHED */ ! } ! X X /* ora_close(csr) X * *************** *** 407,417 **** X { X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! DEBUG(8, (fprintf(stderr, "ora_close(%#lx)\n", (long) csr))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, (fputs("ora_close: returning NULL\n", stderr))); X ora_errno = ORAP_INVCSR; X return(NULL); X } --- 578,592 ---- X { X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0); X ! ! DEBUG(8, 1, (fprintf(stderr, "ora_close(%s)\n", csr_s))); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_close: string \"%s\" converted to csr %#lx\n", ! csr_s, csr))); X X if (check_csr(csr) == 0) X { ! DEBUG(8, -1, (fputs("ora_close: not a csr\n", stderr))); X ora_errno = ORAP_INVCSR; X return(NULL); X } *************** *** 420,426 **** X ora_errno = csr->csr->csrrc; X ora_dropcursor(csr); X ! DEBUG(8, (fputs("ora_close: returning OK\n", stderr))); X return(OK); X } X --- 595,601 ---- X ora_errno = csr->csr->csrrc; X ora_dropcursor(csr); X ! DEBUG(8, -1, (fputs("ora_close: returning OK\n", stderr))); X return(OK); X } X *************** *** 435,445 **** X { X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0); X ! DEBUG(8, (fprintf(stderr, "ora_logoff(%#lx)\n", (long) lda))); X X if (check_lda(lda) == 0) X { ! DEBUG(8, (fputs("ora_logoff: returning NULL\n", stderr))); X ora_errno = ORAP_INVLDA; X return(NULL); X } --- 610,623 ---- X { X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0); X ! DEBUG(8, 1, (fprintf(stderr, "ora_logoff(%s)\n", lda_s))); ! DEBUG(32, 0, (fprintf(stderr, ! "ora_logoff: string \"%s\" converted to lda %#lx\n", ! lda_s, lda))); X X if (check_lda(lda) == 0) X { ! DEBUG(8, -1, (fputs("ora_logoff: not an lda\n", stderr))); X ora_errno = ORAP_INVLDA; X return(NULL); X } *************** *** 448,453 **** X ora_errno = lda->csr->csrrc; X ora_droplda(lda); X ! DEBUG(8, (fputs("ora_logoff: returning OK\n", stderr))); X return(OK); X } --- 626,631 ---- X ora_errno = lda->csr->csrrc; X ora_droplda(lda); X ! DEBUG(8, -1, (fputs("ora_logoff: returning OK\n", stderr))); X return(OK); X } *** ORIG/orafns.h Mon Oct 28 17:13:03 1991 --- ./orafns.h Mon Oct 28 16:38:53 1991 *************** *** 15,20 **** --- 15,21 ---- X char *ora_login(), X *ora_open(), X *ora_close(), + *ora_do(), X *ora_logoff(); X X int ora_bind(), *************** *** 67,72 **** --- 68,74 ---- X struct csrdef *csr; X char *hda, /* used if this cursor is an lda */ X **data; /* used to receive database contents */ + short *rcode; /* used to receive fetch error codes */ X int nfields, /* number of fields to retrieve */ X varfields; /* number of modifiable variables */ X struct cursor *next; /* list pointer */ *************** *** 99,105 **** --- 101,112 ---- X * X * At present, the only flags used are: X * 8 program execution - report function entry and exit + * 32 conversion between strings and numbers + * (in this case, the numbers are cursor addresses) X * 128 use of malloc/free + * + * My apologies if you dislike the DEBUG macro, but I wanted to improve the + * readability of the debugging traces that came out. X */ X X #ifdef PERL_DEBUGGING *************** *** 109,122 **** X #endif X X #ifdef DEBUGGING ! # define DEBUG(flag, stmt) { if (ora_debug & flag) { (stmt); } } X # ifdef PERL_DEBUGGING ! extern int debug; /* exists in uperl.o */ ! # else ! EXT int debug; /* need to create it ourselves */ X # endif X #else ! # define DEBUG(flag, stmt) X #endif X X --- 116,141 ---- X #endif X X #ifdef DEBUGGING ! EXT int __debug_level__ INIT(1); ! ! # define DEBUG(flag, change, stmt) \ ! { \ ! if ((ora_debug & 8) && ((change) > 0)) \ ! { __debug_level__ += 2 * (change); } \ ! if (ora_debug & (flag)) \ ! { \ ! fprintf(stderr, "OP:%*s", __debug_level__, ""); \ ! (stmt); \ ! } \ ! if ((ora_debug & 8) && ((change) < 0)) \ ! { __debug_level__ += 2 * (change); } \ ! } ! X # ifdef PERL_DEBUGGING ! extern int debug; /* -D flag from uperl.o */ X # endif X #else ! # define DEBUG(flag, change, stmt) /* nothing */ X #endif X X *************** *** 134,136 **** --- 153,158 ---- X #define ORAP_NOSID 100004 /* couldn't set ORACLE_SID */ X #define ORAP_BADVAR 100005 /* bad colon variable sequence */ X #define ORAP_NUMVARS 100006 /* wrong number of colon variables */ + #define ORAP_NODATA 100007 /* statement does not return data */ + + #define ORAP_ERRMAX ORAP_NODATA /* highest value actually used */ *** ORIG/oraperl.1 Mon Oct 28 17:13:03 1991 --- ./oraperl.1 Mon Oct 28 14:22:43 1991 *************** *** 6,16 **** --- 6,19 ---- X oraperl \- Perl access to Oracle databases X .SH SYNOPSIS X .nf + &ora_version + X $lda = &ora_login($database, $name, $password) X $csr = &ora_open($lda, $stmt) X &ora_bind($csr, $var, ...) X &ora_fetch($csr) X &ora_close($csr) + &ora_do($lda, $stmt) X &ora_logoff($lda) X X $ora_debug *************** *** 22,27 **** --- 25,33 ---- X which has been extended (through the \fIusersubs\fP feature) X to allow access to \fIOracle\fP databases. X .SH Functions + The \fIora_version\fP function + prints the version number and copyright information concerning Oraperl. + X Any program wishing to access an \fIOracle\fP database X must first log in to \fIOracle\fP X using \fIora_login\fP. *************** *** 32,48 **** X (an \fIORACLE Login Data Area\fP). X X To specify the \fISQL\fP statement to be executed, ! the program must call \fIora_open\fP. ! This function takes two parameters: X a login identifier (obtained from \fIora_login\fP) X and the \fISQL\fP statement to be executed. SHAR_EOF true || echo 'restore of Patch03 failed' fi echo 'End of part 1' echo 'File Patch03 is continued in part 2' echo 2 > _shar_seq_.tmp exit 0 exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.