kstock@isfrance.encore.fr (Kevin Stock) (04/11/91)
Submitted-by: Kevin Stock <kstock@gouldfr.encore.fr>
Posting-number: Volume 18, Issue 10
Archive-name: oraperl/part01
The attached shar contains ORAPERL, a set of usersubs for Perl allowing
it to access Oracle databases. It requires a version of Perl capable of
accepting usersubs (3.0.27 or later) and the Oracle Pro*C product. It
has been tested on an Encore Multimax running UMAX V (Sys Vr3.2) and
compiled (but not tested, since I don't have Pro*C on that machine) in
the BSD universe of a Gould PN 6040.
Read README and modify Makefile (and oracle.mus if necessary). Then
type make and let it go.
I wrote this in order to allow me to get information out of an Oracle
database into a Perl program, but since any SQL statement may be used,
it is also possible for the Perl program to modify data. I don't think
that there's any risk attached to this, but I haven't used it extensively.
Any comments, bug reports (and fixes) gratefully accepted. If you find this
useful, please let me know what you're using it for - it's good for my ego!
Kevin.
----
#!/bin/sh
# This is a shell archive (shar 3.47)
# made 04/10/1991 08:14 UTC by kstock@isfrance
# Source directory /wp/users/kstock/tmp
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 2175 -rw-r--r-- README
# 1347 -rw-r--r-- Makefile
# 112 -rwxr-xr-x debug-p
# 655 -rw-r--r-- ex.pl
# 5749 -rw-r--r-- getcursor.c
# 3876 -rw-r--r-- oracle.mus
# 8596 -rw-r--r-- orafns.c
# 3578 -rw-r--r-- orafns.h
# 4711 -rw-r--r-- oraperl.1
# 7198 -rw-r--r-- oraperl.doc
# 1401 -rw-r--r-- oraperl.ref
# 499 -rw-r--r-- usersub.c
#
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
echo 'x - skipping README (File already exists)'
else
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
XThis is an instant-mix package (just add Perl) to create Oraperl,
Xa version of Perl which is capable of accessing Oracle databases.
XTo use it, you must have the Oracle Pro*C product and a version of
XPerl which supports Usersubs (v3.0.27 or later).
X
XUnshar it somewhere convenient, and edit the Makefile. You may need
Xto change the definitions below:
X
X ORACLE_HOME your Oracle installation directory
X SRC your Perl source directory (with the usub directory)
X OTHERLIBS \
X CLIBS |
X OCILIB +- copy these from your proc.mk file
X NETLIBS |
X ORALIBS /
X GLOBINCS \
X LOCINCS +- copy these from $SRC/usub/Makefile
X LIBS /
X DEBUG -DDEBUGGING, -DPERL_DEBUGGING or leave blank;
X see orafns.h for an explanation
X
XIf your version of Perl is earlier than v4, you will also need to make
Xone change to oracle.mus . The name str_2mortal() on line 100 must
Xbe changed to str_2static() with the same arguments.
X
XI've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
Xusing Perl 3.0.34 and 4.0.00 with Oracle version 6, as I don't have access
Xto any other system with Pro*C. I'd appreciate any comments, bug-reports etc.
X
XIn addition to this README, the package contains the following files:
X
XSource Code:
X Makefile building instructions
X orafns.h common declarations
X oracle.mus function interface description
X getcursor.c functions to deal with the cursor pool
X orafns.c actual functions to interact with oracle
X usersub.c initialisation routine
X
XExamples (taken from the manual page)
X debug-p tests to see if debugging is available
X ex.pl simple example of using the functions
X
XDocumentation
X oraperl.doc explains some of the thinking behind Oraperl
X oraperl.ref quick reference (troff format)
X oraperl.1 manual page
X
XMany thanks to Larry for Perl. Now if only we could get the Camel book
Xinto France! Hmm. Any plans for "Le Livre Chameau"?
X
X Kevin Stock
X kstock@gouldfr.encore.fr
X
X
X NOTICE - Warranty and Copyright
X
XOraperl is not a product of Encore Computer Corporation or any of its
Xsubsidiaries. There is no warranty, and no official support is available.
X
XIt is copyright, but may be freely distributed under the same terms as
XPerl itself.
SHAR_EOF
chmod 0644 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 2175 -eq "$Wc_c" ||
echo 'README: original size 2175, current size' "$Wc_c"
fi
# ============= Makefile ==============
if test -f 'Makefile' -a X"$1" != X"-c"; then
echo 'x - skipping Makefile (File already exists)'
else
echo 'x - extracting Makefile (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
X# Makefile for Oraperl
X
X# Change these to your ORACLE installation directory and Perl source directory
X
XORACLE_HOME = /usr/soft/oracle
XSRC = /usr/soft/public/perl4/src
X
X# Oracle Definitions, taken from proc.mk
X
XOTHERLIBS = `cat $(ORACLE_HOME)/rdbms/lib/sysliblist`
XCLIBS = $(OTHERLIBS)
XOCILIB = $(ORACLE_HOME)/rdbms/lib/libocic.a
XNETLIBS = $(ORACLE_HOME)/rdbms/lib/osntab.o \
X $(ORACLE_HOME)/rdbms/lib/libsqlnet.a
XORALIBS = $(ORACLE_HOME)/rdbms/lib/libora.a
X
X# Perl Definitions, taken from $SRC/usub/Makefile
X
XGLOBINCS =
XLOCINCS =
XLIBS =
X
X# Oraperl Definitions
X
X# Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
X
XDEBUG = -DPERL_DEBUGGING
XCFLAGS = $(DEBUG) -I$(SRC) $(GLOBINCS) -O
X
Xoraperl: $(SRC)/uperl.o usersub.o oracle.o orafns.o getcursor.o
X cc -o oraperl $(SRC)/uperl.o usersub.o oracle.o orafns.o getcursor.o \
X -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS)
X
Xoracle.c: $(SRC)/usub/mus oracle.mus
X chmod +x $(SRC)/usub/mus
X $(SRC)/usub/mus oracle.mus >oracle.c
X
Xusersub.o oracle.o orafns.o getcursor.o: orafns.h
X
Xprint: Makefile orafns.h orafns.c oracle.mus usersub.c getcursor.c
X pr -fn Makefile orafns.h getcursor.c orafns.c oracle.mus usersub.c | \
X pr -fto4 -e > Print
X
Xman: oraperl.1
X nroff -man oraperl.1 >oraperl.man
X
Xclean:
X rm -f nohup.out oraperl *.o oracle.c oraperl.man Print tags out core
SHAR_EOF
chmod 0644 Makefile ||
echo 'restore of Makefile failed'
Wc_c="`wc -c < 'Makefile'`"
test 1347 -eq "$Wc_c" ||
echo 'Makefile: original size 1347, current size' "$Wc_c"
fi
# ============= debug-p ==============
if test -f 'debug-p' -a X"$1" != X"-c"; then
echo 'x - skipping debug-p (File already exists)'
else
echo 'x - extracting debug-p (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'debug-p' &&
Xdefined($ora_debug) && print "debugging available\n";
Xdefined($ora_debug) || print "debugging not available\n";
SHAR_EOF
chmod 0755 debug-p ||
echo 'restore of debug-p failed'
Wc_c="`wc -c < 'debug-p'`"
test 112 -eq "$Wc_c" ||
echo 'debug-p: original size 112, current size' "$Wc_c"
fi
# ============= ex.pl ==============
if test -f 'ex.pl' -a X"$1" != X"-c"; then
echo 'x - skipping ex.pl (File already exists)'
else
echo 'x - extracting ex.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'ex.pl' &&
Xformat top =
X Name Phone
X ==== =====
X.
X
Xformat STDOUT =
X @<<<<<<<<<< @>>>>>>>>>>
X $name, $phone
X.
X
Xdie ("You should use oraperl, not perl\n") unless defined &ora_login;
X
X$lda = &ora_login("t", "kstock", "kstock")
X || die $ora_errstr;
X$csr = &ora_open($lda, "select * from telno order by name")
X || die $ora_errstr;
X
X$nfields = &ora_fetch($csr);
Xprint "Query will return $nfields fields\n\n";
X
Xwhile (($name, $phone) = &ora_fetch($csr))
X{
X write;
X}
X
Xdo ora_close($csr) || die "can't close cursor";
Xdo ora_logoff($lda) || die "can't log off Oracle";
SHAR_EOF
chmod 0644 ex.pl ||
echo 'restore of ex.pl failed'
Wc_c="`wc -c < 'ex.pl'`"
test 655 -eq "$Wc_c" ||
echo 'ex.pl: original size 655, current size' "$Wc_c"
fi
# ============= getcursor.c ==============
if test -f 'getcursor.c' -a X"$1" != X"-c"; then
echo 'x - skipping getcursor.c (File already exists)'
else
echo 'x - extracting getcursor.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'getcursor.c' &&
X/* getcursor.c
X *
X * Functions to deal with allocating and freeing cursors for Oracle
X */
X/* Copyright 1991 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * a copy of which should have accompanied your Perl kit.
X */
X
X#include "EXTERN.h"
X#include <stdio.h>
X#include <ctype.h>
X#include "orafns.h"
X
X
X/* head of the cursor list */
Xstruct cursor csr_list = { NULL, NULL, NULL, 0, NULL };
X
X
X/* ora_free_data(csr)
X *
X * Frees memory attached to csr->data
X */
X
Xvoid ora_free_data(csr)
Xstruct cursor *csr;
X{
X int i;
X
X DEBUG(8, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr)));
X
X if (csr->data == NULL)
X {
X DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
X return;
X }
X
X for (i = 0 ; i < csr->nfields ; i++)
X {
X if (csr->data[i] != NULL)
X {
X DEBUG(128, (fprintf(stderr, "freeing (%d) == %#lx\n",
X i, (long) csr->data[i])));
X free(csr->data[i]);
X }
X }
X
X DEBUG(128, (fprintf(stderr, "freeing %#lx\n", (long) csr->data)));
X free(csr->data);
X csr->data = NULL;
X csr->nfields = 0;
X DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
X}
X
X
X/* ora_getcursor()
X *
X * Allocates memory for a new cursor and returns its address.
X * Inserts the cursor at the front of the list.
X * Returns NULL if it can't get enough memory.
X */
X
Xstruct cursor *ora_getcursor()
X{
X struct cursor *tmp;
X
X DEBUG(8, (fputs("ora_getcursor()\n", stderr)));
X
X if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL)
X {
X DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
X DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
X ora_errno = ORAP_NOMEM;
X return(NULL);
X }
X DEBUG(128, (fprintf(stderr,
X "ora_getcursor: got cursor at %#lx\n", (long) tmp)));
X
X if ((tmp->csr = (struct csrdef *) malloc(sizeof(struct csrdef))) == NULL)
X {
X free(tmp);
X DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
X DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
X ora_errno = ORAP_NOMEM;
X return(NULL);
X }
X DEBUG(128, (fprintf(stderr,
X "ora_getcursor: got csr at %#lx\n", tmp->csr)));
X
X tmp->hda = NULL;
X tmp->data = NULL;
X tmp->nfields = 0;
X tmp->next = csr_list.next;
X csr_list.next = tmp;
X
X ora_errno = 0;
X DEBUG(8, (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp)));
X return(tmp);
X}
X
X
X/* ora_getlda()
X *
X * Gets a new login data area.
X * Uses ora_getcursor and then allocates the host data area.
X */
X
Xstruct cursor *ora_getlda()
X{
X struct cursor *tmp;
X
X DEBUG(8, (fputs("ora_getlda()\n", stderr)));
X
X if ((tmp = ora_getcursor()) == NULL)
X {
X DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
X return(NULL);
X }
X
X if ((tmp->hda = malloc(256)) == NULL)
X {
X DEBUG(128, (fputs("ora_getlda: out of memory\n", stderr)));
X ora_dropcursor(tmp);
X DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
X ora_errno = ORAP_NOMEM;
X return(NULL);
X }
X DEBUG(128, (fprintf(stderr,
X "ora_getlda: got hda at %#lx\n", tmp->hda)));
X
X DEBUG(8, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp)));
X return(tmp);
X}
X
X
X/* ora_dropcursor(csr)
X *
X * Frees the space occupied by a given cursor, removing it from the list.
X */
X
Xint ora_dropcursor(csr)
Xstruct cursor *csr;
X{
X struct cursor *tmp, *t;
X
X tmp = &csr_list;
X
X DEBUG(8, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr)));
X
X while ((tmp->next != NULL) && (tmp->next != csr))
X {
X tmp = tmp->next;
X }
X
X if (tmp->next == NULL)
X {
X DEBUG(8, (fputs("ora_dropcursor: invalid\n", stderr)));
X ora_errno = ORAP_INVCSR;
X return(0);
X }
X
X t = tmp->next;
X
X if (t->hda != NULL)
X {
X DEBUG(128, (fprintf(stderr,
X "ora_dropcursor: freeing hda at %#lx\n", (long) t->hda)));
X free(t->hda);
X }
X if (t->data != NULL)
X {
X DEBUG(128, (fputs("ora_dropcursor: freeing data\n", stderr)));
X ora_free_data(t);
X }
X
X DEBUG(128, (fprintf(stderr,
X "ora_dropcursor: freeing csr at %#lx\n", (long) t->csr)));
X free(t->csr);
X
X t = t->next;
X DEBUG(128, (fprintf(stderr,
X "ora_dropcursor: freeing cursor at %#lx\n", (long) tmp->next)));
X free(tmp->next);
X tmp->next = t;
X
X DEBUG(8, (fputs("ora_dropcursor: returning\n", stderr)));
X return(1);
X}
X
X
X/* ora_droplda()
X *
X * This is just here for completeness' sake.
X * (I suppose we could check the value of hda in dropcursor and droplda
X * but I don't think it's worth it
X */
X
Xint ora_droplda(lda)
Xstruct cursor *lda;
X{
X DEBUG(8, (fprintf(stderr,
X "ora_droplda(%#lx): calling ora_dropcursor\n", lda)));
X return(ora_dropcursor(lda));
X}
X
X
X/* ora_findcursor()
X *
X * Checks whether the specified csr is present in the list
X */
X
Xint ora_findcursor(csr)
Xstruct cursor *csr;
X{
X struct cursor *tmp;
X
X tmp = &csr_list;
X
X DEBUG(8, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr)));
X
X while ((tmp->next != NULL) && (tmp->next != csr))
X {
X tmp = tmp->next;
X }
X
X if (tmp->next == NULL)
X {
X DEBUG(8, (fputs("ora_findcursor: not valid\n", stderr)));
X return(0);
X }
X
X DEBUG(8, (fputs("ora_findcursor: valid\n", stderr)));
X return(1);
X}
X
X
X/* check_lda()
X *
X * Checks whether the given address corresponds to a valid lda
X */
X
X int check_lda(lda)
X struct cursor *lda;
X {
X DEBUG(8, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda)));
X
X if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL))
X {
X DEBUG(8, (fputs("check_lda: valid\n", stderr)));
X return (1);
X }
X else
X {
X DEBUG(8, (fputs("check_lda: invalid\n", stderr)));
X return (0);
X }
X};
X
X
X/* check_csr()
X *
X * Checks whether the given address corresponds to a valid csr
X */
X
X int check_csr(csr)
X struct cursor *csr;
X {
X DEBUG(8, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr)));
X
X if (ora_findcursor(csr) && (csr->hda == NULL) && (csr->data != NULL))
X {
X DEBUG(8, (fputs("check_csr: valid\n", stderr)));
X return (1);
X }
X else
X {
X DEBUG(8, (fputs("check_csr: invalid\n", stderr)));
X return (0);
X }
X};
SHAR_EOF
chmod 0644 getcursor.c ||
echo 'restore of getcursor.c failed'
Wc_c="`wc -c < 'getcursor.c'`"
test 5749 -eq "$Wc_c" ||
echo 'getcursor.c: original size 5749, current size' "$Wc_c"
fi
# ============= oracle.mus ==============
if test -f 'oracle.mus' -a X"$1" != X"-c"; then
echo 'x - skipping oracle.mus (File already exists)'
else
echo 'x - extracting oracle.mus (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'oracle.mus' &&
X/* oracle.mus
X *
X * User subroutine interface to Oracle functions
X */
X/* Copyright 1991 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * a copy of which should have accompanied your Perl kit.
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "orafns.h"
X
X
Xstatic enum uservars {
X#ifdef DEBUGGING
X UV_ora_debug,
X#endif
X UV_ora_errno,
X UV_ora_errstr,
X};
X
Xstatic enum usersubs {
X US_ora_login,
X US_ora_open,
X US_ora_fetch,
X US_ora_close,
X US_ora_logoff,
X};
X
Xstatic int usersub();
Xstatic int userset();
Xstatic int userval();
X
Xint
Xinit_oracle()
X{
X struct ufuncs uf;
X char *filename = "oracle.c";
X
X uf.uf_set = userset;
X uf.uf_val = userval;
X
X#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
X
X#ifdef DEBUGGING
X MAGICVAR("ora_debug", UV_ora_debug);
X#endif
X MAGICVAR("ora_errno", UV_ora_errno);
X MAGICVAR("ora_errstr", UV_ora_errstr);
X
X make_usub("ora_login", US_ora_login, usersub, filename);
X make_usub("ora_open", US_ora_open, usersub, filename);
X make_usub("ora_fetch", US_ora_fetch, usersub, filename);
X make_usub("ora_close", US_ora_close, usersub, filename);
X make_usub("ora_logoff", US_ora_logoff, usersub, filename);
X};
X
X
Xstatic int
Xusersub(ix, sp, items)
Xint ix;
Xregister int sp;
Xregister int items;
X{
X STR **st = stack->ary_array + sp;
X register int i;
X register char *tmps;
X register STR *Str; /* used in str_get and str_gnum macros */
X
X switch (ix) {
X
XCASE char * ora_login
XI char * database
XI char * name
XI char * password
XEND
X
XCASE char * ora_open
XI char * lda
XI char * stmt
XEND
X
X case US_ora_fetch:
X if (items != 1)
X fatal("Usage: @array = &ora_fetch($csr)");
X else {
X char *csr = (char *) str_get(st[1]);
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 st = stack->ary_array + sp;
X for (i = 0 ; i < retval ; i++) {
X tmps = ora_result[i];
X st[i] = str_2mortal(str_make(tmps, strlen(tmps)));
X }
X return sp + retval - 1;
X } else { /* in scalar context, return the number of fields */
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 str_set(st[0], (char *) NULL);
X return sp;
X }
X }
X /* NOTREACHED */
X
XCASE char * ora_close
XI char * csr
XEND
X
XCASE char * ora_logoff
XI char * lda
XEND
X
X default:
X fatal("Unimplemented user-defined subroutine");
X }
X return sp;
X}
X
X
Xstatic int
Xuserset(ix, str)
Xint ix;
XSTR *str;
X{
X switch (ix) {
X#ifdef DEBUGGING
X case UV_ora_debug:
X ora_debug = (int)str_gnum(str);
X break;
X#endif
X
X case UV_ora_errno:
X fatal("ora_errno is read-only");
X break;
X
X case UV_ora_errstr:
X fatal("ora_errstr is read-only");
X break;
X }
X return 0;
X}
X
X
Xstatic int
Xuserval(ix, str)
Xint ix;
XSTR *str;
X{
X switch (ix) {
X#ifdef DEBUGGING
X case UV_ora_debug:
X str_numset(str, (double) ora_debug);
X break;
X#endif
X
X case UV_ora_errno:
X str_numset(str, (double) ora_errno);
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 }
X str_set(str, ertxt);
X }
X else
X {
X switch (ora_errno)
X {
X case ORAP_NOMEM:
X str_set(str, "insufficient memory");
X break;
X
X case ORAP_INVCSR:
X str_set(str, "invalid cursor");
X break;
X
X case ORAP_INVLDA:
X str_set(str, "invalid login data area");
X break;
X
X case ORAP_NOSID:
X str_set(str, "couldn't set ORACLE_SID");
X break;
X
X default:
X {
X char tmp[30];
X
X sprintf(tmp, "unknown oraperl error %d",
X ora_errno);
X str_set(str, tmp);
X }
X }
X }
X }
X break;
X }
X return 0;
X}
SHAR_EOF
chmod 0644 oracle.mus ||
echo 'restore of oracle.mus failed'
Wc_c="`wc -c < 'oracle.mus'`"
test 3876 -eq "$Wc_c" ||
echo 'oracle.mus: original size 3876, current size' "$Wc_c"
fi
# ============= orafns.c ==============
if test -f 'orafns.c' -a X"$1" != X"-c"; then
echo 'x - skipping orafns.c (File already exists)'
else
echo 'x - extracting orafns.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'orafns.c' &&
X/* orafns.c
X *
X * Simple C interface to Oracle, intended to be linked to Perl.
X */
X/* Copyright 1991 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * a copy of which should have accompanied your Perl kit.
X */
X
X#include "INTERN.h"
X#include <stdio.h>
X#include <ctype.h>
X#include "orafns.h"
X
X
X/* address[] is used to return cursor addresses to the perl program
X * it is used so that we can get the addresses exactly right, without
X * worrying about rounding errors or playing with oracle.mus
X */
X
Xchar address[20];
X
X
X/* NOSID is returned by set_sid if the environment can't be set */
X
X#define NOSID ((char *) -1)
X
X
X/* set_sid(database)
X *
X * Sets the environment variable ORACLE_SID to the given string.
X * Returns the previous value.
X * If the parameter is NULL, restores the previous saved value, if any.
X */
X
Xchar *set_sid(database)
Xchar *database;
X{
X char *sid;
X static char *oldsid = NULL,
X *newsid = NULL;
X
X DEBUG(8, (fprintf(stderr, "set_sid(%s)\n",
X (database == NULL) ? "<NULL>" : database)));
X
X if (database != NULL)
X {
X /* normal case - save old value and set new */
X
X if ((sid = getenv("ORACLE_SID")) != NULL)
X {
X if (oldsid != NULL)
X {
X DEBUG(128, (fprintf(stderr,
X "set_sid: freeing oldsid (%#lx)\n",
X (long) oldsid)));
X free(oldsid);
X }
X if ((oldsid = malloc(strlen(sid) + 1)) == NULL)
X {
X DEBUG(128, (fputs("set_sid: out of memory\n",
X stderr)));
X DEBUG(8, (fputs("set_sid: returning NOSID\n",
X stderr)));
X ora_errno = ORAP_NOMEM;
X return(NOSID);
X }
X DEBUG(128, (fprintf(stderr,
X "set_sid: got oldsid at %#lx\n", (long) oldsid)));
X strcpy(oldsid, sid);
X }
X
X if (newsid != NULL)
X {
X DEBUG(128, (fprintf(stderr,
X "set_sid: freeing newsid (%#lx)\n",
X (long) newsid)));
X free(newsid);
X }
X if ((newsid = malloc(strlen(database) + 12)) == NULL)
X {
X DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
X DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
X ora_errno = ORAP_NOMEM;
X return(NOSID);
X }
X DEBUG(128, (fprintf(stderr,
X "set_sid: got newsid at %#lx\n", (long) newsid)));
X strcpy(newsid, "ORACLE_SID=");
X strcat(newsid, database);
X
X DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
X return (putenv(newsid)) ? oldsid : NULL;
X }
X else
X {
X if (oldsid == NULL)
X {
X DEBUG(8, (fputs("set_sid: oldsid not set\n", stderr)));
X return(NULL);
X }
X
X if (newsid != NULL)
X {
X DEBUG(128, (fprintf(stderr,
X "set_sid: freeing newsid (%#lx)\n", (long)newsid)));
X free(newsid);
X }
X if ((newsid = malloc(strlen(oldsid) + 12)) == NULL)
X {
X DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
X DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
X ora_errno = ORAP_NOMEM;
X return(NOSID);
X }
X DEBUG(128, (fprintf(stderr,
X "set_sid: got newsid at %#lx\n", (long) newsid)));
X strcpy(newsid, "ORACLE_SID=");
X strcat(newsid, oldsid);
X
X DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
X return (putenv(newsid)) ? oldsid : NULL;
X }
X
X /* NOTREACHED */
X}
X
X
X/* ora_login(database, name, password)
X *
X * logs into the current database under the given name and password.
X */
X
Xchar *ora_login(database, name, password)
Xchar *database, *name, *password;
X{
X int logged;
X char *tmp;
X struct cursor *lda;
X
X DEBUG(8, (fprintf(stderr,
X "ora_login(%s, %s, %s)\n", database, name, password)));
X
X if ((lda = ora_getlda()) == NULL)
X {
X DEBUG(8, (fputs("ora_login: couldn't get an lda\n", stderr)));
X return(NULL);
X }
X
X if (set_sid(database) == NOSID)
X {
X DEBUG(8, (fputs("ora_login: couldn't set database\n", stderr)));
X ora_dropcursor(lda);
X return(NULL);
X }
X else if (strcmp(database, getenv("ORACLE_SID")) != 0)
X {
X DEBUG(8, (fprintf(stderr,"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
X logged = orlon(lda->csr, lda->hda, name, -1, password, -1, 0);
X set_sid(NULL); /* don't really care if this fails */
X
X if (logged == 0)
X {
X sprintf(address, "%#lx", (long) lda);
X DEBUG(8, (fprintf(stderr,
X "ora_login: returning lda %s\n", address)));
X ora_errno = 0;
X return(address);
X }
X else
X {
X ora_errno = lda->csr->csrrc;
X ora_droplda(lda);
X DEBUG(8, (fprintf(stderr,
X "ora_login: failed (error %d)\n", ora_errno)));
X return((char *) NULL);
X }
X}
X
X
X/* ora_open(lda, query)
X *
X * sets and executes the specified sql query
X */
X
Xchar *ora_open(lda_s, query)
Xchar *lda_s;
Xchar *query;
X{
X int i;
X struct cursor *csr;
X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
X short dbsize;
X
X DEBUG(8, (fprintf(stderr, "ora_open(%#lx, %s)\n", (long) lda, query)));
X
X if (check_lda(lda) == 0)
X {
X DEBUG(8, (fputs("ora_open: returning NULL\n", stderr)));
X ora_errno = ORAP_INVLDA;
X return((char *) NULL);
X }
X
X if ((csr = ora_getcursor()) == NULL)
X {
X /* ora_errno is set by ora_getcursor */
X DEBUG(8, (fprintf(stderr, "ora_open: can't get a cursor\n")));
X return((char *) NULL);
X }
X
X if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0)
X || (osql3(csr->csr, query, -1) != 0)
X || (oexec(csr->csr) != 0))
X {
X ora_errno = csr->csr->csrrc;
X ora_dropcursor(csr);
X DEBUG(8, (fprintf(stderr,
X "couldn't run SQL statement (error %d)\n", ora_errno)));
X return((char *) NULL);
X }
X
X /* set up csr->data to receive the information when we do a fetch */
X
X i = 0;
X do
X {
X odsc(csr->csr, ++i, (short *) 0, (short *) 0, (short *) 0,
X (short *) 0, (char *) 0, (short *) 0, (short *) 0);
X } while (csr->csr->csrrc == 0);
X --i;
X
X ora_errno = 0;
X
X if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
X {
X DEBUG(128, (fputs("ora_open: out of memory\n", stderr)));
X DEBUG(8, (fputs("ora_open: returning NOMEM\n", stderr)));
X ora_errno = ORAP_NOMEM;
X ora_dropcursor(csr);
X return(0);
X }
X DEBUG(128, (fprintf(stderr, "ora_open: got data at %#lx\n",csr->data)));
X csr->nfields = i;
X
X for (i = 0 ; i < csr->nfields ; i++)
X {
X odsc(csr->csr, i + 1, &dbsize, (short *) 0, (short *) 0,
X (short *) 0, (char *) 0, (short *) 0, (short *) 0);
X
X if ((csr->data[i] = (char *) malloc(dbsize + 1)) == NULL)
X {
X csr->nfields = i;
X ora_dropcursor(csr);
X
X DEBUG(128, (fputs("ora_open: out of memory\n",stderr)));
X DEBUG(8, (fputs("ora_open: returning NOMEM\n",stderr)));
X ora_errno = ORAP_NOMEM;
X return((char *) NULL);
X }
X DEBUG(128, (fprintf(stderr, "ora_open: got field %d at %#lx\n",
X i, csr->data[i])));
X odefin(csr->csr, i + 1, csr->data[i], dbsize + 1, 5, 0,
X (short *) 0, (char *) 0, 0, 0, (short *) 0, (char *) 0);
X }
X
X sprintf(address, "%#lx", (long) csr);
X DEBUG(8, (fprintf(stderr, "ora_open: returning csr %s\n", address)));
X return(address);
X}
X
X
X/* ora_fetch(csr)
X *
X * returns the next set of data from the cursor
X */
X
Xint ora_fetch(csr_s)
Xchar *csr_s;
X{
X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
X
X DEBUG(8, (fprintf(stderr, "ora_fetch(%#lx)\n", (long) csr)));
X
X if (check_csr(csr) == 0)
X {
X DEBUG(8, (fputs("ora_fetch: returning NULL\n", stderr)));
X ora_errno = ORAP_INVCSR;
X return(NULL);
X }
X
X if ((csr->nfields == 0) || (ofetch(csr->csr) != 0))
X {
X DEBUG(8, (fputs("ora_fetch: ofetch failed, returing 0\n",
X stderr)));
X ora_result = NULL;
X ora_errno = csr->csr->csrrc;
X return(0);
X }
X
X ora_result = csr->data;
X ora_errno = 0;
X DEBUG(8, (fprintf(stderr,"ora_fetch: returning <%d>\n", csr->nfields)));
X return(csr->nfields);
X}
X
X
Xchar *OK = "OK"; /* valid return from ora_close, ora_logoff */
X
X/* ora_close(csr)
X *
X * Closes an oracle statement, releasing resources
X */
X
Xchar *ora_close(csr_s)
Xchar *csr_s;
X{
X struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
X
X DEBUG(8, (fprintf(stderr, "ora_close(%#lx)\n", (long) csr)));
X
X if (check_csr(csr) == 0)
X {
X DEBUG(8, (fputs("ora_close: returning NULL\n", stderr)));
X ora_errno = ORAP_INVCSR;
X return(NULL);
X }
X
X oclose(csr->csr);
X ora_errno = csr->csr->csrrc;
X ora_dropcursor(csr);
X
X DEBUG(8, (fputs("ora_close: returning OK\n", stderr)));
X return(OK);
X}
X
X
X/* ora_logoff(lda)
X *
X * Logs the user off of Oracle, releasing all resources
X */
X
Xchar *ora_logoff(lda_s)
Xchar *lda_s;
X{
X struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
X
X DEBUG(8, (fprintf(stderr, "ora_logoff(%#lx)\n", (long) lda)));
X
X if (check_lda(lda) == 0)
X {
X DEBUG(8, (fputs("ora_logoff: returning NULL\n", stderr)));
X ora_errno = ORAP_INVLDA;
X return(NULL);
X }
X
X ologof(lda->csr);
X ora_errno = lda->csr->csrrc;
X ora_droplda(lda);
X
X DEBUG(8, (fputs("ora_logoff: returning OK\n", stderr)));
X return(OK);
X}
SHAR_EOF
chmod 0644 orafns.c ||
echo 'restore of orafns.c failed'
Wc_c="`wc -c < 'orafns.c'`"
test 8596 -eq "$Wc_c" ||
echo 'orafns.c: original size 8596, current size' "$Wc_c"
fi
# ============= orafns.h ==============
if test -f 'orafns.h' -a X"$1" != X"-c"; then
echo 'x - skipping orafns.h (File already exists)'
else
echo 'x - extracting orafns.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'orafns.h' &&
X/* orafns.h
X *
X * Common declarations for the Oraperl functions
X */
X/* Copyright 1991 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * a copy of which should have accompanied your Perl kit.
X */
X
X
X/* public functions to be called by Perl programs */
X
Xchar *ora_login(),
X *ora_open(),
X *ora_close(),
X *ora_logoff();
X
Xint ora_fetch();
X
X
X/* These functions are internal to the system, not for public consumption */
X
Xstruct cursor *ora_getcursor(),
X *ora_getlda();
X
Xint ora_dropcursor(),
X ora_droplda();
X
X
X/* definition of the csrdef structure - taken from the oracle sample program */
X
Xstruct csrdef
X{
X short csrrc; /* return code */
X short csrft; /* function type */
X unsigned long csrrpc; /* rows processed count */
X short csrpeo; /* parse error offset */
X unsigned char csrfc; /* function code */
X unsigned char csrfil; /* filler */
X unsigned short csrarc; /* reserved, private */
X unsigned char csrwrn; /* warning flags */
X unsigned char csrflg; /* error flags */
X /* *** Operating system dependent *** */
X unsigned int csrcn; /* cursor number */
X struct { /* rowid structure */
X struct {
X unsigned long tidtrba; /* rba of first blockof table */
X unsigned short tidpid; /* partition id of table */
X unsigned char tidtbl; /* table id of table */
X } ridtid;
X unsigned long ridbrba; /* rba of datablock */
X unsigned short ridsqn; /* sequence number of row in block */
X } csrrid;
X unsigned int csrose; /* os dependent error code */
X unsigned char csrchk; /* check byte */
X unsigned char crsfill[26]; /* private, reserved fill */
X};
X
X
X/* data structure for the pool of cursors */
X
Xstruct cursor
X{
X struct csrdef *csr;
X char *hda, /* used if this cursor is an lda */
X **data; /* used to receive database contents */
X int nfields; /* number of fields to retrieve */
X struct cursor *next; /* list pointer */
X};
X
X
X/* functions that we use */
X
Xlong strtol();
Xchar *getenv(), *malloc();
X
X
X/* variables accesible to the outside world */
X
XEXT int ora_debug, ora_errno;
XEXT char **ora_result;
X
X
X/* Debugging calls.
X *
X * I've tried to give these some compatibility with Larry's -D flag,
X * but allowing some flexibility so that we can debug the oracle functions
X * without debugging perl as well.
X *
X * If your uperl.o was built with -DDEBUGGING, you can define PERL_DEBUGGING
X * and the oraperl debugging will be initialiased from the -D flag. If not,
X * you can still define DEBUGGING, but you will have to set ora_debug from
X * within your program.
X *
X * At present, the only flags used are:
X * 8 program execution - report function entry and exit
X * 128 use of malloc/free
X */
X
X#ifdef PERL_DEBUGGING
X# ifndef DEBUGGING
X# define DEBUGGING
X# endif
X#endif
X
X#ifdef DEBUGGING
X# define DEBUG(flag, stmt) { if (ora_debug & flag) { (stmt); } }
X# ifdef PERL_DEBUGGING
X extern int debug; /* exists in uperl.o */
X# else
X EXT int debug; /* need to create it ourselves */
X# endif
X#else
X# define DEBUG(flag, stmt)
X#endif
X
X
X/* error codes for ORAPERL
X *
X * These are higher than any possible ORACLE error code,
X * so that they can be distinguished
X */
X
X#define ORAP_ERRMIN 100000 /* lowest value allowed for an oraperl error */
X
X#define ORAP_NOMEM 100001 /* out of memory */
X#define ORAP_INVCSR 100002 /* invalid cursor supplied */
X#define ORAP_INVLDA 100003 /* invalid lda supplied */
X#define ORAP_NOSID 100004 /* couldn't set ORACLE_SID */
SHAR_EOF
chmod 0644 orafns.h ||
echo 'restore of orafns.h failed'
Wc_c="`wc -c < 'orafns.h'`"
test 3578 -eq "$Wc_c" ||
echo 'orafns.h: original size 3578, current size' "$Wc_c"
fi
# ============= oraperl.1 ==============
if test -f 'oraperl.1' -a X"$1" != X"-c"; then
echo 'x - skipping oraperl.1 (File already exists)'
else
echo 'x - extracting oraperl.1 (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'oraperl.1' &&
X.po 8
X.TH ORAPERL 1 Oracle/Perl
X.ad
X.nh
X.SH NAME
Xoraperl \- Perl access to Oracle databases
X.SH SYNOPSIS
X.nf
X$lda = &ora_login($database, $name, $password)
X$csr = &ora_open($lda, $stmt)
X&ora_fetch($csr)
X&ora_close($csr)
X&ora_logoff($lda)
X
X$ora_debug
X$ora_errno
X$ora_errstr
X.fi
X.SH DESCRIPTION
X\fBOraperl\fP is a version of \fIPerl\fP
Xwhich has been extended (through the \fIusersubs\fP feature)
Xto allow access to \fIOracle\fP databases.
X.SH Functions
XAny program wishing to access an \fIOracle\fP database
Xmust first log in to \fIOracle\fP
Xusing \fIora_login\fP.
XThis is called with three parameters,
Xthe system ID of the \fIOracle\fP database to be used,
X(which \fIOracle\fP products expect
Xin the \fBORACLE_SID\fP environment variable)
Xand the \fIOracle\fP username and password.
XThe return value is a login identifier
X(an \fIORACLE Login Data Area\fP).
X
XTo specify the \fISQL\fP statement to be executed,
Xthe program must call \fIora_open\fP.
XThis function takes two parameters:
Xa login identifier (obtained from \fIora_login\fP)
Xand the \fISQL\fP statement to be executed.
XThe return value is a statement identifier
X(an \fIORACLE cursor\fP).
X
XTo retrieve the data returned from an \fISQL\fP \fBSELECT\fP statement,
Xthe program should make successive calls to \fIora_fetch\fP.
XThis function takes a single parameter,
Xa statement identifier (obtained from \fIora_open\fP).
XIn an array context,
Xthe return value is an array containing the data,
Xone element per field.
XIn a scalar context,
Xthe return value is the number of fields available from the query.
X
XWhen all the data desired has been returned from an \fISQL\fP statement,
Xthe statement identifier should be released using the \fIora_close\fP function.
XEvery \fIora_open\fP call should have a corresponding \fIora_close\fP,
Xeven if it did not return any data.
XThis function returns the string \fBOK\fP.
X
XWhen the program no longer needs to access a given database,
Xthe login identifier should be released using the \fIora_logoff\fP function.
XThis function returns the string \fBOK\fP.
X
XAll functions return a null string to indicate failure.
XIn the case of \fIora_fetch\fP, this implies the end of the data.
X.SH Variables
XTwo special variables are provided,
X\fIora_errno\fP and \fIora_errstr\fP.
XThese may only be read;
Xa fatal error occurs if a program attempts to change them.
X\fIOra_errno\fP contains the \fIOracle\fP error code
Xfrom the last function call, and
X\fIora_errstr\fP contains the \fIOracle\fP error message
Xcorresponding to the current value of \fIora_errno\fP.
X.ne 28
X.SH EXAMPLE
X.if t .ft C
X.ta 4 8 12 16 20 24 28 32 36 40
X.nf
X.cc ^ .\" because ex.pl has lines beginning with a .
X^eo .\" so that \n etc don't get messed up
Xformat top =
X Name Phone
X ==== =====
X.
X
Xformat STDOUT =
X @<<<<<<<<<< @>>>>>>>>>>
X $name, $phone
X.
X
Xdie ("You should use oraperl, not perl\n") unless defined &ora_login;
X
X$lda = &ora_login("t", "name", "password")
X || die $ora_errstr;
X$csr = &ora_open($lda, "select * from telno order by name")
X || die $ora_errstr;
X
X$nfields = &ora_fetch($csr);
Xprint "Query will return $nfields fields\n\n";
X
Xwhile (($name, $phone) = &ora_fetch($csr))
X{
X write;
X}
X
Xdo ora_close($csr) || die "can't close cursor";
Xdo ora_logoff($lda) || die "can't log off Oracle";
X^cc
X.ec
X.fi
X.if t .ft P
X.SH DEBUGGING
XIf debugging has been compiled into \fIOraperl\fP,
Xa further variable, \fIora_debug\fP is available.
XSetting this variable sets the level of debugging required.
XIf \fIPerl\fP's own runtime debugging is included,
Xthis variable is initialised from the \fB-D\fP option.
XIt may be set from within an \fIOraperl\fP script by normal assignment.
X
X.ne 6
XTo determine whether debugging is available,
Xyou could use something like this:
X
X.in +3
X.if t .ft C
X.nf
X.eo
Xdefined($ora_debug) && print "debugging available\n";
Xdefined($ora_debug) || print "debugging not available\n";
X.ec
X.fi
X.if t .ft P
X.in -3
X
XAt present, only flags \fB8\fP (program execution)
Xand \fB128\fP (use of malloc and free)
Xare supported.
X.bp
X.SH NOTES
XIn keeping with the philosophy of \fIPerl\fP,
Xthere is no pre-defined limit to the number of simultaneous logins
Xor SQL statements which may be active,
Xnor to the number of data fields which may be returned by a query.
XThe only limits are those imposed by the amount of memory available,
Xor by \fIOracle\fP.
X.SH SEE ALSO
XDocumentation for \fIOracle\fP, \fISQL*Plus\fP and \fIPro*C\fP.
X.br
XDocumentation for \fIPerl\fP.
X.SH AUTHOR
X\fIORACLE\fP by Oracle Corporation, California.
X.br
X\fIPerl\fP by Larry Wall, Jet Propulsion Laboratory, NASA.
X.br
X\fIOraperl\fP by Kevin Stock, Encore Computer SA, France.
SHAR_EOF
chmod 0644 oraperl.1 ||
echo 'restore of oraperl.1 failed'
Wc_c="`wc -c < 'oraperl.1'`"
test 4711 -eq "$Wc_c" ||
echo 'oraperl.1: original size 4711, current size' "$Wc_c"
fi
# ============= oraperl.doc ==============
if test -f 'oraperl.doc' -a X"$1" != X"-c"; then
echo 'x - skipping oraperl.doc (File already exists)'
else
echo 'x - extracting oraperl.doc (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'oraperl.doc' &&
X
X.ce 2
X\fBO R A P E R L\fP
X_____________
X
X
XThis document describes the implementation of \fBOraperl\fP,
Xan extension of the \fIPerl\fP language
Xcapable of accessing \fIOracle\fP databases.
X
X\fIPerl\fP provides a facility known as \fIusersubs\fP,
Xwhich allows user\-specified subroutines
Xto be linked into a \fIPerl\fP interpreter.
X\fIOracle\fP provides \fIOCI\fP, the \fIOracle Call Interface\fP,
Xwhich is a library of subroutines which may be called from C programs.
X\fBOraperl\fP is a combination of these two features.
X
X
X.ce 2
X\fBInterface\fP
X_________
X
XThe C language interface of the \fIOCI\fP is not particularly friendly.
XA number of functions accept redundant parameters,
Xin order to be useful in a wide range of programming languages.
XThe interface is not really suitable for \fIPerl\fP
Xbecause it requires fixed addresses to be specified for receipt of data.
XA new interface was therefore created for \fBOraperl\fP.
X
XThe interface follows the idiom of the following five tasks:
X
X.in +5
X.ta .4i 4.4i
X.nf
X\fBTask Interface\fP
X
X\fB1\fP log in to the database ora_login
X\fB2\fP open a stream for an SQL statement ora_open
X\fB3\fP get the data ora_fetch
X\fB4\fP close the stream ora_close
X\fB5\fP log off of the database ora_logoff
X.fi
X.in -5
X
XSteps \fB2\fP and \fB3\fP are kept separate
Xbecause a single query may produce a large amount of data.
X
X
X.ce 2
X\fBCursors\fP
X_______
X
XThe \fIOCI\fP communicates with the calling process via \fIcursor\fPs.
XOne cursor is required for each login (together with a host data area),
Xand one for each SQL statement executed.
XTo save the user the task of allocating cursors,
X\fBOraperl\fP allocates them automatically,
Xand returns an identifier to the user
Xto be supplied as a parameter to future function calls.
X
XA set of functions (not directly accessible to the user)
Xdeals with the allocation and release of cursors.
X
X
X.ce 2
X\fBInformation from the Database\fP
X_____________________________
X
XEach set of data retrieved from the database
Xis returned to the user as an array.
XA program may determine the number of fields to be returned
Xwithout actually accessing any data.
XThis may be useful
Xin a program which allows queries to be entered interactively.
X
X
X.ce 2
X\fBPublic Function Descriptions\fP
X____________________________
X
XReturn values from functions are in the form of strings,
Xwith a null string being returned for an error.
X
X
X\fBora_login(database, name, password)\fP
X
XRequests a cursor
Xfor use as a \fILogin Data Area\fP (\fIlda\fP)
Xand then calls \fBOCI\ orlon\fP
Xto log the user into the given \fIOracle\fP database
Xunder the name and password specified.
XIt returns the address of the \fIlda\fP.
X
X
X\fBora_open(lda, stmt)\fP
X
XRequests a cursor (\fIcsr\fP)
Xand calls \fBOCI\ oopen\fP to connect it the the specified \fIlda\fP.
XIt then calls \fBOCI\ osql3\fP to attach the SQL statement
Xand \fBOCI\ oexec\fP to instruct \fIOracle\fP to execute it.
X
XIf these three steps succeed,
X\fBora_open\fP then makes successive calls to \fBOCI\ odsc\fP
Xto determine the number and size of the fields which will be returned.
XIt allocates memory for these fields within \fIcsr\fP
Xand attaches them to the cursor using \fBOCI\ odefin\fP.
XIt returns the address of the \fIcsr\fP.
X
X
X\fBora_fetch(csr)\fP
X
XIn an array context,
Xcalls \fBOCI\ ofetch\fP with the specified \fIcsr\fP
Xand returns an array with one element for each field returned.
XIn a scalar context,
Xreturns the number of fields available from the query.
X
X
X\fBora_close(csr)\fP
X
XCalls \fBOCI\ oclose\fP to release the \fIcsr\fP
Xand then frees the memory allocated to it.
XThe string \fBOK\fP is returned.
X
X
X\fBora_logoff(lda)\fP
X
XCalls \fBOCI\ ologoff\fP to log off of \fIOracle\fP
Xand then frees the memory allocated to \fIlda\fP.
XThe string \fBOK\fP is returned.
X
X
X.ce 2
X\fBPublic Variable Descriptions\fP
X____________________________
X
XThe variables are read\-only,
Xsince they refer to the status of \fIOracle\fP commands.
X
X
X\fB$ora_errno\fP
X
XContains the error number from the last \fBOCI\fP function executed.
X
X
X\fB$ora_errstr\fP
X
XContains the error message corresponding to the current value of $errno.
X
X
X.ce 2
X\fBPrivate Function Descriptions\fP
X_____________________________
X
X
XFunctions private to \fBOraperl\fP
Xdeal with the allocation and release of cursors.
X
XThe definition of a cursor is extended from the \fIOracle\fP definition
Xto include an \fIhda\fP (\fIHost Data Area\fP)
Xand space for the data returned from the database.
XThus, \fIcsr\fPs and \fIlda\fPs have the same structure internally.
XAll the cursors are held on a singly\-linked list.
X
X
X\fBora_free_data(csr)\fP
X
XReleases the memory space reserved for data for the specified \fIcsr\fP.
X
X
X\fBora_getcursor()\fP
X
XAllocates a new cursor and adds it to the list.
XIt returns the address of the cursor.
X
X
X\fBora_getlda()\fP
X
XCalls \fBora_getcursor\fP to allocate a new cursor,
Xthen allocates the \fIhda\fP
Xto allow it to be used for logging into \fIOracle\fP.
XIt returns the address of the cursor.
X
X
X\fBora_dropcursor(csr)\fP
X
XReleases the memory associated with the specified cursor,
Xand removes it from the list.
XIt returns 1 if the cursor was successfully dropped,
X0 otherwise.
X
X
X\fBora_droplda(lda)\fP
X
XCalls \fBora_dropcursor\fP to release the cursor
Xand passes back the return value.
XOnly exists for completeness,
Xbut could be extended to verify that what it is dropping is an \fIlda\fP.
X
X
X\fBora_findcursor(csr)\fP
X
XSearches the list looking for the specified \fIcsr\fP.
XIt returns 1 if it was found, 0 otherwise.
X
X
X\fBcheck_csr(csr)\fP
X
XChecks whether the address supplied corresponds to a valid data cursor
X(i.e. it exists in the list,
Xits \fIhda\fP is not allocated,
Xits \fIdata\fP area is allocated).
XIt returns 1 for a valid cursor, 0 otherwise.
X
X
X\fBcheck_lda(lda)\fP
X
XChecks whether the address supplied corresponds to a valid login cursor
X(i.e. it exists in the list,
Xits \fIhda\fP is allocated,
Xits \fIdata\fP area is not allocated).
XIt returns 1 for a valid cursor, 0 otherwise.
X
X
X.ce 2
X\fBDebugging\fP
X_________
X
X\fIPerl\fP includes support for runtime debugging via a \fB\-D\fP option
Xwhich sets debugging flags.
X\fIOraperl\fP also allows runtime debugging by a separate but related mechanism.
X
XDebugging is flag based.
XThe following flags have significance for \fIOraperl\fP:
X
X.in +5
X.ta 5
X.ti -5
X\ \ 8 \c
XReports entry and exit to \fIOraperl\fP functions,
Xincluding internal functions not directly available to \fIOraperl\fP scripts.
X
X.ti -5
X128 \c
XReports use of \fImalloc\fP and \fIfree\fP
Xto obtain cursors, login data areas, etc.
X.in -5
X
XDebugging may be enabled in \fIOraperl\fP
Xby defining either \fBDEBUGGING\fP or \fBPERL_DEBUGGING\fP during compilation.
X\fBPERL_DEBUGGING\fP may only be used
Xif \fIPerl\fP was compiled with debugging enabled.
XIt differs from \fBDEBUGGING\fP in that
Xit arranges for the \fIOraperl\fP debugging flags to be initialised
Xfrom the \fB\-D\fP option on the command line,
Xif given.
X
XIf debugging is compiled into \fIOraperl\fP,
Xthe debugging flags may be accessed or set
Xvia the variable \fIora_debug\fP.
XThis variable may be tested to determine whether debugging has been enabled;
Xfor example:
X
X.ti +5
X\fBdefined($ora_debug)\0||\0warn("oraperl debugging not enabled\en");\fP
SHAR_EOF
chmod 0644 oraperl.doc ||
echo 'restore of oraperl.doc failed'
Wc_c="`wc -c < 'oraperl.doc'`"
test 7198 -eq "$Wc_c" ||
echo 'oraperl.doc: original size 7198, current size' "$Wc_c"
fi
# ============= oraperl.ref ==============
if test -f 'oraperl.ref' -a X"$1" != X"-c"; then
echo 'x - skipping oraperl.ref (File already exists)'
else
echo 'x - extracting oraperl.ref (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'oraperl.ref' &&
X.\" Quick reference sheet for OraPerl
X.\"
X.nf
X.\"
X.ps 10
X\fBOraperl Quick Reference\fP
X.ps 8
X.sp 2
X.ps 10
X\fBOraperl Functions\fP
X.ps 8
X.in +2m
X.sp
X.ti -2m
X\fB$lda = &ora_login($database, $name, $password)\fP
XLogs into the specified database with the name and password given.
XReturns an \fIlda\fP for use with \fIora_open()\fP.
X.sp
X.ti -2m
X\fB$csr = &ora_login($lda, $statement)\fP
XExecutes the given SQL statement in the database identified by $lda.
XReturns a \fIcsr\fP for use with \fIora_fetch()\fP.
X.sp
X.ti -2m
X\fB$n = &ora_fetch($csr)\fP
XReturns the number of fields available from the query.
X.sp
X.ti -2m
X\fB@ary = &ora_fetch($csr)\fP
XRetrieves the (next) output data from the statement identified by $csr.
X.sp
X.ti -2m
X\fB&ora_close($csr)\fP
XFinishes the SQL statement identified by $csr.
X.sp
X.ti -2m
X\fB&ora_logoff($lda)\fP
XLogs out of the database identified by $lda.
X.ti -2m
X.sp 2
X.ps 10
X\fBOraperl Variables\fP
X.sp
X.ps 8
X.ti -2m
X\fB$ora_errno\fP (read only)
XContains the error code from the last funtion call.
X.sp
X.ti -2m
X\fB$ora_errstr\fP (read only)
XContains the error message corresponding to $ora_errno.
X
X.ti -2m
X\fB$ora_debug\fP (if debugging is enabled)
XContains the debugging flags for \fIOraperl\fP.
XMay be set by a program to debug only certain parts of the script.
XThe following flags are meaningful:
X.ta 5m
X\0\08 report function entry and exit
X128 report use of malloc and free
SHAR_EOF
chmod 0644 oraperl.ref ||
echo 'restore of oraperl.ref failed'
Wc_c="`wc -c < 'oraperl.ref'`"
test 1401 -eq "$Wc_c" ||
echo 'oraperl.ref: original size 1401, current size' "$Wc_c"
fi
# ============= usersub.c ==============
if test -f 'usersub.c' -a X"$1" != X"-c"; then
echo 'x - skipping usersub.c (File already exists)'
else
echo 'x - extracting usersub.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'usersub.c' &&
X/* usersub.c
X *
X * Initialisation for Oraperl.
X */
X/* Copyright 1991 Kevin Stock.
X *
X * You may copy this under the terms of the GNU General Public License,
X * a copy of which should have accompanied your Perl kit.
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "orafns.h"
X
Xint
Xuserinit()
X{
X init_oracle();
X
X#ifdef DEBUGGING
X#ifdef PERL_DEBUGGING
X ora_debug = debug; /* pick up the -D flag */
X#else
X ora_debug = 0;
X#endif /* PERL_DEBUGGING */
X#endif /* DEBUGGING */
X
X ora_errno = 0;
X}
X
SHAR_EOF
chmod 0644 usersub.c ||
echo 'restore of usersub.c failed'
Wc_c="`wc -c < 'usersub.c'`"
test 499 -eq "$Wc_c" ||
echo 'usersub.c: original size 499, current size' "$Wc_c"
fi
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.