Newsgroups: comp.sources.misc
From: kstock@gouldfr.encore.fr (Kevin Stock)
Subject:  v26i036:  oraperl - Extensions to Perl to access Oracle databases, Patch04
Message-ID: <1991Nov21.000708.16635@sparky.imd.sterling.com>
X-Md4-Signature: 17834b3d980868d2d38d344d52f2ebc5
Date: Thu, 21 Nov 1991 00:07:08 GMT
Approved: kent@sparky.imd.sterling.com

Submitted-by: kstock@gouldfr.encore.fr (Kevin Stock)
Posting-number: Volume 26, Issue 36
Archive-name: oraperl/patch04
Environment: Perl, Oracle
Patch-To: oraperl: Volume 18, Issue 10

This is Patch 04 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
	v25i035, 036	patch 03


			Details of Patch 04
			-------------------

The main change is that you can now build coraperl, a version of Perl
which incorporates Larry's curses subs into Oraperl. Look at the new,
all-singing, all-dancing mkdb.pl for an example. (This was trivial to
add since Larry added Sys V curses in 4.0.19.)

 Changes
 -------
Added "coraperl" - Perl with Oracle and Curses
Modified mkdb.pl to use the curses functions if they're available
Added a note about dual-universe machines to the Hints file
Added a strtoul() function instead of strtol
Added "sql" - a script to execute SQL statements from the command line
Separated the clean and realclean/clobber targets

 What to do
 ----------
To apply this patch, unshar the shar file which follows. This will
create the following files:

	Patch04
	sql
	strtoul.c

Run the file Patch04 through the patch program.

Fix anything you need for your system in the Makefile. Then read
README and run make.

  ,---------------.
,-+-------------. |    Kevin Stock
| | E N C O R E | |
| `-------------+-'    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/19/1991 10:59 UTC by kstock@mmcompta
# Source directory /usr/local/src/cmd/oraperl
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  24488 -rw-r--r-- Patch04
#   2802 -rwxr-xr-x sql
#   4318 -rw-r--r-- strtoul.c
#
# ============= Patch04 ==============
if test -f 'Patch04' -a X"$1" != X"-c"; then
	echo 'x - skipping Patch04 (File already exists)'
else
echo 'x - extracting Patch04 (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Patch04' &&
XPrereq: 3
X*** :PostedVersion/patchlevel.h	Tue Nov 19 11:36:52 1991
X--- ./patchlevel.h	Wed Nov 13 15:55:28 1991
X***************
X*** 1,3 ****
X  /* patchlevel.h */
X  
X! #define	PATCHLEVEL	3
X--- 1,3 ----
X  /* patchlevel.h */
X  
X! #define	PATCHLEVEL	4
X*** :PostedVersion/CHANGES	Tue Nov 19 11:37:20 1991
X--- ./CHANGES	Tue Nov 19 11:27:11 1991
X***************
X*** 28,30 ****
X--- 28,40 ----
X  Added the &ora_do() function, equivalent to &ora_close(&ora_open(...))
X  Added handling of NULL values returned from the database
X  Added an 'oraperl.ph' file
X+ 
X+ Patch 04
X+ ========
X+ Added "coraperl" - Perl with Oracle and Curses
X+ Modified mkdb.pl to use the curses functions if they're available
X+ Added sql, a script which executes SQL statements from the command line
X+ Added a note about dual-universe machines to the Hints file
X+ Added a strtoul() function
X+ Separated the clean and realclean/clobber targets
X+ Cleaned up a few bits and pieces - shouldn't make any difference
X*** :PostedVersion/Hints	Tue Nov 19 11:37:21 1991
X--- ./Hints	Tue Nov 19 11:27:25 1991
X***************
X*** 14,20 ****
X  Building on a Convex machine
X  ============================
X  
X! Uncomment the definitions of STRTOL and PUTENV in the Makefile.
X  
X  
X  Building with Perl v3
X--- 14,35 ----
X  Building on a Convex machine
X  ============================
X  
X! Uncomment the definition PUTENV and comment the definition of STRTOUL in
X! the Makefile.
X! 
X! 
X! Building on Dual Universe machines
X! ==================================
X! 
X! This was reported on a Pyramid machine, but I think it applies to most (if
X! not all) dual-universe systems (Sequent, Gould, etc).  Although packages
X! built in one universe will run correctly in the other, hybrids (packages
X! built partly in one universe and partly in the other) will not work
X! properly in either.
X! 
X! Since Oracle specifies that it is to be installed in the ATT universe, you
X! must also compile Perl and Oraperl in the ATT universe to allow them to be
X! linked together successfully.
X  
X  
X  Building with Perl v3
X*** :PostedVersion/Makefile	Tue Nov 19 11:37:21 1991
X--- ./Makefile	Mon Nov 18 16:43:57 1991
X***************
X*** 1,4 ****
X! # Makefile for Oraperl
X  
X  # Change these to your ORACLE installation directory and Perl source directory
X  
X--- 1,4 ----
X! # Makefile for Oraperl and Coraperl
X  
X  # Change these to your ORACLE installation directory and Perl source directory
X  
X***************
X*** 18,38 ****
X  
X  GLOBINCS	= 
X  LOCINCS		= 
X! LIBS		= -lnsl_s -lsocket -ldbm -lmalloc -lm 
X  
X  # Oraperl Definitions
X  
X  # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
X- 
X  DEBUG		= -DPERL_DEBUGGING
X  
X  # Some system-specific things
X  #
X  # If you have setenv() instead of putenv(), uncomment the next line
X  # PUTENV	= -Dputenv=setenv
X  #
X! # If you have strtoul(), uncomment the next line
X! # STRTOL	= -Dstrtol=strtoul
X  #
X  # If you are using Perl v3 instead of v4, uncomment the next line
X  # STR_2MORTAL	= -Dstr_2mortal=str_2static
X--- 18,41 ----
X  
X  GLOBINCS	= 
X  LOCINCS		= 
X! LIBS		= `. $(SRC)/config.sh; echo $$libs`
X  
X  # Oraperl Definitions
X  
X  # Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
X  DEBUG		= -DPERL_DEBUGGING
X  
X+ # Curses Definitions
X+ 
X+ CURSELIB	= -lcurses	# you may also need -ltermlib
X+ 
X  # Some system-specific things
X  #
X  # If you have setenv() instead of putenv(), uncomment the next line
X  # PUTENV	= -Dputenv=setenv
X  #
X! # If your system library does not include strtoul, uncomment the next line
X! STRTOUL	= strtoul.o
X  #
X  # If you are using Perl v3 instead of v4, uncomment the next line
X  # STR_2MORTAL	= -Dstr_2mortal=str_2static
X***************
X*** 39,63 ****
X  
X  # From here on, you shouldn't need to change anything
X  
X! SRCS		= usersub.c oracle.mus orafns.c getcursor.c colons.c
X! OBJS		= usersub.o oracle.o orafns.o getcursor.o colons.o
X  HDRS		= patchlevel.h orafns.h
X  DEFS		= $(STRTOL) $(PUTENV) $(STR_2MORTAL)
X  
X  CFLAGS		= $(DEBUG) -I$(SRC) $(GLOBINCS) $(LOCINCS) $(DEFS) -O
X  
X! oraperl: $(SRC)/uperl.o $(OBJS)
X! 	$(CC) -o oraperl $(SRC)/uperl.o $(OBJS)				\
X  	      -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS)
X  
X  oracle.c: $(SRC)/usub/mus oracle.mus
X  	$(SRC)/usub/mus oracle.mus >oracle.c
X  
X! $(OBJS):	$(HDRS)
X  
X  clean:
X! 	rm -f nohup.out oraperl *.o oracle.c oraperl.man oraperl.doc.pr \
X! 	      oraperl.ref.pr listing tags core PATCHLEVEL
X  
X  listing:
X  	pr -fn Makefile $(HDRS) $(SRCS) >listing
X--- 42,81 ----
X  
X  # From here on, you shouldn't need to change anything
X  
X! SRCS		= oracle.mus orafns.c getcursor.c colons.c usersub.c strtoul.c
X! OBJS		= oracle.o orafns.o getcursor.o colons.o $(STRTOUL)
X! OOBJS		= $(OBJS) usersub.o
X! COBJS		= $(OBJS) cusersub.o
X  HDRS		= patchlevel.h orafns.h
X  DEFS		= $(STRTOL) $(PUTENV) $(STR_2MORTAL)
X  
X  CFLAGS		= $(DEBUG) -I$(SRC) $(GLOBINCS) $(LOCINCS) $(DEFS) -O
X  
X! oraperl: $(SRC)/uperl.o $(OOBJS)
X! 	$(CC) -o oraperl $(SRC)/uperl.o $(OOBJS)			\
X  	      -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS)
X  
X+ coraperl: $(SRC)/uperl.o $(COBJS) $(SRC)/usub/curses.o
X+ 	$(CC) -o coraperl $(SRC)/uperl.o $(COBJS) $(SRC)/usub/curses.o	\
X+ 	      -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS) $(LIBS) $(CURSELIB)
X+ 
X+ cusersub.o:	usersub.c
X+ 	@rm -f cusersub.c
X+ 	ln usersub.c cusersub.c
X+ 	$(CC) -c $(CFLAGS) -DCURSES cusersub.c
X+ 
X  oracle.c: $(SRC)/usub/mus oracle.mus
X  	$(SRC)/usub/mus oracle.mus >oracle.c
X  
X! $(OOBJS) $(COBJS):	$(HDRS)
X  
X  clean:
X! 	rm -f nohup.out *.o oracle.c cusersub.c			\
X! 		oraperl.man oraperl.doc.pr oraperl.ref.pr	\
X! 		listing tags core
X! 
X! clobber realclean:	clean
X! 	rm -f oraperl coraperl
X  
X  listing:
X  	pr -fn Makefile $(HDRS) $(SRCS) >listing
X***************
X*** 66,69 ****
X  	nroff -man oraperl.1 >oraperl.man
X  	nroff oraperl.doc >oraperl.doc.pr
X  	nroff oraperl.ref >oraperl.ref.pr
X- 
X--- 84,86 ----
X*** :PostedVersion/README	Tue Nov 19 11:37:21 1991
X--- ./README	Tue Nov 19 11:28:30 1991
X***************
X*** 1,5 ****
X  This is an instant-mix package (just add Perl) to create Oraperl,
X! a version of Perl which is capable of accessing Oracle databases.
X  To use it, you must have the Oracle Pro*C product and a version of
X  Perl which supports Usersubs (v3.0.27 or later).
X  
X--- 1,6 ----
X  This is an instant-mix package (just add Perl) to create Oraperl,
X! a version of Perl which is capable of accessing Oracle databases,
X! and Coraperl, a version of Oraperl which also includes Curses.
X  To use it, you must have the Oracle Pro*C product and a version of
X  Perl which supports Usersubs (v3.0.27 or later).
X  
X***************
X*** 22,30 ****
X  	STRTOL		 +- system dependent - see Makefile for details
X  	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,
X  bug-reports etc.
X  
X  In addition to this README, the package contains the following files:
X--- 23,38 ----
X  	STRTOL		 +- system dependent - see Makefile for details
X  	STR_2MORTAL	/
X  
X+ As well as oraperl, you can also type "make coraperl" to create a version
X+ of Oraperl which incorporates curses. You must compile curseperl first (in
X+ $(SRC)/usub), and leave the curses.o file there. You probably need Perl
X+ v4.0.19 or later for this to work, as that was the first version to
X+ support System V curses.
X+ 
X  I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
X! using Perl (all versions from 3.0.34 to 4.0.19) with Oracle version 6, as
X! I don't have access to any other system with Pro*C. However, other people
X! have compiled and used it on different systems. I'd appreciate any comments,
X  bug-reports etc.
X  
X  In addition to this README, the package contains the following files:
X***************
X*** 38,49 ****
X  	orafns.c	actual functions to interact with oracle
X  	usersub.c	initialisation routine
X  	colons.c	counts substitution variables in a statement
X  
X  Examples
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! 			and ora_do()
X  
X  Documentation
X  	oraperl.doc	explains some of the thinking behind Oraperl
X--- 46,59 ----
X  	orafns.c	actual functions to interact with oracle
X  	usersub.c	initialisation routine
X  	colons.c	counts substitution variables in a statement
X+ 	strtoul.c	for systems which don't have strtoul(3)
X  
X  Examples
X  	debug-p		tests to see if debugging is available
X! 	ex.pl		simple example of Oraperl functions
X! 	mkdb.pl		more extensive example, using curses if available
X! 			you can run this with either Oraperl or Coraperl
X! 	sql		execute an SQL statement from the command line
X  
X  Documentation
X  	oraperl.doc	explains some of the thinking behind Oraperl
X*** :PostedVersion/getcursor.c	Tue Nov 19 11:37:22 1991
X--- ./getcursor.c	Mon Nov 18 15:33:05 1991
X***************
X*** 16,22 ****
X  
X  
X  /* head of the cursor list */
X! struct cursor csr_list = { NULL, NULL, NULL, 0, NULL };
X  
X  
X  /* ora_free_data(csr)
X--- 16,22 ----
X  
X  
X  /* head of the cursor list */
X! struct cursor csr_list = { NULL, NULL, NULL, NULL, 0, 0, NULL };
X  
X  
X  /* ora_free_data(csr)
X*** :PostedVersion/mkdb.pl	Tue Nov 19 11:37:22 1991
X--- ./mkdb.pl	Mon Nov 18 16:45:41 1991
X***************
X*** 1,39 ****
X- #!./oraperl
X- #
X  # mkdb.pl
X  #
X! # Sample oraperl program to create a new database and load data into it.
X  #
X  # Author:	Kevin Stock
X  # Date:		5th August 1991
X  #
X  
X! # make sure that we really are running oraperl
X  die ("You should use oraperl, not perl\n") unless defined &ora_login;
X  
X! # get debugging & error codes
X! require('oraperl.ph');
X  
X! # let's see what oraperl is doing when it executes this
X! $ora_debug = $ODBG_EXEC | $ODBG_STRNUM | $ODBG_MALLOC;
X  
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";
X! $DELETE	= "delete from tryit where name = :1";
X! $DROP	= "drop table tryit";
X  
X! format top =
X!        Name         Ext
X!        ====         ===
X  .
X  
X! format STDOUT =
X!        @<<<<<<<<<   @>>
X!        $name,       $ext
X  .
X  
X  # function to list the database
X  
X  sub list
X--- 1,85 ----
X  # mkdb.pl
X  #
X! # Sample (c)oraperl program to create a new database and load data into it.
X  #
X  # Author:	Kevin Stock
X  # Date:		5th August 1991
X  #
X+ # Modified to use curses functions if present.
X+ #
X+ # Date:		15th November 1991
X+ #
X  
X! # make sure that we really are running (c)oraperl
X  die ("You should use oraperl, not perl\n") unless defined &ora_login;
X  
X! # Arrange to use curses functions if they're available.
X! # (This is just showing off)
X  
X! if (defined(&initscr) && &initscr())
X! {
X!     eval <<'____END_OF_CURSES_STUFF';
X  
X! 	$curses = 1;
X! 
X! 	# functions used by the list function
X! 
X! 	sub before
X! 	{
X! 		&erase();
X! 		&standout();
X! 		&addstr("Num  Name           Ext\n\n");
X! 		&standend();
X! 		$lineno = 1;
X! 	}
X! 
X! 	sub during
X! 	{
X! 		&addstr(sprintf("%2d   %-15s%3d\n", $lineno++, $name, $ext));
X! 	}
X! 
X! 	sub after
X! 	{
X! 		&standout();
X! 		&move($LINES - 1, 0);
X! 		&addstr("Press RETURN to continue.");
X! 		&standend();
X! 		&refresh();
X! 		&getstr($dummy);
X! 		&move($LINES - 1, 0);
X! 		&addstr("                         ");
X! 		&move($LINES - 1, 0);
X! 		&refresh();
X! 	}
X! 
X! ____END_OF_CURSES_STUFF
X! }
X! else
X! {
X!     eval <<'____END_OF_PLAIN_STUFF';
X! 
X! 	$curses = 0;
X! 	$ora_debug = 8;
X  
X! 	format top =
X! 	       Name         Ext
X! 	       ====         ===
X  .
X  
X! 	format STDOUT =
X! 	       @<<<<<<<<<   @>>
X! 	       $name,       $ext
X  .
X  
X+ 	# functions used by the list function
X+ 
X+ 	sub before	{ $- = 0; }
X+ 	sub during	{ write; }
X+ 	sub after	{ 1; }
X+ 
X+ ____END_OF_PLAIN_STUFF
X+ }
X+ 
X  # function to list the database
X  
X  sub list
X***************
X*** 40,56 ****
X  {
X  	local($csr, $name, $ext);
X  
X! 	$- = 0;
X  
X  	$csr = &ora_open($lda, $LIST)			|| die $ora_errstr;
X  	while (($name, $ext) = &ora_fetch($csr))
X  	{
X! 		write;
X  	}
X  	die $ora_errstr if ($ora_errno != 0);
X  	do ora_close($csr)				|| die $ora_errstr;
X  }
X  
X  # create the database
X  
X  $lda = &ora_login("t", "kstock", "kstock")	|| die $ora_errstr;
X--- 86,114 ----
X  {
X  	local($csr, $name, $ext);
X  
X! 	do before();
X  
X  	$csr = &ora_open($lda, $LIST)			|| die $ora_errstr;
X  	while (($name, $ext) = &ora_fetch($csr))
X  	{
X! 		do during();
X  	}
X  	die $ora_errstr if ($ora_errno != 0);
X  	do ora_close($csr)				|| die $ora_errstr;
X+ 
X+ 	do after();
X  }
X  
X+ # get debugging & error codes
X+ require('oraperl.ph');
X+ 
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";
X+ $DELETE	= "delete from tryit where name = :1";
X+ $DROP	= "drop table tryit";
X+ 
X  # create the database
X  
X  $lda = &ora_login("t", "kstock", "kstock")	|| die $ora_errstr;
X***************
X*** 82,89 ****
X  do list();
X  
X  # remove the database and log out
X! $csr = &ora_do($lda, $DROP)			|| die $ora_errstr;
X  do ora_logoff($lda)				|| die $ora_errstr;
X  
X  # This is the data which will go into the database
X  __END__
X--- 140,149 ----
X  do list();
X  
X  # remove the database and log out
X! do ora_do($lda, $DROP)				|| die $ora_errstr;
X  do ora_logoff($lda)				|| die $ora_errstr;
X+ 
X+ do endwin() if $curses == 1;
X  
X  # This is the data which will go into the database
X  __END__
X*** :PostedVersion/oracle.mus	Tue Nov 19 11:37:23 1991
X--- ./oracle.mus	Mon Nov 18 16:52:23 1991
X***************
X*** 106,112 ****
X  
X  	    if (curcsv->wantarray) {	/* in array context, return the data */
X  		int  retval;
X- 		char *tmps;
X  
X  		retval = ora_fetch(csr);
X  		astore(stack, sp + retval, Nullstr);
X--- 106,111 ----
X***************
X*** 120,126 ****
X  		struct cursor *csrp;
X  		extern int check_csr();
X  
X! 		csrp = (struct cursor *) strtol(csr, (char *) NULL, 0);
X  		if (check_csr(csrp))
X  		    str_numset(st[0], (double) csrp->nfields);
X  		else
X--- 119,125 ----
X  		struct cursor *csrp;
X  		extern int check_csr();
X  
X! 		csrp = (struct cursor *) strtoul(csr, (char *) NULL, 0);
X  		if (check_csr(csrp))
X  		    str_numset(st[0], (double) csrp->nfields);
X  		else
X***************
X*** 136,142 ****
X  	else {
X  	    char *csr		= (char *) str_get(st[1]);
X  	    char **vars		= (char **) malloc((items-1) * sizeof(char *));
X! 	    int i, retval;
X  
X  	    if (vars == NULL)
X  	    {
X--- 135,141 ----
X  	else {
X  	    char *csr		= (char *) str_get(st[1]);
X  	    char **vars		= (char **) malloc((items-1) * sizeof(char *));
X! 	    int retval;
X  
X  	    if (vars == NULL)
X  	    {
X*** :PostedVersion/orafns.c	Tue Nov 19 11:37:23 1991
X--- ./orafns.c	Mon Nov 18 17:31:39 1991
X***************
X*** 197,203 ****
X  	{
X  		DEBUG(8, -1, (fputs(
X  		    "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--- 197,203 ----
X  	{
X  		DEBUG(8, -1, (fputs(
X  		    "ora_login: couldn't select database\n", stderr)));
X! 		(void) ora_dropcursor(lda);
X  		return(NULL);
X  	}
X  	else if (strcmp(database, getenv("ORACLE_SID")) != 0)
X***************
X*** 205,211 ****
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_login: ORACLE_SID misset to %s\n",
X  		    (tmp = getenv("ORACLE_SID")) ? tmp : "<NULL>")));
X! 		ora_dropcursor(lda);
X  		ora_errno = ORAP_NOSID;
X  		return(NULL);
X  	}
X--- 205,211 ----
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_login: ORACLE_SID misset to %s\n",
X  		    (tmp = getenv("ORACLE_SID")) ? tmp : "<NULL>")));
X! 		(void) ora_dropcursor(lda);
X  		ora_errno = ORAP_NOSID;
X  		return(NULL);
X  	}
X***************
X*** 227,233 ****
X  	else
X  	{
X  		ora_errno = lda->csr->csrrc;
X! 		ora_droplda(lda);
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_login: failed (error %d)\n", ora_errno)));
X  		return((char *) NULL);
X--- 227,233 ----
X  	else
X  	{
X  		ora_errno = lda->csr->csrrc;
X! 		(void) ora_droplda(lda);
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_login: failed (error %d)\n", ora_errno)));
X  		return((char *) NULL);
X***************
X*** 246,252 ****
X  {
X  	int i;
X  	struct cursor *csr;
X! 	struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
X  	short dsize;
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X--- 246,252 ----
X  {
X  	int i;
X  	struct cursor *csr;
X! 	struct cursor *lda = (struct cursor *)strtoul(lda_s, (char **) NULL, 0);
X  	short dsize;
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X***************
X*** 288,294 ****
X  	    || ((csr->varfields == 0) && (oexec(csr->csr) != 0)))
X  	{
X  		ora_errno = csr->csr->csrrc;
X! 		ora_dropcursor(csr);
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_open: couldn't run SQL statement (error %d)\n",
X  		    ora_errno)));
X--- 288,294 ----
X  	    || ((csr->varfields == 0) && (oexec(csr->csr) != 0)))
X  	{
X  		ora_errno = csr->csr->csrrc;
X! 		(void) ora_dropcursor(csr);
X  		DEBUG(8, -1, (fprintf(stderr,
X  		    "ora_open: couldn't run SQL statement (error %d)\n",
X  		    ora_errno)));
X***************
X*** 309,317 ****
X  
X  	if (i > 0)
X  	{
X  		if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
X  		{
X! 			ora_dropcursor(csr);
X  			DEBUG((8 | 128), -1, (fputs(
X  			    "ora_open: out of memory\n", stderr)));
X  			ora_errno = ORAP_NOMEM;
X--- 309,320 ----
X  
X  	if (i > 0)
X  	{
X+ 		DEBUG(8, 0, (fprintf(stderr,
X+ 		    "ora_open: statement returns %d fields\n", i)));
X+ 
X  		if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
X  		{
X! 			(void) ora_dropcursor(csr);
X  			DEBUG((8 | 128), -1, (fputs(
X  			    "ora_open: out of memory\n", stderr)));
X  			ora_errno = ORAP_NOMEM;
X***************
X*** 323,329 ****
X  
X  		if ((csr->rcode = (short *) malloc(i * sizeof(short))) == NULL)
X  		{
X! 			ora_dropcursor(csr);
X  			DEBUG((8 | 128), -1, (fputs(
X  			    "ora_open: out of memory\n", stderr)));
X  			ora_errno = ORAP_NOMEM;
X--- 326,332 ----
X  
X  		if ((csr->rcode = (short *) malloc(i * sizeof(short))) == NULL)
X  		{
X! 			(void) ora_dropcursor(csr);
X  			DEBUG((8 | 128), -1, (fputs(
X  			    "ora_open: out of memory\n", stderr)));
X  			ora_errno = ORAP_NOMEM;
X***************
X*** 344,350 ****
X  			if ((csr->data[i] = (char *) malloc(dsize+1)) == NULL)
X  			{
X  				csr->nfields = i;
X! 				ora_dropcursor(csr);
X  				DEBUG((8 | 128), -1, (fputs(
X  				    "ora_open: out of memory\n", stderr)));
X  				ora_errno = ORAP_NOMEM;
X--- 347,353 ----
X  			if ((csr->data[i] = (char *) malloc(dsize+1)) == NULL)
X  			{
X  				csr->nfields = i;
X! 				(void) ora_dropcursor(csr);
X  				DEBUG((8 | 128), -1, (fputs(
X  				    "ora_open: out of memory\n", stderr)));
X  				ora_errno = ORAP_NOMEM;
X***************
X*** 385,391 ****
X  char *csr_s;
X  {
X  	int i;
X! 	struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X  	    "ora_fetch(%s)\n", csr_s)));
X--- 388,394 ----
X  char *csr_s;
X  {
X  	int i;
X! 	struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X  	    "ora_fetch(%s)\n", csr_s)));
X***************
X*** 452,459 ****
X  
X  	if (ora_debug & 8)
X  	{
X- 		int i;
X- 
X  		DEBUG(8, 0, (fputs("ora_fetch: returning data:\n", stderr)));
X  		for (i = 0 ; i < csr->nfields ; i++)
X  		{
X--- 455,460 ----
X***************
X*** 480,487 ****
X  char *csr_s, **vars;
X  int nitems;
X  {
X! 	int i, ret;
X! 	struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X  	    "ora_bind(%s, %#lx, %d)\n", csr_s, (long) vars, nitems)));
X--- 481,488 ----
X  char *csr_s, **vars;
X  int nitems;
X  {
X! 	int i;
X! 	struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr,
X  	    "ora_bind(%s, %#lx, %d)\n", csr_s, (long) vars, nitems)));
X***************
X*** 505,511 ****
X  
X  	for (i = 0 ; i < nitems ; i++)
X  	{
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  			DEBUG(8, -1, (fprintf(stderr,
X--- 506,512 ----
X  
X  	for (i = 0 ; i < nitems ; i++)
X  	{
X! 		if ((obndrn(csr->csr, i+1, vars[i], strlen(vars[i])+1,
X  			5, -1, (short *) -1, (char *) -1, 0, 0)) != 0)
X  		{
X  			DEBUG(8, -1, (fprintf(stderr,
X***************
X*** 576,582 ****
X  char *ora_close(csr_s)
X  char *csr_s;
X  {
X! 	struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
X  
X  
X  	DEBUG(8, 1, (fprintf(stderr, "ora_close(%s)\n", csr_s)));
X--- 577,583 ----
X  char *ora_close(csr_s)
X  char *csr_s;
X  {
X! 	struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0);
X  
X  
X  	DEBUG(8, 1, (fprintf(stderr, "ora_close(%s)\n", csr_s)));
X***************
X*** 593,599 ****
X  
X  	oclose(csr->csr);
X  	ora_errno = csr->csr->csrrc;
X! 	ora_dropcursor(csr);
X  
X  	DEBUG(8, -1, (fputs("ora_close: returning OK\n", stderr)));
X  	return(OK);
X--- 594,600 ----
X  
X  	oclose(csr->csr);
X  	ora_errno = csr->csr->csrrc;
X! 	(void) ora_dropcursor(csr);
X  
X  	DEBUG(8, -1, (fputs("ora_close: returning OK\n", stderr)));
X  	return(OK);
X***************
X*** 608,614 ****
X  char *ora_logoff(lda_s)
X  char *lda_s;
X  {
X! 	struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr, "ora_logoff(%s)\n", lda_s)));
X  	DEBUG(32, 0, (fprintf(stderr,
X--- 609,615 ----
X  char *ora_logoff(lda_s)
X  char *lda_s;
X  {
X! 	struct cursor *lda = (struct cursor *)strtoul(lda_s, (char **) NULL, 0);
X  
X  	DEBUG(8, 1, (fprintf(stderr, "ora_logoff(%s)\n", lda_s)));
X  	DEBUG(32, 0, (fprintf(stderr,
X***************
X*** 624,630 ****
X  
X  	ologof(lda->csr);
X  	ora_errno = lda->csr->csrrc;
X! 	ora_droplda(lda);
X  
X  	DEBUG(8, -1, (fputs("ora_logoff: returning OK\n", stderr)));
X  	return(OK);
X--- 625,631 ----
X  
X  	ologof(lda->csr);
X  	ora_errno = lda->csr->csrrc;
X! 	(void) ora_droplda(lda);
X  
X  	DEBUG(8, -1, (fputs("ora_logoff: returning OK\n", stderr)));
X  	return(OK);
X*** :PostedVersion/orafns.h	Tue Nov 19 11:37:24 1991
X--- ./orafns.h	Mon Nov 18 17:31:08 1991
X***************
X*** 12,17 ****
X--- 12,19 ----
X  
X  /* public functions to be called by Perl programs */
X  
X+ void		ora_version();
X+ 
X  char		*ora_login(),
X  		*ora_open(),
X  		*ora_close(),
X***************
X*** 77,85 ****
X  
X  /* functions that we use */
X  
X! int	count_colons();
X! long	strtol();
X! char	*getenv(), *malloc();
X  
X  
X  /* variables accesible to the outside world */
X--- 79,87 ----
X  
X  /* functions that we use */
X  
X! int		count_colons();
X! unsigned long	strtoul();
X! char		*getenv(), *malloc();
X  
X  
X  /* variables accesible to the outside world */
X*** :PostedVersion/oraperl.1	Tue Nov 19 11:37:24 1991
X--- ./oraperl.1	Wed Nov 13 16:05:57 1991
X***************
X*** 4,9 ****
X--- 4,11 ----
X  .nh
X  .SH NAME
X  oraperl \- Perl access to Oracle databases
X+ .br
X+ coraperl \- Oraperl with Curses functions
X  .SH SYNOPSIS
X  .nf
X  &ora_version
X***************
X*** 24,29 ****
X--- 26,34 ----
X  \fBOraperl\fP is a version of \fIPerl\fP
X  which has been extended (through the \fIusersubs\fP feature)
X  to allow access to \fIOracle\fP databases.
X+ 
X+ \fBCoraperl\fP additionally includes the \fIcurses\fP routines
X+ from the \fIusub\fP example included with the \fIPerl\fP source.
X  .SH Functions
X  The \fIora_version\fP function
X  prints the version number and copyright information concerning Oraperl.
X***************
X*** 203,209 ****
X  
X  .ti -5
X  \fIPerl\fP documentation:
X! \fIProgramming Perl\fP by Larry Wall and Randall Schwartz
X  \fIperl(1)\fP
X  .in -5
X  .fi
X--- 208,214 ----
X  
X  .ti -5
X  \fIPerl\fP documentation:
X! \fIProgramming Perl\fP by Larry Wall and Randal Schwartz
X  \fIperl(1)\fP
X  .in -5
X  .fi
X***************
X*** 210,216 ****
X  .SH AUTHORS
X  \fIORACLE\fP by Oracle Corporation, California.
X  .br
X! \fIPerl\fP by Larry Wall, Netlabs
X  .if t .ft C
X  (lwall@netlabs.com).
X  .if t .ft P
X--- 215,221 ----
X  .SH AUTHORS
X  \fIORACLE\fP by Oracle Corporation, California.
X  .br
X! \fIPerl\fP and \fICurseperl\fP by Larry Wall, Netlabs
X  .if t .ft C
X  (lwall@netlabs.com).
X  .if t .ft P
X*** :PostedVersion/usersub.c	Tue Nov 19 11:37:25 1991
X--- ./usersub.c	Wed Nov 13 15:55:19 1991
X***************
X*** 17,22 ****
X--- 17,25 ----
X  userinit()
X  {
X      init_oracle();
X+ #ifdef CURSES
X+     init_curses();
X+ #endif
X  
X  #ifdef DEBUGGING
X  #   ifdef PERL_DEBUGGING
X***************
X*** 28,31 ****
X  
X      ora_errno = 0;
X  }
X- 
X--- 31,33 ----
SHAR_EOF
chmod 0644 Patch04 ||
echo 'restore of Patch04 failed'
Wc_c="`wc -c < 'Patch04'`"
test 24488 -eq "$Wc_c" ||
	echo 'Patch04: original size 24488, current size' "$Wc_c"
fi
# ============= sql ==============
if test -f 'sql' -a X"$1" != X"-c"; then
	echo 'x - skipping sql (File already exists)'
else
echo 'x - extracting sql (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'sql' &&
X#!/usr/local/bin/oraperl
X'di';
X'ig00';
X#
X# sql [-ddelim] username/password statement
X#
X# Script to run an Oracle statement from the command line.
X# Written in response to <nirad.690285085@newdelphi> in alt.sources.wanted.
X#
X# Author:	Kevin Stock
X# Date:		18th November 1991
X#
X
X# $ora_debug = 8;		# if you want to see what's happenning
X
X$, = "\t";			# default delimiter is a tab
X$\ = "\n";			# each record terminated with newline
X
Xif ($ARGV[0] =~ /^-d(.*)/)	# allows the delimiter to be empty
X{
X	$, = $1;
X	shift;
X}
X
X$USER = shift;			# get the user name and password
Xdie "Usage: $0 sql [-ddelim] username/password statement\n" unless $#ARGV >= 0;
X
X# log into the database and execute the statement
X
X$lda = &ora_login($ENV{'ORACLE_SID'}, $USER, '') || die "$ora_errstr\n";
X$csr = &ora_open($lda, "@ARGV") || die "$ora_errstr\n";
X
X# print out any information which comes back
X
Xif (&ora_fetch($csr) > 0)	# does the statement return data?
X{
X	while (@result = &ora_fetch($csr))
X	{
X		print @result;
X	}
X	warn "$ora_errstr\n" if ($ora_errno != 0);
X}
X
X# finish off neatly
X
Xdo ora_close($csr);
Xdo ora_logoff($lda);
X
X__END__		# no need for perl even to scan the rest
X
X##############################################################################
X
X	# These next few lines are legal in both Perl and nroff.
X
X.00;			# finish .ig
X 
X'di			\" finish diversion--previous line must be blank
X.nr nl 0-1		\" fake up transition to first page again
X.nr % 0			\" start at page 1
X';<<'.ex'; ############## From here on it's a standard manual page ############
X.ll 80
X.TH SQL L "18th November 1991"
X.ad
X.nh
X.SH NAME
Xsql \- execute an Oracle SQL statement from the command line
X.SH SYNOPSIS
X\fBsql\fP [\fB\-d\fP\fIdelim\fP] \fIname\fP\fB/\fP\fIpassword\fP \fIstatement\fP
X.SH DESCRIPTION
X.I Sql
Xconnects to an Oracle database
Xusing the \fIname/password\fP supplied
Xand executes the given SQL \fIstatement\fP
Xreturning the result
X(without column headers)
Xon its standard output.
XNormally, fields are separated with tabs;
Xthis may be changed to any desired string (\fIdelim\fP)
Xusing the \fB\-d\fP flag.
X.SH ENVIRONMENT
XThe environment variable \fBORACLE_SID\fP
Xdetermines the Oracle database to be used.
X.SH DIAGNOSTICS
XThe only diagnostic generated by \fIsql\fP is a usage message.
XHowever, you may also encounter
Xerror messages from Oraperl (unlikely) or Oracle (more common).
XSee the \fIOracle Error Messages and Codes Manual\fP for details.
X.SH NOTES
XThis program is only intended for use from the command line.
XIf you use it within a shell script
Xthen you should consider rewriting it in Oraperl
Xto use Perl's text manipulation and formatting commands.
X.SH "SEE ALSO"
X\fISQL Language Reference Manual\fP
X.br
Xperl(1),
Xoraperl(1)
X.SH AUTHOR
XKevin Stock,
X.if t .ft C
X<kstock@gouldfr.encore.fr, kstock@encore.com>
X.if t .ft P
X.ex
SHAR_EOF
chmod 0755 sql ||
echo 'restore of sql failed'
Wc_c="`wc -c < 'sql'`"
test 2802 -eq "$Wc_c" ||
	echo 'sql: original size 2802, current size' "$Wc_c"
fi
# ============= strtoul.c ==============
if test -f 'strtoul.c' -a X"$1" != X"-c"; then
	echo 'x - skipping strtoul.c (File already exists)'
else
echo 'x - extracting strtoul.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'strtoul.c' &&
X/* 
X * strtoul.c --
X *
X *	Source code for the "strtoul" library procedure.
X *
X * Copyright 1988 Regents of the University of California
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/compat/RCS/strtoul.c,v 1.2 91/09/22 14:04:43 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <ctype.h>
X
X/*
X * The table below is used to convert from ASCII digits to a
X * numerical equivalent.  It maps from '0' through 'z' to integers
X * (100 for non-digit characters).
X */
X
Xstatic char cvtIn[] = {
X    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,		/* '0' - '9' */
X    100, 100, 100, 100, 100, 100, 100,		/* punctuation */
X    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'A' - 'Z' */
X    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
X    30, 31, 32, 33, 34, 35,
X    100, 100, 100, 100, 100, 100,		/* punctuation */
X    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'a' - 'z' */
X    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
X    30, 31, 32, 33, 34, 35};
X
X/*
X *----------------------------------------------------------------------
X *
X * strtoul --
X *
X *	Convert an ASCII string into an integer.
X *
X * Results:
X *	The return value is the integer equivalent of string.  If endPtr
X *	is non-NULL, then *endPtr is filled in with the character
X *	after the last one that was part of the integer.  If string
X *	doesn't contain a valid integer value, then zero is returned
X *	and *endPtr is set to string.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
Xunsigned long int
Xstrtoul(string, endPtr, base)
X    char *string;		/* String of ASCII digits, possibly
X				 * preceded by white space.  For bases
X				 * greater than 10, either lower- or
X				 * upper-case digits may be used.
X				 */
X    char **endPtr;		/* Where to store address of terminating
X				 * character, or NULL. */
X    int base;			/* Base for conversion.  Must be less
X				 * than 37.  If 0, then the base is chosen
X				 * from the leading characters of string:
X				 * "0x" means hex, "0" means octal, anything
X				 * else means decimal.
X				 */
X{
X    register char *p;
X    register unsigned long int result = 0;
X    register unsigned digit;
X    int anyDigits = 0;
X
X    /*
X     * Skip any leading blanks.
X     */
X
X    p = string;
X    while (isspace(*p)) {
X	p += 1;
X    }
X
X    /*
X     * If no base was provided, pick one from the leading characters
X     * of the string.
X     */
X    
X    if (base == 0)
X    {
X	if (*p == '0') {
X	    p += 1;
X	    if (*p == 'x') {
X		p += 1;
X		base = 16;
X	    } else {
X
X		/*
X		 * Must set anyDigits here, otherwise "0" produces a
X		 * "no digits" error.
X		 */
X
X		anyDigits = 1;
X		base = 8;
X	    }
X	}
X	else base = 10;
X    } else if (base == 16) {
X
X	/*
X	 * Skip a leading "0x" from hex numbers.
X	 */
X
X	if ((p[0] == '0') && (p[1] == 'x')) {
X	    p += 2;
X	}
X    }
X
X    /*
X     * Sorry this code is so messy, but speed seems important.  Do
X     * different things for base 8, 10, 16, and other.
X     */
X
X    if (base == 8) {
X	for ( ; ; p += 1) {
X	    digit = *p - '0';
X	    if (digit > 7) {
X		break;
X	    }
X	    result = (result << 3) + digit;
X	    anyDigits = 1;
X	}
X    } else if (base == 10) {
X	for ( ; ; p += 1) {
X	    digit = *p - '0';
X	    if (digit > 9) {
X		break;
X	    }
X	    result = (10*result) + digit;
X	    anyDigits = 1;
X	}
X    } else if (base == 16) {
X	for ( ; ; p += 1) {
X	    digit = *p - '0';
X	    if (digit > ('z' - '0')) {
X		break;
X	    }
X	    digit = cvtIn[digit];
X	    if (digit > 15) {
X		break;
X	    }
X	    result = (result << 4) + digit;
X	    anyDigits = 1;
X	}
X    } else {
X	for ( ; ; p += 1) {
X	    digit = *p - '0';
X	    if (digit > ('z' - '0')) {
X		break;
X	    }
X	    digit = cvtIn[digit];
X	    if (digit >= base) {
X		break;
X	    }
X	    result = result*base + digit;
X	    anyDigits = 1;
X	}
X    }
X
X    /*
X     * See if there were any digits at all.
X     */
X
X    if (!anyDigits) {
X	p = string;
X    }
X
X    if (endPtr != 0) {
X	*endPtr = p;
X    }
X
X    return result;
X}
SHAR_EOF
chmod 0644 strtoul.c ||
echo 'restore of strtoul.c failed'
Wc_c="`wc -c < 'strtoul.c'`"
test 4318 -eq "$Wc_c" ||
	echo 'strtoul.c: original size 4318, current size' "$Wc_c"
fi
chmod 0644 mkdb.pl
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.