I recently had some Ingres extensions to perl mailed to me. For those that have not heard about perl or these patches a brief description is given below. It seems to me that this is a very easy way to program in 3GL and produce very pretty output. Has anybody used these and hopefully made some functional tools available that are command line oriented, unlike the standard terminal oriented tools. perl - a comprehensive mix of everything you ever wanted awk/C/shell - very good for handling and manipulating text and/or files - not trivial to learn, but well worth the effort - see comp.lang.perl FAQ for a proper description IngPERL - patches to perl to provide the following function do_sql ; execute an sql command - this is done using a 3GL C stub that accepts a command, "prepare"s it and then wraps a cursor around it and returns the rows from the query Examples (supplied with IngPERL): $foo = &sql ("connect test"); if (!defined ($foo)) { die &sql ("geterror"); } else { print "foo: $foo\n"; } $foo = &sql (("select table_name, table_maxpages from iitables" . " where table_maxpages != 1")); if (!defined ($foo)) { die &sql ("geterror"); } else { print "foo: $foo\n"; } while (@foo = &sql ("fetch")) { print "Fetched: ", $foo [0], ", ", $foo [1], ", \"", $foo [2], "\"\n"; } print &sql ("geterror"), "\n"; -- Darren Bock | Dept DEVETIR, Qld, Australia | The mind is its own illusion sgccdeb@citecuc.citec.oz.au | it creates far more problems than ph: 612 07 231 9716 | it could possibly solve in one lifetime fax: 612 07 221 1002 | This code is not mine, it was posted to comp.lang.perl in 1991.7.22 by Ted Lemon (mellon@nigiri.pa.dec.com) If anybody writes any DBA style tools using this I would be very interested to see them posted in this newsgroup. Darren Bock ------------------------cut here------------------------------------ #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh'ingres/Makefile' <<'END_OF_FILE' SRC = /usr/src/local/perl-4.0 GLOBINCS = LOCINCS = LIBS = /usr/ingres/ingres/lib/libingres.a SRCS = usersub.c sql.sc OBJS = usersub.o sql.o SQLPERL = sqlperl X X$(SQLPERL): $(SRC)/uperl.o $(OBJS) X cc $(SRC)/uperl.o $(OBJS) $(LIBS) -lm -o $(SQLPERL) X usersub.o: usersub.c X cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g usersub.c X sql.o: sql.sc X esqlc sql.sc X cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g sql.c X clean: X rm -f *.o *~ $(SQLPERL) sql.c END_OF_FILE if test 441 -ne `wc -c <'ingres/Makefile'`; then echo shar: \"'ingres/Makefile'\" unpacked with wrong size! fi # end of 'ingres/Makefile' fi if test -f 'ingres/sql.sc' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ingres/sql.sc'\" else echo shar: Extracting \"'ingres/sql.sc'\" \(7790 characters\) sed "s/^X//" >'ingres/sql.sc' <<'END_OF_FILE' X/* $Header: X * X * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X */ X X#include "EXTERN.h" X#include "perl.h" X exec sql include sqlca; exec sql include sqlda; int SqlDataLen; char *SqlData; X exec sql begin declare section; char *SqlBuf; char errbuf[150]; exec sql end declare section; X IISQLDA *sqlda = (IISQLDA *)0; X init_sql () X{ X int do_sql (); X X make_usub ("sql", 0, do_sql, "sql.sc"); X} X int do_sql(ix, sp, items) X int ix; X register int sp; X register int items; X{ X static int inited = 0; 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 char *argstr = (char *)str_get (st [1]); X X if (!inited) X { X if (!getenv ("II_SYSTEM")) X fatal ("II_SYSTEM is not set!\n"); X } X X if (!strncmp (argstr, "connect ", 8)) X { X SqlBuf = &argstr [8]; X exec sql connect :SqlBuf; X if (sqlca.sqlcode != 0) X st [0] = &str_undef; X else X { X inited = 1; X st [0] = &str_yes; X } X return sp; X } X else if (!strcmp (argstr, "geterror")) X { X exec sql inquire_ingres (:errbuf = errortext); X str_set(st [0], errbuf); X return sp; X } X else if (!strcmp (argstr, "fetch")) X return do_sql_fetch(sp, items); X else X { X SqlBuf = argstr; X if (do_sql_prepare ()) X st [0] = &str_undef; X else X st [0] = &str_yes; X return sp; X } X} X int do_sql_prepare() X{ X int len; X int save = SqlDataLen; X int templen = 0; X int done; X int i; X X /* If there isn't one around, allocate the initial sqlda: */ X if (sqlda == (IISQLDA *)0) X { X sqlda = (IISQLDA *)malloc (sizeof (IISQLDA)); X if (sqlda == (IISQLDA *)0) X { X return 1; X } X sqlda -> sqln = IISQ_MAX_COLS; X } X X /* Prepare and describe the statement. If there isn't space, X make more space. */ X for (done = 0; !done; ) X { X exec sql prepare stmt from :SqlBuf; X if (sqlca.sqlcode < 0) X { X return 1; X } X exec sql describe stmt into :sqlda; X if (sqlca.sqlcode < 0) X { X return 1; X } X X if (sqlda -> sqld < sqlda -> sqln) X done = 1; X else { X i = sqlda -> sqld; X free (sqlda); X sqlda = (IISQLDA *)malloc (sizeof (IISQLDA) X + (i - IISQ_MAX_COLS) * sizeof (IISQLVAR)); X if (sqlda == (IISQLDA *)0) X { X return 1; X } X sqlda -> sqln = i; X } /* End if */ X } /* End for */ X X /* sqlda -> sqld will be zero if it wasn't a select statement. X If that happens to be the case, just execute the statement X and return an error code. */ X if (sqlda -> sqld == 0) X { X exec sql execute stmt; X if (sqlca.sqlcode < 0) X { X return 1; X } X else X return 0; X } X /* Otherwise, go down the sqlda allocating storage for things: */ X else X { X char *typename = "heck"; X X for (i = 0; i < sqlda -> sqld; i++) X { X int len; X int ind; X int type; X int baggage; X X if (sqlda -> sqlvar [i].sqltype < 0) X { X ind = 1; X type = -sqlda -> sqlvar [i].sqltype; X } X else X { X ind = 0; X type = sqlda -> sqlvar [i].sqltype; X } X X switch (type) X { X case 30: /* integer */ X typename = "INT"; X len = sizeof (int); X sqlda -> sqlvar [i].sqltype = ind ? -30 : 30; X break; X X case 31: /* float */ X case 5: /* money */ X typename = "FLOAT"; X len = sizeof (double); X sqlda -> sqlvar [i].sqltype = ind ? -31 : 31; X break; X X case 3: /* date */ X typename = "DATE"; X len = 30; X sqlda -> sqlvar [i].sqltype = ind ? -21 : 21; X break; X X case 20: /* char */ X typename = "CHAR"; X len = sqlda -> sqlvar [i].sqllen; X baggage = 1; X break; X X case 21: /* varchar */ X typename = "VARCHAR(%d)"; X baggage = 1; X len = sqlda -> sqlvar [i].sqllen + 2; X break; X } X X /* For sqlind, make sure we're on a 16-bit boundary: */ X if (templen & 1) X templen = (templen + 1) & ~1; X X if (ind) X { X sqlda -> sqlvar [i].sqlind = (short *)templen; X templen += 2; X } X else X { X sqlda -> sqlvar [i].sqlind = (short *)0; X } X X /* For sqldata, make sure we're on a 32-bit boundary: */ X if (templen & 3) X templen = (templen + 3) & ~3; X X sqlda -> sqlvar [i].sqldata = (char *)templen; X templen += len + baggage; X } X X /* Now that we've figured out how big everything is, let's make X sure there's space for it: */ X if (save < templen) X { X /* Free the old hunk if there is one, and then X allocate a new one of the appropriate size: */ X if (SqlData != (char *)0) X free (SqlData); X SqlData = (char *)malloc (templen); X SqlDataLen = templen; X if (SqlData == (char *)0) X { X return 1; X } X } X else X { X /* There's more than enough space, so remember the old X size... */ X SqlDataLen = save; X } /* End if */ X X for (i = 0; i < sqlda -> sqld; i++) X { X if (sqlda -> sqlvar [i].sqltype < 0) X { X sqlda -> sqlvar [i].sqlind = X (short *)(SqlData + (int)(sqlda -> sqlvar [i].sqlind)); X } /* End if */ X X sqlda -> sqlvar [i].sqldata = X SqlData + (int)(sqlda -> sqlvar [i].sqldata); X } /* End for */ X } X exec sql declare curs cursor for stmt; X if (sqlca.sqlcode < 0) X { X return 1; X } X exec sql open curs; X if (sqlca.sqlcode < 0) X { X return 1; X } X return 0; X} /* End do_sql_prepare() */ X int do_sql_fetch(sp, items) X register int sp; X register int items; X{ X register STR *str; X register ARRAY *ary = stack; X register int i; X register char *tmps; X register STR *Str; /* used in str_get and str_gnum macros */ X unsigned long len; X X#ifdef DEBUG_SQL printf ("Fetch:\n"); X#endif X exec sql fetch curs using descriptor :sqlda; X X if (sqlca.sqlcode != 0) X { X exec sql close curs; X#ifdef DEBUG_SQL printf ("Done fetching\n"); X#endif X return 0; X } X X#ifdef DEBUG_SQL X printf ("("); X#endif X for (i = 0; i < sqlda -> sqld; i++) X { X int type; X IISQLVAR *var = &sqlda -> sqlvar [i]; X union _data { X char *c; X double *f; X float *sf; X struct { X short l; X char c; X } *v; X int *i; X } data; X X#ifdef DEBUG_SQL X if (i) X printf (" "); X#endif X X data.c = var -> sqldata; X X if (var -> sqltype < 0 && *(var -> sqlind) < 0) X { X (void)astore(ary, sp++, str = str_mortal(&str_no)); X str_set(str, ""); X#ifdef DEBUG_SQL X printf (" "); X#endif X } X else X { X if (var -> sqltype < 0) X type = -var -> sqltype; X else X type = var -> sqltype; X X switch (type) X { X case 30: /* int */ X (void)astore(ary, sp++, str = str_mortal(&str_no)); X str_numset(str, (double)(*data.i)); X#ifdef DEBUG_SQL X printf ("%d", *data.i); X#endif X break; X X case 31: /* float */ X (void)astore(ary, sp++, str = str_mortal(&str_no)); X if (var -> sqllen == sizeof (float)) X { X str_numset (str, (double)(*data.sf)); X#ifdef DEBUG_SQL X printf ("%f", (double)(*data.sf)); X#endif X } X else X { X str_numset(str, *data.f); X#ifdef DEBUG_SQL X printf ("%f", *data.f); X#endif X } X break; X X case 20: /* char */ X data.c [var -> sqllen] = 0; X (void)astore(ary, sp++, str = str_mortal(&str_no)); X str_set(str, data.c); X#ifdef DEBUG_SQL X printf ("'%s'", data.c); X#endif X break; X X case 21: /* varchar */ X (&(data.v -> c)) [data.v -> l] = 0; X (void)astore(ary, sp++, str = str_mortal(&str_no)); X str_set(str, &(data.v -> c)); X#ifdef DEBUG_SQL X printf ("'%s'", data.v -> c); X#endif X break; X } X } X } X#ifdef DEBUG_SQL X printf (")\n"); X#endif X return --sp; X} END_OF_FILE if test 7790 -ne `wc -c <'ingres/sql.sc'`; then echo shar: \"'ingres/sql.sc'\" unpacked with wrong size! fi # end of 'ingres/sql.sc' fi if test -f 'ingres/sqltest' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ingres/sqltest'\" else echo shar: Extracting \"'ingres/sqltest'\" \(451 characters\) sed "s/^X//" >'ingres/sqltest' <<'END_OF_FILE' X$foo = &sql ("connect test"); if (!defined ($foo)) { X die &sql ("geterror"); X} else { X print "foo: $foo\n"; X} X X$foo = &sql (("select table_name, table_maxpages from iitables" . X " where table_maxpages != 1")); if (!defined ($foo)) { X die &sql ("geterror"); X} else { X print "foo: $foo\n"; X} X while (@foo = &sql ("fetch")) { X print "Fetched: ", $foo [0], ", ", $foo [1], ", \"", $foo [2], "\"\n"; X} X print &sql ("geterror"), "\n"; X END_OF_FILE if test 451 -ne `wc -c <'ingres/sqltest'`; then echo shar: \"'ingres/sqltest'\" unpacked with wrong size! fi # end of 'ingres/sqltest' fi if test -f 'ingres/usersub.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ingres/usersub.c'\" else echo shar: Extracting \"'ingres/usersub.c'\" \(311 characters\) sed "s/^X//" >'ingres/usersub.c' <<'END_OF_FILE' X/* $Header: usersub.c,v 4.0 91/03/20 01:56:34 lwall Locked $ X * X * $Log: usersub.c,v $ X * Revision 4.0 91/03/20 01:56:34 lwall X * 4.0 baseline. X * X * Revision 3.0.1.1 90/08/09 04:06:10 lwall X * patch19: Initial revision X * X */ X X#include "EXTERN.h" X#include "perl.h" X int userinit() X{ X init_sql(); X} X END_OF_FILE if test 311 -ne `wc -c <'ingres/usersub.c'`; then echo shar: \"'ingres/usersub.c'\" unpacked with wrong size! fi # end of 'ingres/usersub.c' fi echo shar: End of shell archive. exit 0
© William Yuan 2000
Email William