Ingperl extensions

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
Ingres Q & A
To William's Home Page

© William Yuan 2000

Email William