home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 October
/
usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso
/
misc
/
volume38
/
oraperl-v2
/
patch04
next >
Wrap
Text File
|
1993-07-15
|
64KB
|
2,202 lines
Newsgroups: comp.sources.misc
From: Kevin Stock <kstock@encore.com>
Subject: REPOST: v38i009: oraperl-v2 - Extensions to Perl to access Oracle database, Patch04
Message-ID: <1993Jul15.164736.15400@sparky.sterling.com>
X-Md4-Signature: 64905c384350d0e22b046507f4b6ed58
Sender: kent@sparky.sterling.com (Kent Landfield)
Organization: Sterling Software
Date: Thu, 15 Jul 1993 16:47:36 GMT
Approved: kent@sparky.sterling.com
Submitted-by: Kevin Stock <kstock@encore.com>
Posting-number: Volume 38, Issue 9
Archive-name: oraperl-v2/patch04
Environment: Perl, Oracle with OCI, optionally Curses
Patch-To: oraperl-v2: Volume 30, Issue 87-91
[ This is being reposted due to a problem with propagation. -Kent+ ]
This is patch 4 to version 2 of 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. If you
can build Larry's Curseperl, then you can also build Coraperl, which is
Oraperl with Curses.
Oraperl version 2 appeared in the comp.sources.misc newsgroup as
follows:
v30i087-091 Part 01-05 29th June 1992
v30i099 Patch 01 6th July 1992
v32i093 Patch 02 4th October 1992
v34i021 Patch 03 12th December 1992
Oraperl should be available at any comp.sources.misc archive site,
for example wuarchive.wustl.edu [128.252.135.4] (in the USA) or
src.doc.uc.ac.uk (in the UK). On these two sites, look in the
directory /usenet/comp.sources.misc/volume30/oraperl-v2.
I didn't intend to release this patch. Work on DBperl (a standard for
database access from Perl) is well underway, and the next release of
Oraperl should have been version 3, which would have been DBperl
compliant.
However, I have been laid off as part of a cost cutting exercise here,
and I don't know when I'll be able to get net access again. So, this
patch tidies up a few outstanding issues.
As I no longer have access to the net, please do not try to send me
mail. If you really want, you can write to me at the address below, but
please enclose an International Reply Coupon if you want a reply. I
won't have access to a system running Oracle, so I probably won't be
able to give you much help.
Changes
-------
&ora_open() and &ora_do() now ignore colons which are not followed by a
digit. This avoids problems with PL/SQL which uses := for an assignment
operator, and :NAME for trigger names.
$ora_errstr now looks up the error message using oerhms() if possible,
as the manual says it should.
If the first parameter to &ora_login() (the database ID) contains a
colon, then it will be assigned to TWO_TASK, instead of ORACLE_SID.
Note that if you also have a value set in ORACLE_SID, Oracle gets to
use whichever it wants.
The sample script sql no longer requires a value for $ORACLE_SID, since
the application may be using TWO_TASK. Also, if the sql statement is not
specified on the command line, it will be read in from standard input.
To apply the patch, unshar this file in your Oraperl source directory.
Then:
patch -p1 <patch04
make test
My thanks to those who suggested some of these modifications, including
Scott Grosch, Viet Hoang and Charles Jardine.
Kevin Stock
5 rue de la Liberation
78660 ABLIS
France
==========================
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# Contents: FAQ patch4
# Wrapped by kent@sparky on Thu Jun 17 14:11:42 1993
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo ' "shar: End of archive 1 (of 1)."'
if test -f 'FAQ' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'FAQ'\"
else
echo shar: Extracting \"'FAQ'\" \(5279 characters\)
sed "s/^X//" >'FAQ' <<'END_OF_FILE'
X
X Frequently Asked Questions for Oraperl
X ______________________________________
X
X
XWhat is Oraperl?
X----------------
XAccording to Buzz Moschetti, "Oraperl sounds like a denture cleaner".
XFor the rest of us, it's a version of Perl which has been extended to
Xmanipulate Oracle databases.
X
X
XIs Oraperl public domain, shareware, or what?
X---------------------------------------------
XOraperl is Freeware; that is, it's author retains copyright (so it isn't
Xpublic domain) but allows free distribution, under the same terms as
XPerl. It isn't shareware, because you don't have to pay to use it.
X
X
XHow can I contact the author?
X-----------------------------
XUnfortunately, I do not have access to the net at present. If you have
Xproblems with Oraperl, your best bet is to send a message to either
Xcomp.lang.perl or comp.databases.oracle, depending on whether the
Xproblem seems to relate to Perl or to Oracle. A number of Oraperl users
Xhang out on both groups, so you may be able to get an answer there.
X
XIf you really need to contact me, you can write to me at the address
Xbelow. I don't have access to a system running Oracle at present, so I
Xwill only be able to give limited. Please include an International Reply
XCoupon if you want a reply.
X
X Kevin Stock
X 5 rue de la Liberation
X 78660 ABLIS
X France
X
X
XWill Oraperl run on my system?
X------------------------------
XAt present, Oraperl is known to run on the following systems:
X
X Amdhal UTS
X Convex
X Encore Multimax, Oracle v6.0.27, Perl 3.0.27 - 4.0.36
X NeXT
X Prime EXL MBX Sys V.3.1, Oracle 6.0.26
X Pyramid (ATT Universe),
X MIPS (SysVr4)
X Sparcstation
X Sperry 500/80 Sys V.3.1, Oracle v5.1, Perl 4.0.3
X Sun 4/280, Oracle 6.0.30
X SunOS 4.1.1
X Ultrix, Oracle v5
X
Xbut if you can build Perl, you can almost certainly build Oraperl.
X
XOraperl is distributed as source, so you build it yourself (or get a
Xfriendly system administrator to do it). You need the following on your
Xsystem to build it:
X
X C compiler
X Perl source
X Oracle Call Interface (part of the Pro*C package)
X
X
XWill Oraperl work with {Dbase, Informix, Ingres, Interbase, Sybase, ...}
X------------------------------------------------------------------------
XNo. Versions of Perl do exist for some of these databases; ask in
Xcomp.databases or comp.lang.perl for help. A project is under way to
Xcreate a unified programming interface for all SQL databases, but
Xthere's a lot of work to do before it is available.
X
X
XWhere can I get Oraperl?
X------------------------
XOraperl version 2 appeared in the comp.sources.misc newsgroup as
Xfollows:
X
X v30i087-091 Part 01-05 29th June 1992
X v30i099 Patch 01 6th July 1992
X v32i093 Patch 02 4th October 1992
X v34i021 Patch 03 12th December 1992
X
XYou should be able to find it at any comp.sources.misc archive site.
XOne such site in the US is wuarchive.wustl.edu [128.252.135.4]. Look in
Xthe directory /usenet/comp.sources.misc/volume30/oraperl-v2.
X
XYou also need the Perl sources. These are also in the comp.sources.misc
Xarchives. Contact Larry Wall <lwall@netlabs.com> if you need help
Xfinding them.
X
X
XI tried building Oraperl, but cc says "Redeclaration of sprintf in perl.h"
XOraperl compiled OK, but the tests dump core
XOraperl compiled and seems to run OK, but I don't get any output
XOraperl compiled OK, but {something weird} happens
X--------------------------------------------------------------------------
XYou are probably running a dual universe ATT/BSD system and you
Xconfigured Perl under BSD. Oracle programs have to be built under the
XATT universe, so you will have to create an ATT version of uperl.o to
Xlink to Oraperl. Copy the Perl sources to a different directory and
Xbuild uperl.o there.
X
X
XI tried building Oraperl, but cc says "Undefined: _my_setenv"
X-------------------------------------------------------------
XYou are running an old version of Perl, which doesn't have my_setenv().
XIf possible, you should upgrade to the latest version. If you can't do
Xso, you could try adding one of the following to the start of orafns.c:
X
XIf your system uses setenv(var, value) :
X
X #define my_setenv(var, value) set_env(var, value)
X
XIf your system uses putenv(envstring) :
X
X void my_setenv(var, value)
X char *var, *value;
X {
X static char *envstr = NULL;
X
X if (envstr == NULL)
X {
X if ((envstr = (char *) malloc(1024)) == NULL)
X {
X return;
X }
X else
X {
X sprintf(envstr, "%s=%s", var, value);
X putenv(envstr);
X }
X }
X else
X {
X sprintf(envstr, "%s=%s", var, value);
X }
X }
X
X
XWhen I try to build Coraperl, I get messages about undefined functions
X----------------------------------------------------------------------
XYou are probably trying to link Oraperl with the BSD curses routines.
XIf you are on a dual universe system, you should use the ATT routines.
X
XIf you are on a BSD-only system, then you need to modify the file
Xbsdcurses.mus in $(SRC)/usub. You should #ifdef out the references to
Xtestcallback .
X
X
XWhenever I try to fetch a DATE or ROWID field, I get a truncation error
X-----------------------------------------------------------------------
XThis is due to a bug in early versions of Oraperl. You should upgrade to
Xthe latest version.
X
XIf you cannot upgrade, you may be able to work round the problem with
XDATE fields by calling the SQL function TO_CHAR() in your SELECT
Xstatement.
END_OF_FILE
if test 5279 -ne `wc -c <'FAQ'`; then
echo shar: \"'FAQ'\" unpacked with wrong size!
fi
# end of 'FAQ'
fi
if test -f 'patch4' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'patch4'\"
else
echo shar: Extracting \"'patch4'\" \(51655 characters\)
sed "s/^X//" >'patch4' <<'END_OF_FILE'
Xdiff -cr oraperl-v2/patchlevel.h oraperl-v2.4/patchlevel.h
X*** oraperl-v2/patchlevel.h Wed Jun 9 12:33:40 1993
X--- oraperl-v2.4/patchlevel.h Tue May 25 16:48:33 1993
X***************
X*** 1,4 ****
X /* patchlevel.h */
X
X #define VERSION 2
X! #define PATCHLEVEL 3
X--- 1,4 ----
X /* patchlevel.h */
X
X #define VERSION 2
X! #define PATCHLEVEL 4
Xdiff -cr oraperl-v2/Changes oraperl-v2.4/Changes
X*** oraperl-v2/Changes Wed Jun 9 12:33:40 1993
X--- oraperl-v2.4/Changes Wed Jun 9 12:09:14 1993
X***************
X*** 4,9 ****
X--- 4,17 ----
X Version 2
X =========
X
X+ Patch 04
X+ ========
X+ Now uses oerhms() to get the error text if possible
X+ count_colons() ignores colons which are not followed by a digit (for PL/SQL)
X+ Fixed a few typos in the documentation
X+ &ora_login() uses TWO_TASK instead of ORACLE_SID if the sid contains a colon
X+ sql now reads a script from stdin if it isn't on the command line
X+
X Patch 03
X ========
X Modify &ora_bind() and &ora_do() to return the row count
Xdiff -cr oraperl-v2/Debugging oraperl-v2.4/Debugging
X*** oraperl-v2/Debugging Wed Jun 9 12:31:54 1993
X--- oraperl-v2.4/Debugging Wed Jun 9 14:23:41 1993
X***************
X*** 47,53 ****
X output lines.
X
X If your uperl.o was built with -DDEBUGGING, you can define PERL_DEBUGGING
X! at compilation and the oraperl debugging will be initialiased from the -D
X flag. If not, you can still define DEBUGGING, but you will have to set
X ora_debug from within your program.
X
X--- 47,53 ----
X output lines.
X
X If your uperl.o was built with -DDEBUGGING, you can define PERL_DEBUGGING
X! at compilation and the oraperl debugging will be initialised from the -D
X flag. If not, you can still define DEBUGGING, but you will have to set
X ora_debug from within your program.
X
X***************
X*** 56,62 ****
X DBUG package recommends -# (and so the routines will remove a leading -#
X from the control string if there is one). For example, I use this line:
X
X! $ora_debug = shift if $ARGV[0] =~ /-#/;
X
X If you want to trace something else, you can add your own DBUG_PRINT
X statements to the code wherever you want. I would recommend that you use
X--- 56,62 ----
X DBUG package recommends -# (and so the routines will remove a leading -#
X from the control string if there is one). For example, I use this line:
X
X! $ora_debug = shift if $ARGV[0] =~ /^-#/;
X
X If you want to trace something else, you can add your own DBUG_PRINT
X statements to the code wherever you want. I would recommend that you use
Xdiff -cr oraperl-v2/Readme oraperl-v2.4/Readme
X*** oraperl-v2/Readme Wed Jun 9 12:33:41 1993
X--- oraperl-v2.4/Readme Wed Jun 9 14:33:21 1993
X***************
X*** 49,55 ****
X
X I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
X using whichever version of Perl was current at the time that I completed
X! each release (covers the range 3.0.34 to 4.0.35, excluding 4.0.33) with
X Oracle version 6, as I don't have access to any other system with Pro*C.
X However, other people have compiled and used it on a range of different
X systems including Amdahl, Convex, Cray, NeXT, Pyramid, Sun and Ultrix,
X--- 49,55 ----
X
X I've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
X using whichever version of Perl was current at the time that I completed
X! each release (covers the range 3.0.34 to 4.0.36, excluding 4.0.33) with
X Oracle version 6, as I don't have access to any other system with Pro*C.
X However, other people have compiled and used it on a range of different
X systems including Amdahl, Convex, Cray, NeXT, Pyramid, Sun and Ultrix,
X***************
X*** 85,90 ****
X--- 85,91 ----
X ckdebug.pl tests to see if debugging is available
X commit.pl using commit and rollback
X ex.pl simple example of Oraperl functions
X+ japh just another perl hacker, in Oraperl
X mkdb.pl more extensive example, using curses if available
X you can run this with either Oraperl or Coraperl
X oradump.pl dump an Oracle table into a set of insert statements
X***************
X*** 100,105 ****
X--- 101,107 ----
X Readme test information
X Standard-Results correct results for a test run
X commit.pl test script
X+ japh.pl test script
X mkdb.pl test script
X
X Miscellaneous:
X***************
X*** 124,129 ****
X Corporation or any of their subsidiaries. There is no warranty, and no
X official support is available.
X
X! It is Copyright 1991, 1992 Kevin Stock, but may be freely distributed
X under the same terms as Perl itself, that is, under the terms of either
X the GNU Public License or the Artistic License.
X--- 126,131 ----
X Corporation or any of their subsidiaries. There is no warranty, and no
X official support is available.
X
X! It is Copyright 1991, 1992, 1993 Kevin Stock, but may be freely distributed
X under the same terms as Perl itself, that is, under the terms of either
X the GNU Public License or the Artistic License.
Xdiff -cr oraperl-v2/colons.c oraperl-v2.4/colons.c
X*** oraperl-v2/colons.c Wed Jun 9 12:32:08 1993
X--- oraperl-v2.4/colons.c Wed Jun 9 12:39:28 1993
X***************
X*** 2,8 ****
X *
X * Returns the number of substitution variables in an SQL query.
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 2,8 ----
X *
X * Returns the number of substitution variables in an SQL query.
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 10,15 ****
X--- 10,16 ----
X */
X
X #include <stdio.h>
X+ #include <ctype.h>
X #include "EXTERN.h"
X #include "orafns.h"
X
X***************
X*** 29,46 ****
X /* numbers must be used in sequence,
X * but they may be repeated if a parameter is reused
X */
X! if (((c = atoi(++s)) <= 0) || (c > n+1))
X {
X! /* number too low or out of sequence */
X! DBUG_PRINT("exit",
X! ("count_colons: got %d, expected %d", c, n+1));
X! DBUG_RETURN(-1);
X }
X! else if (c == n + 1)
X {
X! ++n;
X }
X- /* else repeating a previous parameter */
X }
X else if (*s == '\'')
X {
X--- 30,56 ----
X /* numbers must be used in sequence,
X * but they may be repeated if a parameter is reused
X */
X!
X! if (isdigit(*++s))
X {
X! if (((c = atoi(s)) <= 0) || (c > n+1))
X! {
X! /* number too low or out of sequence */
X! DBUG_PRINT("exit",
X! ("count_colons: got %d, expected %d",
X! c, n+1));
X! DBUG_RETURN(-1);
X! }
X! else if (c == n + 1)
X! {
X! ++n;
X! }
X! /* else repeating a previous parameter */
X }
X! else
X {
X! DBUG_PRINT("info", ("ignoring :%c", *s));
X }
X }
X else if (*s == '\'')
X {
Xdiff -cr oraperl-v2/doc/oraperl.1 oraperl-v2.4/doc/oraperl.1
X*** oraperl-v2/doc/oraperl.1 Wed Jun 9 12:33:42 1993
X--- oraperl-v2.4/doc/oraperl.1 Wed Jun 9 11:23:56 1993
X***************
X*** 79,85 ****
X correlating or transferring data between databases.
X
X Most \fIOracle\fP programs (for example, \fISQL*Plus\fP or \fISQL*Forms\fP)
X! examine the environment variable \fBORACLE_SID\fP
X to determine which database to connect to.
X In an environment which uses several different databases,
X it is easy to make a mistake, and attempt to run a program on the wrong one.
X--- 79,85 ----
X correlating or transferring data between databases.
X
X Most \fIOracle\fP programs (for example, \fISQL*Plus\fP or \fISQL*Forms\fP)
X! examine the environment variable \fBORACLE_SID\fP or \fBTWO_TASK\fP
X to determine which database to connect to.
X In an environment which uses several different databases,
X it is easy to make a mistake, and attempt to run a program on the wrong one.
X***************
X*** 86,94 ****
X Also, it is cumbersome to create a program
X which works with more than one database simultaneously.
X Therefore, \fIOraperl\fP requires the system ID to be passed as a parameter.
X- However, if the system ID parameter is an empty string
X- then \fIOraperl\fP will use the existing value of \fBORACLE_SID\fP.
X
X .ne 4
X Example:
X
X--- 86,100 ----
X Also, it is cumbersome to create a program
X which works with more than one database simultaneously.
X Therefore, \fIOraperl\fP requires the system ID to be passed as a parameter.
X
X+ If the system ID parameter contains a colon,
X+ it is assumed to be a \fBTWO_TASK\fP value.
X+ Otherwise, if it is not blank,
X+ it is assumed to be an \fBORACLE_SID\fP value.
X+ If it is blank,
X+ the current values of \fBORACLE_SID\fP and \fBTWO_TASK\fP
X+ will be left unchanged.
X+
X .ne 4
X Example:
X
X***************
X*** 167,173 ****
X .ti +.5i
X .if t .ft CW
X &ora_bind($csr, 70, 'marketing', undef);
X! .if t .fi P
X
X \fI&ora_bind()\fP returns an undefined value if an error occurred.
X Otherwise, it returns the number of rows affected by the command
X--- 173,179 ----
X .ti +.5i
X .if t .ft CW
X &ora_bind($csr, 70, 'marketing', undef);
X! .if t .ft P
X
X \fI&ora_bind()\fP returns an undefined value if an error occurred.
X Otherwise, it returns the number of rows affected by the command
X***************
X*** 343,349 ****
X by calling the \fI&ora_types()\fP function.
X This function takes a single parameter,
X a statement identifier (obtained from \fI&ora_open()\fP)
X! indicating the query for which the lengths are required.
X The types are returned as an array of integers, one for each field.
X
X These types are defined in your OCI documentation.
X--- 349,355 ----
X by calling the \fI&ora_types()\fP function.
X This function takes a single parameter,
X a statement identifier (obtained from \fI&ora_open()\fP)
X! indicating the query for which the types are required.
X The types are returned as an array of integers, one for each field.
X
X These types are defined in your OCI documentation.
X***************
X*** 513,519 ****
X The \fI$ora_errstr\fP variable contains the \fIOracle\fP error message
X corresponding to the current value of \fI$ora_errno\fP.
X
X! This is equivalent to the \fIOCI oerrmsg\fP function.
X .\"
X .SH "$ora_verno"
X .\"
X--- 519,525 ----
X The \fI$ora_errstr\fP variable contains the \fIOracle\fP error message
X corresponding to the current value of \fI$ora_errno\fP.
X
X! This is equivalent to the \fIOCI oerhms\fI and \fIoermsg\fP functions.
X .\"
X .SH "$ora_verno"
X .\"
X***************
X*** 568,576 ****
X Note that the substitution variables must be assigned consecutively
X beginning from \fB1\fP for each SQL statement,
X as \fI&ora_bind()\fP assigns its parameters in this order.
X! Named substitution variables
X! (for example, \fB:NAME\fP, \fB:TELNO\fP)
X! are not permitted.
X .\"
X .SH DEBUGGING
X .\"
X--- 574,585 ----
X Note that the substitution variables must be assigned consecutively
X beginning from \fB1\fP for each SQL statement,
X as \fI&ora_bind()\fP assigns its parameters in this order.
X!
X! \fIOraperl\fP does not recognise the named substitution variables
X! (for example, :NAME, :TELNO) which are allowed by the \fIOCI\fP.
X! Any colon which is not followed by a digit will be ignored by \fIOraperl\fP
X! and passed on to the \fIOracle\fP engine.
X! This allows PL/SQL assignments and triggers to be used.
X .\"
X .SH DEBUGGING
X .\"
Xdiff -cr oraperl-v2/examples/sql oraperl-v2.4/examples/sql
X*** oraperl-v2/examples/sql Wed Jun 9 12:33:43 1993
X--- oraperl-v2.4/examples/sql Wed Jun 9 14:42:17 1993
X***************
X*** 18,56 ****
X # -l page_len lines per page, only used by -f (default 60)
X # -n string replace NULL fields by string
X # name/pass * Oracle username and password
X! # stmt * Oracle statement to be executed
X #
X # Author: Kevin Stock
X # Date: 18th November 1991
X! # Last change: 18th November 1992
X #
X
X $ora_debug = shift if $ARGV[0] =~ /^-#/;
X
X $USAGE = <<;
X! [-bbase] [-ccache] [-ddelim] [-f|-h] [-lpage_len] [-nstring] name/pass stmt
X
X- $, = "\t"; # default delimiter is a tab
X- $\ = "\n"; # each record terminated with newline
X-
X require 'getopts.pl'; # option parsing
X do Getopts('b:c:d:fhl:n:');
X die "$0: only one of -f and -h may be specified\n" if ($opt_f && $opt_h);
X
X! $USER = shift; # get the user name and password
X! die "Usage: $0 $USAGE\n" unless $#ARGV >= 0; # must have a statement
X
X! $ENV{'ORACLE_SID'} = $opt_b if defined($opt_b); # set database
X $ora_cache = $opt_c if defined($opt_c); # set fetch cache
X $, = $opt_d if defined($opt_d); # set column delimiter
X $= = $opt_l if defined($opt_l); # set page length
X
X- die "ORACLE_SID not set\n" unless defined($ENV{'ORACLE_SID'});
X-
X # log into the database and execute the statement
X
X! $lda = &ora_login('', $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
X--- 18,64 ----
X # -l page_len lines per page, only used by -f (default 60)
X # -n string replace NULL fields by string
X # name/pass * Oracle username and password
X! # stmt Oracle statement to be executed
X! # read from stdin if not given on command line
X #
X # Author: Kevin Stock
X # Date: 18th November 1991
X! # Last change: 9th June 1993
X #
X
X $ora_debug = shift if $ARGV[0] =~ /^-#/;
X
X $USAGE = <<;
X! [-bbase] [-ccache] [-ddelim] [-f|-h] [-lpage_len] [-nstring] name/pass [stmt]
X
X require 'getopts.pl'; # option parsing
X do Getopts('b:c:d:fhl:n:');
X die "$0: only one of -f and -h may be specified\n" if ($opt_f && $opt_h);
X
X! $USER = shift || die "user/password not specified\n";
X!
X! if ($#ARGV >= 0)
X! {
X! @stmt = @ARGV;
X! }
X! else
X! {
X! print "Enter the statement to execute (^D to end):\n";
X! @stmt = <STDIN>;
X! }
X!
X! $, = "\t"; # default delimiter is a tab
X! $\ = "\n"; # each record terminated with newline
X
X! $db = $opt_b if defined($opt_b); # set database
X $ora_cache = $opt_c if defined($opt_c); # set fetch cache
X $, = $opt_d if defined($opt_d); # set column delimiter
X $= = $opt_l if defined($opt_l); # set page length
X
X # log into the database and execute the statement
X
X! $lda = &ora_login($db, $USER, '') || die "$ora_errstr\n";
X! $csr = &ora_open($lda, "@stmt") || die "$ora_errstr\n";
X
X # print out any information which comes back
X
X***************
X*** 129,135 ****
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 1992"
X .ad
X .nh
X--- 137,142 ----
X***************
X*** 155,161 ****
X
X The \fB\-b\fP\fIbase\fP flag may be supplied to specify the database to be used.
X If it is not given, the database specified by the environment variable
X! \fBORACLE_SID\fP is used.
X
X The \fB\-c\fP\fIcache\fP flag may be supplied to set the size of fetch cache
X to be used. If it is not given, the system default is used.
X--- 162,168 ----
X
X The \fB\-b\fP\fIbase\fP flag may be supplied to specify the database to be used.
X If it is not given, the database specified by the environment variable
X! \fBORACLE_SID\fP or \fBTWO_TASK\fP is used.
X
X The \fB\-c\fP\fIcache\fP flag may be supplied to set the size of fetch cache
X to be used. If it is not given, the system default is used.
X***************
X*** 182,188 ****
X this may be changed to any desired string (\fIdelim\fP)
X using the \fB\-d\fP flag.
X .SH ENVIRONMENT
X! The environment variable \fBORACLE_SID\fP
X determines the Oracle database to be used
X if the \fB\-b\fP\fIbase\fP flag is not supplied.
X .SH DIAGNOSTICS
X--- 189,195 ----
X this may be changed to any desired string (\fIdelim\fP)
X using the \fB\-d\fP flag.
X .SH ENVIRONMENT
X! The environment variable \fBORACLE_SID\fP or \fBTWO_TASK\fP
X determines the Oracle database to be used
X if the \fB\-b\fP\fIbase\fP flag is not supplied.
X .SH DIAGNOSTICS
X***************
X*** 192,204 ****
X .br
X the \fB\-f\fP and \fB\-h\fP options are mutually exclusive,
X but both were specified
X-
X- .ti -5
X- \fBORACLE_SID not set\fP
X- .br
X- the \fB\-b\fP\fIbase\fP option was not supplied,
X- and the \fBORACLE_SID\fP environment variable was not set,
X- so \fIsql\fP cannot work out which database to open
X
X .in -5
X The only other diagnostics generated by \fIsql\fP are usage messages,
X--- 199,204 ----
Xdiff -cr oraperl-v2/getcursor.c oraperl-v2.4/getcursor.c
X*** oraperl-v2/getcursor.c Wed Jun 9 12:31:51 1993
X--- oraperl-v2.4/getcursor.c Wed Jun 9 10:51:55 1993
X***************
X*** 2,8 ****
X *
X * Functions to deal with allocating and freeing cursors for Oracle
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 2,8 ----
X *
X * Functions to deal with allocating and freeing cursors for Oracle
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 17,23 ****
X
X /* head of the cursor list */
X struct cursor csr_list =
X! { NULL, NULL, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0, NULL };
X
X
X /* ora_free_data(csr)
X--- 17,23 ----
X
X /* head of the cursor list */
X struct cursor csr_list =
X! { NULL, NULL, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0, NULL, NULL };
X
X
X /* ora_free_data(csr)
X***************
X*** 108,114 ****
X {
X DBUG_PRINT("malloc", ("insufficient memory for a cursor"));
X DBUG_PRINT("exit", ("returning NULL"));
X! ora_errno = ORAP_NOMEM;
X DBUG_RETURN(NULL);
X }
X DBUG_PRINT("malloc", ("got a cursor at %#lx", (long) tmp));
X--- 108,115 ----
X {
X DBUG_PRINT("malloc", ("insufficient memory for a cursor"));
X DBUG_PRINT("exit", ("returning NULL"));
X! ora_err.no = ORAP_NOMEM;
X! ora_err.lda = NULL;
X DBUG_RETURN(NULL);
X }
X DBUG_PRINT("malloc", ("got a cursor at %#lx", (long) tmp));
X***************
X*** 118,124 ****
X free(tmp);
X DBUG_PRINT("malloc", ("insufficient memory for a csrdef"));
X DBUG_PRINT("exit", ("returning NULL"));
X! ora_errno = ORAP_NOMEM;
X DBUG_RETURN(NULL);
X }
X DBUG_PRINT("malloc", ("got a csr at %#lx", (long) tmp->csr));
X--- 119,126 ----
X free(tmp);
X DBUG_PRINT("malloc", ("insufficient memory for a csrdef"));
X DBUG_PRINT("exit", ("returning NULL"));
X! ora_err.no = ORAP_NOMEM;
X! ora_err.lda = NULL;
X DBUG_RETURN(NULL);
X }
X DBUG_PRINT("malloc", ("got a csr at %#lx", (long) tmp->csr));
X***************
X*** 134,144 ****
X tmp->next_entry = 0;
X tmp->nfields = 0;
X tmp->varfields = 0;
X
X tmp->next = csr_list.next;
X csr_list.next = tmp;
X
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning %#lx", (long) tmp));
X DBUG_RETURN(tmp);
X }
X--- 136,148 ----
X tmp->next_entry = 0;
X tmp->nfields = 0;
X tmp->varfields = 0;
X+ tmp->parent = NULL;
X
X tmp->next = csr_list.next;
X csr_list.next = tmp;
X
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("returning %#lx", (long) tmp));
X DBUG_RETURN(tmp);
X }
X***************
X*** 167,173 ****
X {
X DBUG_PRINT("malloc", ("insufficient memory for an hda"));
X ora_dropcursor(tmp);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN(NULL);
X }
X--- 171,178 ----
X {
X DBUG_PRINT("malloc", ("insufficient memory for an hda"));
X ora_dropcursor(tmp);
X! ora_err.no = ORAP_NOMEM;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN(NULL);
X }
X***************
X*** 199,205 ****
X
X if (tmp->next == NULL)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a cursor"));
X DBUG_RETURN(0);
X }
X--- 204,211 ----
X
X if (tmp->next == NULL)
X {
X! ora_err.no = ORAP_INVCSR;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("not a cursor"));
X DBUG_RETURN(0);
X }
Xdiff -cr oraperl-v2/oracle.mus oraperl-v2.4/oracle.mus
X*** oraperl-v2/oracle.mus Wed Jun 9 12:33:44 1993
X--- oraperl-v2.4/oracle.mus Wed Jun 9 11:28:42 1993
X***************
X*** 5,11 ****
X * NOTE: Do not modify oracle.c as it is created automagically from oracle.mus.
X * Modify oracle.mus instead, or your changes will be lost.
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 5,11 ----
X * NOTE: Do not modify oracle.c as it is created automagically from oracle.mus.
X * Modify oracle.mus instead, or your changes will be lost.
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 231,237 ****
X
X if (vars == NULL)
X {
X! ora_errno = ORAP_NOMEM;
X retval = 0;
X }
X else
X--- 231,237 ----
X
X if (vars == NULL)
X {
X! ora_err.no = ORAP_NOMEM;
X retval = 0;
X }
X else
X***************
X*** 493,499 ****
X break;
X
X case UV_ora_errno:
X! str_numset(str, (double) ora_errno);
X break;
X
X case UV_ora_verno:
X--- 493,499 ----
X break;
X
X case UV_ora_errno:
X! str_numset(str, (double) ora_err.no);
X break;
X
X case UV_ora_verno:
X***************
X*** 500,513 ****
X str_numset(str, (double) (VERSION + (double) PATCHLEVEL / 1000));
X break;
X
X! case UV_ora_errstr:
X {
X int len;
X! char ertxt[132];
X
X! if (ora_errno < ORAP_ERRMIN)
X {
X! oermsg(ora_errno, ertxt);
X if (ertxt[len = (strlen(ertxt) - 1)] == '\n')
X {
X ertxt[len] = '\0';
X--- 500,528 ----
X str_numset(str, (double) (VERSION + (double) PATCHLEVEL / 1000));
X break;
X
X! case UV_ora_errstr:
X {
X int len;
X! char ertxt[256];
X
X! if (ora_err.no < ORAP_ERRMIN)
X {
X! DBUG_PRINT("info",
X! ("ora_err.no = %d, ora_err.lda = 0x%x",
X! ora_err.no, ora_err.lda));
X!
X! if (ora_err.lda == NULL)
X! {
X! /* lda isn't set */
X! DBUG_PRINT("info", ("Using oermsg"));
X! oermsg(ora_err.no, ertxt);
X! }
X! else
X! {
X! DBUG_PRINT("info", ("Using oerhms"));
X! oerhms(ora_err.lda->csr, ora_err.no, ertxt,256);
X! }
X!
X if (ertxt[len = (strlen(ertxt) - 1)] == '\n')
X {
X ertxt[len] = '\0';
X***************
X*** 514,527 ****
X }
X str_set(str, ertxt);
X }
X! else if((ora_errno == ORAP_ERRMIN) || (ora_errno > ORAP_ERRMAX))
X {
X! sprintf(ertxt, "unknown error %d", ora_errno);
X str_set(str, ertxt);
X }
X else
X {
X! str_set(str, ora_errlist[ora_errno - ORAP_ERRMIN]);
X }
X }
X break;
X--- 529,543 ----
X }
X str_set(str, ertxt);
X }
X! else if ((ora_err.no == ORAP_ERRMIN) ||
X! (ora_err.no > ORAP_ERRMAX))
X {
X! sprintf(ertxt, "unknown error %d", ora_err.no);
X str_set(str, ertxt);
X }
X else
X {
X! str_set(str, ora_errlist[ora_err.no - ORAP_ERRMIN]);
X }
X }
X break;
Xdiff -cr oraperl-v2/orafns.c oraperl-v2.4/orafns.c
X*** oraperl-v2/orafns.c Wed Jun 9 12:33:44 1993
X--- oraperl-v2.4/orafns.c Wed Jun 9 11:58:54 1993
X***************
X*** 2,8 ****
X *
X * Simple C interface to Oracle, intended to be linked to Perl.
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 2,8 ----
X *
X * Simple C interface to Oracle, intended to be linked to Perl.
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 60,91 ****
X /* oracle_sid is just used so that we don't keep repeating the string */
X
X static char *oracle_sid = "ORACLE_SID";
X
X
X /* set_sid() uses my_setenv() to set ORACLE_SID to the required database.
X * It preserves the old value of ORACLE_SID so that it can be restored
X * (by calling set_sid() with NULL as its parameter.
X */
X
X! void set_sid(db)
X char *db;
X {
X! char *h;
X static char *oldsid = NULL;
X
X DBUG_ENTER("set_sid");
X DBUG_PRINT("entry", ("set_sid(%s)", db ? db : "<NULL>"));
X
X! ora_errno = 0;
X
X if (db == NULL)
X {
X if (oldsid != NULL)
X {
X! DBUG_PRINT("info", ("setting oracle_sid to %s",oldsid));
X! my_setenv(oracle_sid, oldsid);
X }
X- /* no old value to restore if oldsid == NULL */
X }
X else
X {
X--- 60,104 ----
X /* oracle_sid is just used so that we don't keep repeating the string */
X
X static char *oracle_sid = "ORACLE_SID";
X+ static char *two_task = "TWO_TASK";
X
X
X /* set_sid() uses my_setenv() to set ORACLE_SID to the required database.
X * It preserves the old value of ORACLE_SID so that it can be restored
X * (by calling set_sid() with NULL as its parameter.
X+ *
X+ * If db contains a colon, then TWO_TASK is used instead of ORACLE_SID.
X */
X
X! set_sid(db)
X char *db;
X {
X! char *h, *var;
X static char *oldsid = NULL;
X
X DBUG_ENTER("set_sid");
X DBUG_PRINT("entry", ("set_sid(%s)", db ? db : "<NULL>"));
X
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X
X if (db == NULL)
X {
X if (oldsid != NULL)
X {
X! var = (strchr(oldsid, ':') == NULL) ? oracle_sid
X! : two_task;
X!
X! DBUG_PRINT("info", ("resetting %s to %s", var, oldsid));
X! my_setenv(var, oldsid);
X! DBUG_RETURN(1); /* assume it worked */
X! }
X! else
X! {
X! DBUG_PRINT("info", ("no value to reset %s/%s",
X! oracle_sid, two_task));
X! DBUG_RETURN(1);
X }
X }
X else
X {
X***************
X*** 96,102 ****
X free(oldsid);
X }
X
X! if ((h = getenv(oracle_sid)) == NULL)
X {
X /* no previous value to save */
X oldsid = NULL;
X--- 109,117 ----
X free(oldsid);
X }
X
X! var = (strchr(db, ':') == NULL) ? oracle_sid : two_task;
X!
X! if ((h = getenv(var)) == NULL)
X {
X /* no previous value to save */
X oldsid = NULL;
X***************
X*** 107,113 ****
X {
X DBUG_PRINT("malloc",
X ("insufficient memory for oldsid"));
X! ora_errno = ORAP_NOMEM;
X }
X else
X {
X--- 122,129 ----
X {
X DBUG_PRINT("malloc",
X ("insufficient memory for oldsid"));
X! ora_err.no = ORAP_NOMEM;
X! DBUG_RETURN(0);
X }
X else
X {
X***************
X*** 118,128 ****
X }
X }
X
X! DBUG_PRINT("info", ("setting oracle_sid to %s", db));
X! my_setenv(oracle_sid, db);
X }
X
X! DBUG_VOID_RETURN;
X }
X
X
X--- 134,150 ----
X }
X }
X
X! DBUG_PRINT("info", ("setting %s to %s", var, db));
X! my_setenv(var, db);
X!
X! if (((h = getenv(var)) == NULL) || (strcmp(h, db) != 0))
X! {
X! DBUG_PRINT("info", ("%s misset to %s", var, h));
X! DBUG_RETURN(0);
X! }
X }
X
X! DBUG_RETURN(1);
X }
X
X
X***************
X*** 150,164 ****
X
X if (*database != '\0')
X {
X! set_sid(database);
X! if (((tmp = getenv(oracle_sid)) == NULL) ||
X! (strcmp(database, tmp) != 0))
X {
X (void) ora_dropcursor(lda);
X! ora_errno = ORAP_NOSID;
X! DBUG_PRINT("exit",
X! ("%s misset to %s, returning NULL",
X! oracle_sid, tmp ? tmp : "<NULL>"));
X DBUG_RETURN(NULL);
X }
X }
X--- 172,182 ----
X
X if (*database != '\0')
X {
X! if (set_sid(database) == 0)
X {
X (void) ora_dropcursor(lda);
X! ora_err.no = ORAP_NOSID;
X! DBUG_PRINT("exit", ("couldn't set database ID"));
X DBUG_RETURN(NULL);
X }
X }
X***************
X*** 178,192 ****
X sprintf(address, "%#lx", (long) lda);
X DBUG_PRINT("conv", ("lda %#lx converted to string \"%s\"",
X (long) lda, address));
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning lda %s", address));
X DBUG_RETURN(address);
X }
X else
X {
X! ora_errno = lda->csr->csrrc;
X (void) ora_droplda(lda);
X! DBUG_PRINT("exit", ("orlon failed (error %d)", ora_errno));
X DBUG_RETURN((char *) NULL);
X }
X }
X--- 196,215 ----
X sprintf(address, "%#lx", (long) lda);
X DBUG_PRINT("conv", ("lda %#lx converted to string \"%s\"",
X (long) lda, address));
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("returning lda %s", address));
X DBUG_RETURN(address);
X }
X else
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = NULL; /* this ought to be lda, not NULL
X! * but as we're about to drop the
X! * lda, that wouldn't make sense
X! */
X (void) ora_droplda(lda);
X! DBUG_PRINT("exit", ("orlon failed (error %d)", ora_err.no));
X DBUG_RETURN((char *) NULL);
X }
X }
X***************
X*** 213,219 ****
X
X if (check_lda(lda) == 0)
X {
X! ora_errno = ORAP_INVLDA;
X DBUG_PRINT("exit", ("invalid lda, returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 236,242 ----
X
X if (check_lda(lda) == 0)
X {
X! ora_err.no = ORAP_INVLDA;
X DBUG_PRINT("exit", ("invalid lda, returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 223,228 ****
X--- 246,252 ----
X DBUG_PRINT("exit", ("can't get a cursor, returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X+ csr->parent = lda;
X
X /* Check whether there are any substitution variables in the statement
X * If there are, we don't execute the statement yet.
X***************
X*** 229,235 ****
X */
X if ((csr->varfields = count_colons(stmt)) < 0)
X {
X! ora_errno = ORAP_BADVAR;
X DBUG_PRINT("exit", ("invalid variable sequence"));
X DBUG_RETURN((char *) NULL);
X }
X--- 253,259 ----
X */
X if ((csr->varfields = count_colons(stmt)) < 0)
X {
X! ora_err.no = ORAP_BADVAR;
X DBUG_PRINT("exit", ("invalid variable sequence"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 242,252 ****
X || (osql3(csr->csr, stmt, -1) != 0)
X || ((csr->varfields == 0) && (oexec(csr->csr) != 0)))
X {
X! ora_errno = csr->csr->csrrc;
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X DBUG_PRINT("exit",
X! ("couldn't run SQL statement (error %d)", ora_errno));
X DBUG_RETURN((char *) NULL);
X }
X
X--- 266,277 ----
X || (osql3(csr->csr, stmt, -1) != 0)
X || ((csr->varfields == 0) && (oexec(csr->csr) != 0)))
X {
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = lda;
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X DBUG_PRINT("exit",
X! ("couldn't run SQL statement (error %d)", ora_err.no));
X DBUG_RETURN((char *) NULL);
X }
X
X***************
X*** 259,265 ****
X (short *) 0, (char *) 0, (short *) 0, (short *) 0);
X } while (csr->csr->csrrc == 0);
X --i;
X! ora_errno = 0;
X
X /* set up csr->data to receive the information when we do a fetch
X * csr->rcode to receive the column return codes
X--- 284,291 ----
X (short *) 0, (char *) 0, (short *) 0, (short *) 0);
X } while (csr->csr->csrrc == 0);
X --i;
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X
X /* set up csr->data to receive the information when we do a fetch
X * csr->rcode to receive the column return codes
X***************
X*** 282,288 ****
X DBUG_PRINT("malloc", ("insufficient memory for data"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 308,314 ----
X DBUG_PRINT("malloc", ("insufficient memory for data"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 296,302 ****
X DBUG_PRINT("malloc", ("insufficient memory for len"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 322,328 ----
X DBUG_PRINT("malloc", ("insufficient memory for len"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 308,314 ****
X DBUG_PRINT("malloc", ("insufficient memory for rcode"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 334,340 ----
X DBUG_PRINT("malloc", ("insufficient memory for rcode"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 321,327 ****
X DBUG_PRINT("malloc", ("insufficient memory for type"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 347,353 ----
X DBUG_PRINT("malloc", ("insufficient memory for type"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 352,358 ****
X ("insufficient memory for data[%d]", i));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 378,384 ----
X ("insufficient memory for data[%d]", i));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 366,372 ****
X ("insufficient memory for rcode[%d]", i));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 392,398 ----
X ("insufficient memory for rcode[%d]", i));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 400,406 ****
X ("insufficient memory for ora_result"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X--- 426,432 ----
X ("insufficient memory for ora_result"));
X oclose(csr->csr);
X (void) ora_dropcursor(csr);
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("returning NULL"));
X DBUG_RETURN((char *) NULL);
X }
X***************
X*** 454,472 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_errno = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X--- 480,498 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_err.no = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X***************
X*** 515,521 ****
X i, (long) ora_result[i], ora_result[i]));
X }
X
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X--- 541,548 ----
X i, (long) ora_result[i], ora_result[i]));
X }
X
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X***************
X*** 541,559 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_errno = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X--- 568,586 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_err.no = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X***************
X*** 567,573 ****
X i, (long) csr->data[i], csr->data[i]));
X }
X
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X--- 594,601 ----
X i, (long) csr->data[i], csr->data[i]));
X }
X
X! ora_err.no = 0;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X***************
X*** 594,612 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_errno = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X--- 622,640 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_err.no = ORAP_NODATA;
X DBUG_PRINT("exit", ("nothing to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned correctly"));
X DBUG_RETURN(0);
X }
X***************
X*** 621,627 ****
X types[csr->type[i]] ? types[csr->type[i]] : "unknown"));
X }
X
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X--- 649,656 ----
X types[csr->type[i]] ? types[csr->type[i]] : "unknown"));
X }
X
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X***************
X*** 648,666 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_errno = ORAP_NODATA;
X DBUG_PRINT("exit", ("no data to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_errno = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned"));
X DBUG_RETURN(0);
X }
X--- 677,695 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(0);
X }
X else if (csr->nfields == 0)
X {
X! ora_err.no = ORAP_NODATA;
X DBUG_PRINT("exit", ("no data to return"));
X DBUG_RETURN(0);
X }
X else if ((ora_result == NULL) || (ora_nfields < csr->nfields))
X {
X! ora_err.no = ORAP_NOMEM;
X DBUG_PRINT("exit", ("ora_result is not assigned"));
X DBUG_RETURN(0);
X }
X***************
X*** 671,677 ****
X
X if (csr->end_of_data)
X {
X! ora_errno = 0;
X DBUG_PRINT("exit", ("end of data"));
X DBUG_RETURN(0);
X }
X--- 700,707 ----
X
X if (csr->end_of_data)
X {
X! ora_err.no = 0;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("end of data"));
X DBUG_RETURN(0);
X }
X***************
X*** 691,705 ****
X {
X if ((i == 1) && (csr->csr->csrrc == 4))
X {
X! ora_errno = 0;
X DBUG_PRINT("exit", ("end of data"));
X DBUG_RETURN(0);
X }
X else
X {
X! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit",
X! ("ofen error (%d)", ora_errno));
X DBUG_RETURN(0);
X }
X }
X--- 721,737 ----
X {
X if ((i == 1) && (csr->csr->csrrc == 4))
X {
X! ora_err.no = 0;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("end of data"));
X DBUG_RETURN(0);
X }
X else
X {
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit",
X! ("ofen error (%d)", ora_err.no));
X DBUG_RETURN(0);
X }
X }
X***************
X*** 722,728 ****
X break;
X
X case 1406:
X! ora_errno = 1406;
X
X if (trunc &&
X ((csr->type[i] == 8) || (csr->type[i] == 24)))
X--- 754,761 ----
X break;
X
X case 1406:
X! ora_err.no = 1406;
X! ora_err.lda = csr->parent;
X
X if (trunc &&
X ((csr->type[i] == 8) || (csr->type[i] == 24)))
X***************
X*** 744,750 ****
X default: /* others should not happen */
X DBUG_PRINT("info", ("ofetch error %d, field %d",
X csr->rcode[i][csr->next_entry], i));
X! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit", ("returning 0"));
X DBUG_RETURN(0);
X }
X--- 777,784 ----
X default: /* others should not happen */
X DBUG_PRINT("info", ("ofetch error %d, field %d",
X csr->rcode[i][csr->next_entry], i));
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("returning 0"));
X DBUG_RETURN(0);
X }
X***************
X*** 757,763 ****
X ++csr->next_entry;
X --csr->in_cache;
X
X! ora_errno = 0;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X--- 791,798 ----
X ++csr->next_entry;
X --csr->in_cache;
X
X! ora_err.no = 0;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("returning %d items", csr->nfields));
X DBUG_RETURN(csr->nfields);
X }
X***************
X*** 786,798 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(-1L);
X }
X else if (csr->varfields != nitems)
X {
X! ora_errno = ORAP_NUMVARS;
X DBUG_PRINT("exit", ("expected %d items, got %d",
X csr->varfields, nitems));
X DBUG_RETURN(-1L);
X--- 821,833 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(-1L);
X }
X else if (csr->varfields != nitems)
X {
X! ora_err.no = ORAP_NUMVARS;
X DBUG_PRINT("exit", ("expected %d items, got %d",
X csr->varfields, nitems));
X DBUG_RETURN(-1L);
X***************
X*** 805,811 ****
X if ((obndrn(csr->csr, i+1, (char *) -1, 0,
X 5, -1, &null_flag, (char *) -1, 0, 0)) != 0)
X {
X! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit", ("obndrn failed on field %d, <NULL>",
X i + 1));
X DBUG_RETURN(-1L);
X--- 840,847 ----
X if ((obndrn(csr->csr, i+1, (char *) -1, 0,
X 5, -1, &null_flag, (char *) -1, 0, 0)) != 0)
X {
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("obndrn failed on field %d, <NULL>",
X i + 1));
X DBUG_RETURN(-1L);
X***************
X*** 825,831 ****
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! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit", ("obndrn failed on field %d, \"%s\"",
X i + 1, vars[i]));
X DBUG_RETURN(-1L);
X--- 861,868 ----
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! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("obndrn failed on field %d, \"%s\"",
X i + 1, vars[i]));
X DBUG_RETURN(-1L);
X***************
X*** 837,843 ****
X
X if (oexec(csr->csr) != 0)
X {
X! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit", ("oexec failed"));
X DBUG_RETURN(-1L);
X }
X--- 874,881 ----
X
X if (oexec(csr->csr) != 0)
X {
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("oexec failed"));
X DBUG_RETURN(-1L);
X }
X***************
X*** 918,930 ****
X
X if (check_csr(csr) == 0)
X {
X! ora_errno = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(NULL);
X }
X else if (oclose(csr->csr) != 0)
X {
X! ora_errno = csr->csr->csrrc;
X DBUG_PRINT("exit", ("oclose failed"));
X DBUG_RETURN(NULL);
X }
X--- 956,969 ----
X
X if (check_csr(csr) == 0)
X {
X! ora_err.no = ORAP_INVCSR;
X DBUG_PRINT("exit", ("not a csr"));
X DBUG_RETURN(NULL);
X }
X else if (oclose(csr->csr) != 0)
X {
X! ora_err.no = csr->csr->csrrc;
X! ora_err.lda = csr->parent;
X DBUG_PRINT("exit", ("oclose failed"));
X DBUG_RETURN(NULL);
X }
X***************
X*** 953,966 ****
X
X if (check_lda(lda) == 0)
X {
X! ora_errno = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda"));
X DBUG_RETURN(NULL);
X }
X else if (ologof(lda->csr) != 0)
X {
X! ora_errno = lda->csr->csrrc;
X! DBUG_PRINT("exit", ("ologof failed, error code %d", ora_errno));
X DBUG_RETURN(NULL);
X }
X else
X--- 992,1006 ----
X
X if (check_lda(lda) == 0)
X {
X! ora_err.no = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda"));
X DBUG_RETURN(NULL);
X }
X else if (ologof(lda->csr) != 0)
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = lda;
X! DBUG_PRINT("exit", ("ologof failed, error code %d",ora_err.no));
X DBUG_RETURN(NULL);
X }
X else
X***************
X*** 988,1001 ****
X
X if (check_lda(lda) == 0)
X {
X! ora_errno = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda"));
X DBUG_RETURN(NULL);
X }
X else if (ocom(lda->csr) != 0)
X {
X! ora_errno = lda->csr->csrrc;
X! DBUG_PRINT("exit", ("ocom failed, error code %d", ora_errno));
X DBUG_RETURN(NULL);
X }
X else
X--- 1028,1042 ----
X
X if (check_lda(lda) == 0)
X {
X! ora_err.no = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda"));
X DBUG_RETURN(NULL);
X }
X else if (ocom(lda->csr) != 0)
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = lda;
X! DBUG_PRINT("exit", ("ocom failed, error code %d", ora_err.no));
X DBUG_RETURN(NULL);
X }
X else
X***************
X*** 1022,1035 ****
X
X if (check_lda(lda) == 0)
X {
X! ora_errno = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda", stderr));
X DBUG_RETURN(NULL);
X }
X else if (orol(lda->csr) != 0)
X {
X! ora_errno = lda->csr->csrrc;
X! DBUG_PRINT("exit", ("orol failed, error code %d", ora_errno));
X DBUG_RETURN(NULL);
X }
X else
X--- 1063,1077 ----
X
X if (check_lda(lda) == 0)
X {
X! ora_err.no = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda", stderr));
X DBUG_RETURN(NULL);
X }
X else if (orol(lda->csr) != 0)
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = lda;
X! DBUG_PRINT("exit", ("orol failed, error code %d", ora_err.no));
X DBUG_RETURN(NULL);
X }
X else
X***************
X*** 1057,1063 ****
X
X if (check_lda(lda) == 0)
X {
X! ora_errno = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda", stderr));
X DBUG_RETURN(NULL);
X }
X--- 1099,1105 ----
X
X if (check_lda(lda) == 0)
X {
X! ora_err.no = ORAP_INVLDA;
X DBUG_PRINT("exit", ("not an lda", stderr));
X DBUG_RETURN(NULL);
X }
X***************
X*** 1066,1074 ****
X {
X if (ocon(lda->csr) != 0)
X {
X! ora_errno = lda->csr->csrrc;
X DBUG_PRINT("exit",
X! ("ocon failed, error code %d", ora_errno));
X DBUG_RETURN(NULL);
X }
X }
X--- 1108,1117 ----
X {
X if (ocon(lda->csr) != 0)
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = lda;
X DBUG_PRINT("exit",
X! ("ocon failed, error code %d", ora_err.no));
X DBUG_RETURN(NULL);
X }
X }
X***************
X*** 1076,1084 ****
X {
X if (ocof(lda->csr) != 0)
X {
X! ora_errno = lda->csr->csrrc;
X DBUG_PRINT("exit",
X! ("ocof failed, error code %d", ora_errno));
X DBUG_RETURN(NULL);
X }
X }
X--- 1119,1128 ----
X {
X if (ocof(lda->csr) != 0)
X {
X! ora_err.no = lda->csr->csrrc;
X! ora_err.lda = lda;
X DBUG_PRINT("exit",
X! ("ocof failed, error code %d", ora_err.no));
X DBUG_RETURN(NULL);
X }
X }
Xdiff -cr oraperl-v2/orafns.h oraperl-v2.4/orafns.h
X*** oraperl-v2/orafns.h Wed Jun 9 12:33:45 1993
X--- oraperl-v2.4/orafns.h Wed Jun 9 11:28:54 1993
X***************
X*** 2,8 ****
X *
X * Common declarations for the Oraperl functions
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 2,8 ----
X *
X * Common declarations for the Oraperl functions
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 86,92 ****
X next_entry, /* next valid cache entry */
X nfields, /* number of fields to retrieve */
X varfields; /* number of modifiable variables */
X! struct cursor *next; /* list pointer */
X };
X
X
X--- 86,93 ----
X next_entry, /* next valid cache entry */
X nfields, /* number of fields to retrieve */
X varfields; /* number of modifiable variables */
X! struct cursor *next, /* list pointer */
X! *parent; /* lda related to this csr */
X };
X
X
X***************
X*** 105,112 ****
X
X /* variables accesible to the outside world */
X
X! EXT int ora_errno INIT(0), /* latest error code */
X! ora_long INIT(80), /* length of LONG fields */
X ora_nfields INIT(0), /* size of ora_result array */
X ora_trunc INIT(0); /* allow LONG truncation? */
X
X--- 106,122 ----
X
X /* variables accesible to the outside world */
X
X! EXT struct /* code & lda of last error */
X! {
X! int no;
X! struct cursor *lda;
X! } ora_err
X! #ifdef DOINIT
X! = { 0, NULL }
X! #endif
X! ; /* ends decl of ora_err */
X!
X! EXT int ora_long INIT(80), /* length of LONG fields */
X ora_nfields INIT(0), /* size of ora_result array */
X ora_trunc INIT(0); /* allow LONG truncation? */
X
Xdiff -cr oraperl-v2/usersub.c oraperl-v2.4/usersub.c
X*** oraperl-v2/usersub.c Wed Jun 9 12:32:05 1993
X--- oraperl-v2.4/usersub.c Wed Jun 9 11:29:40 1993
X***************
X*** 2,8 ****
X *
X * Initialisation for Oraperl.
X */
X! /* Copyright 1991, 1992 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X--- 2,8 ----
X *
X * Initialisation for Oraperl.
X */
X! /* Copyright 1991, 1992, 1993 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * or the Artistic License, copies of which should have accompanied your
X***************
X*** 60,66 ****
X warn_on_debug = dowarn;
X #endif
X
X! ora_errno = 0;
X DBUG_VOID_RETURN;
X }
X
X--- 60,68 ----
X warn_on_debug = dowarn;
X #endif
X
X! ora_err.no = 0;
X! ora_err.lda = NULL;
X!
X DBUG_VOID_RETURN;
X }
X
X***************
X*** 117,123 ****
X
X printf("\nPerl is copyright by Larry Wall; type %s -v for details.\n",
X prog);
X! printf("Additions for %s: Copyright 1991, 1992, Kevin Stock.\n", prog);
X
X printf("\n%s may be distributed under the same conditions as Perl.\n\n",
X Prog);
X--- 119,126 ----
X
X printf("\nPerl is copyright by Larry Wall; type %s -v for details.\n",
X prog);
X! printf("Additions for %s: Copyright 1991, 1992, 1993, Kevin Stock.\n",
X! prog);
X
X printf("\n%s may be distributed under the same conditions as Perl.\n\n",
X Prog);
END_OF_FILE
if test 51655 -ne `wc -c <'patch4'`; then
echo shar: \"'patch4'\" unpacked with wrong size!
fi
# end of 'patch4'
fi
echo shar: End of archive 1 \(of 1\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have the archive.
rm -f ark[1-9]isdone
else
echo You still must unpack the following archives:
echo " " ${MISSING}
fi
exit 0
exit 0 # Just in case...