Subject: perl and postgres

From: George Hartzell <[email-masked]>
Date: Fri, 7 Feb 92 16:52:00 -0800

Included below is a shar file containing a touched up version of
pg-libpq.mus, testtestlipq.pl, and a Makefile (guaranteed to need to
be adjusted for your site).  If you replace the components in the
postgres3.1 distribution with these you should be able to build a
functional pgperl.

   **DISCLAIMER** I have yet to really beat on this. **DISCLAIMER**

There is one call in particular, PQgetline, that I can't believe is
going to work reliably, but I haven't gotten around to asking the perl
gurus to check it out for me (libpq will be _writing_ into a buffer
pointed to by a char* that is allocated by perl, and I don't have the
foggiest idea what guarantees I have about the size of that
buffer...).

The philosphy that i took was to only provide what Jeff Meredith
suggested were "user level" calls in the Perl interface.  If I need
something lower level later, I can always hack it back in (you can
too, it's not hard once you get the hang of it).  I also alphabetized
the various declarations since they seemed to be in a random order and
I didn't know enough to really put them in a functional order.  At
least this way I know where to look for things.

The main reasons that it didn't build before was that a number of
calls have been renamed (prefixed with pbuf_).  I also added
new/missing PQ* calls and clipped out the lower level stuff.

Let me know if there are any suggestions, comments, or upgrades to
this.

I'd be happy to see my changes included in the postgres distribution.

#! /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 <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  Makefile pg-libpq.mus testlibpq.pl
# Wrapped by hartzell@genome on Fri Feb  7 16:38:17 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'Makefile' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(1081 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
X# Makefile for pgperl.
X# $Header: /genome/src/postgres/src/contrib/pgperl/RCS/Makefile,v 1.2 92/02/07 16:37:46 hartzell Exp $
X# Thu Aug 23 15:00:05 1990  Igor Metz <[email-masked]>
X# touched up to work with my configuration under postgres3.1 and perl4.x
X
X# PERLDIR is the directory, where your uperl.o and all perl header file live
XPERLDIR = /genome/src/perl/
X
X# GLOBINCS defines include paths, where your Postgres header files live
XGLOBINCS = -I../../pg -I/usr/postgres/src/lib/H
X
X# LIBS defines, where your libpq.a lives
XLIBS = -L/usr/postgres/obj.sparc -lpq -lm
X
XDISTFILES = README Makefile pg-mus usersub.c pg-libpq.mus testlibpq.pl
X
XCC=cc
XCFLAGS = -g -I$(PERLDIR) $(GLOBINCS)
X#CC=gcc
X#CFLAGS = -traditional -fpcc-struct-return -g -I$(PERLDIR) $(GLOBINCS)
X
Xall: pgperl
X
Xpgperl: $(PERLDIR)/uperl.o usersub.o pg-libpq.o
X	$(CC) -g $(PERLDIR)/uperl.o usersub.o pg-libpq.o $(LIBS) -o pgperl 
X
Xpg-libpq.c: pg-libpq.mus
X	pg-mus pg-libpq.mus > pg-libpq.c
X
Xusersub.o: usersub.c
Xpg-libpq.o: pg-libpq.c
X
Xclean:
X	rm usersub.o pg-libpq.o pg-libpq.c
X
Xdist:
X	shar $(DISTFILES) > dist.shar
END_OF_FILE
if test 1081 -ne `wc -c <'Makefile'`; then
    echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'pg-libpq.mus' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'pg-libpq.mus'\"
else
echo shar: Extracting \"'pg-libpq.mus'\" \(11125 characters\)
sed "s/^X//" >'pg-libpq.mus' <<'END_OF_FILE'
X/*
X * Interface to Postgres 2.0
X *
X * $Header: /genome/src/postgres/src/contrib/pgperl/RCS/pg-libpq.mus,v 1.3 92/01/30 16:50:35 hartzell Exp Locker: hartzell $
X *
X * Tue Aug 21 14:13:40 1990  Igor Metz <[email-masked]>
X *
X * $Id: pg-libpq.mus,v 1.3 92/01/30 16:50:35 hartzell Exp Locker: hartzell $
X * $Log:	pg-libpq.mus,v $
X# Revision 1.3  92/01/30  16:50:35  hartzell
X# added PQendcopy, PQgetline, and PQputline.  Don't trust
X# PQgetline, since it expects a pointer to a buffer (a char *) and
X# I don't really believe that perl is going to give it what it
X# wants.
X# 
X# Revision 1.2  92/01/30  16:18:33  hartzell
X# reworked to work with Postgres 3.1 and Perl 4.?.
X# Made sure that all PQ functions were available,
X# commented out all others, whether 'cuz they're out of date,
X# renamed, or not part of the public interface as defined
X# by Jeff Meredith (e.g. don't begin with PQ) varies.
X# 
X# Revision 1.1  1992/01/18  02:14:01  hartzell
X# Initial revision
X#
XRevision 1.2  91/03/08  13:22:32  kemnitz
Xadded RCS header.
X
XRevision 1.1  90/10/24  20:31:11  cimarron
XInitial revision
X
XRevision 1.1  90/08/23  15:18:20  metz
XInitial revision
X
X * 
X */
X
X#include "tmp/libpq.h"
X#include "tmp/libpq-fe.h"	/* superset of ones also in libpq-be.h */
X
X#include "EXTERN.h"
X#include "perl.h"
X
Xextern char *PQhost;
Xextern char *PQport;
Xextern char *PQtty;
Xextern char *PQoption;
Xextern char *PQdatabase;
Xextern int PQportset;
Xextern int PQxactid;
Xextern int PQtracep;
X
Xstatic enum uservars {
X  UV_PQhost,
X  UV_PQport,
X  UV_PQtty,
X  UV_PQoption,
X  UV_PQdatabase,
X  UV_PQportset,
X  UV_PQxactid,
X  UV_PQtracep
X};
X
Xstatic enum usersubs {
X  US_PQFlushI,
X  US_PQclear,
X  US_PQdb,
X  US_PQendcopy,
X  US_PQexec, 
X  US_PQfinish,
X  US_PQfn,
X  US_PQfname,
X  US_PQfnameGroup,
X  US_PQfnumber,
X  US_PQfnumberGroup,
X  US_PQftype,
X  US_PQgetgroup,
X  US_PQgetline,
X  US_PQgetvalue,
X  US_PQgroup,
X  US_PQnfields,
X  US_PQnfieldsGroup,
X  US_PQngroups,
X  US_PQninstances,
X  US_PQninstancesGroup,
X  US_PQnportals,
X  US_PQntuples,
X  US_PQntuplesGroup,
X  US_PQparray,
X  US_PQpnames,
X  US_PQputline,
X  US_PQreset,
X  US_PQrulep,
X  US_PQsametype,
X  US_PQsetdb,
X  US_PQtrace,
X  US_PQuntrace,
X};
X
Xstatic
Xunsigned int
Xdbl2uint(d)
X     double d;
X{
X  unsigned int i = d;
X  return i;
X}
X
Xstatic
Xdouble
Xuint2dbl(i)
X     unsigned int i;
X{
X  double d = i;
X  return d;
X}
X
X
Xstatic int usersub();
Xstatic int userset();
Xstatic int userval();
X
Xextern void
Xinit_postgres_stuff()
X{	
X  struct ufuncs uf;
X  char *filename = "libpq.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  /* register PG variables */
X  MAGICVAR("PQhost",		UV_PQhost);
X  MAGICVAR("PQport",		UV_PQport);
X  MAGICVAR("PQtty",		UV_PQtty);
X  MAGICVAR("PQoption",		UV_PQoption);
X  MAGICVAR("PQdatabase",	UV_PQdatabase);
X  MAGICVAR("PQportset",		UV_PQportset);
X  MAGICVAR("PQxactid",		UV_PQxactid);
X  MAGICVAR("PQtracep",		UV_PQtracep);
X
X  /* register PG functions */
X  make_usub("PQFlushI",		US_PQFlushI,		usersub, filename);
X  make_usub("PQclear",		US_PQclear,		usersub, filename);
X  make_usub("PQdb",		US_PQdb,		usersub, filename);
X  make_usub("PQendcopy",	US_PQendcopy,		usersub, filename);
X  make_usub("PQexec",		US_PQexec,		usersub, filename);
X  make_usub("PQfinish",		US_PQfinish,		usersub, filename);
X  make_usub("PQfn",		US_PQfn,		usersub, filename);
X  make_usub("PQfname",		US_PQfname,		usersub, filename);
X  make_usub("PQfnameGroup",	US_PQfnameGroup,	usersub, filename);
X  make_usub("PQfnumber",	US_PQfnumber,		usersub, filename);
X  make_usub("PQfnumberGroup",	US_PQfnumberGroup,	usersub, filename);
X  make_usub("PQftype",		US_PQftype,		usersub, filename);
X  make_usub("PQgetgroup",	US_PQgetgroup,		usersub, filename);
X  make_usub("PQgetline",	US_PQgetline,		usersub, filename);
X  make_usub("PQgetvalue",	US_PQgetvalue,		usersub, filename);
X  make_usub("PQgroup",		US_PQgroup,		usersub, filename);
X  make_usub("PQnfields",	US_PQnfields,		usersub, filename);
X  make_usub("PQnfieldsGroup",	US_PQnfieldsGroup,	usersub, filename);
X  make_usub("PQngroups",	US_PQngroups,		usersub, filename);
X  make_usub("PQninstances",	US_PQninstances,	usersub, filename);
X  make_usub("PQninstancesGroup", US_PQninstancesGroup,  usersub, filename);
X  make_usub("PQnportals",	US_PQnportals,		usersub, filename);
X  make_usub("PQntuples",	US_PQntuples,		usersub, filename);
X  make_usub("PQntuplesGroup",	US_PQntuplesGroup,	usersub, filename);
X  make_usub("PQparray",		US_PQparray,		usersub, filename);
X  make_usub("PQpnames",		US_PQpnames,		usersub, filename);
X  make_usub("PQputline",	US_PQputline,		usersub, filename);
X  make_usub("PQreset",		US_PQreset,		usersub, filename);
X  make_usub("PQrulep",		US_PQrulep,		usersub, filename);
X  make_usub("PQsametype",	US_PQsametype,		usersub, filename);
X  make_usub("PQsetdb",		US_PQsetdb,		usersub, filename);
X  make_usub("PQtrace",		US_PQtrace,		usersub, filename);
X  make_usub("PQuntrace",	US_PQuntrace,		usersub, filename);
X}
X
Xstatic int
Xusersub(ix, sp, items)
X     int ix;
X     register int sp;
X     register 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/*
X * Used for flushing out "poll" queries by the monitor.
X */
XCASE int PQFlushI
XI int i_count
XEND
X
X/*
X * free storage claimed by named portal.
X */
XCASE void PQclear
XI char* pname
XEND
X
X/*
X * Return the current database being accessed.
X */
XCASE char* PQdb
XEND
X
X/*
X * returns 1 if all's well?
X */
XCASE int PQendcopy
XEND
X
X/*
X * Send a query to the POSTGRES backend.
X * The return value is a string.
X * If there is an error: return "E error-message".
X * If tuples are fetched from the backend, return "P portal-name".
X * If a query is executed successfully but no tuples fetched,
X * return "C query-command".
X */
XCASE char* PQexec 
XI  char* query
XEND
X
X/*
X * Close communication ports with the backend.
X */
XCASE void PQfinish 
XEND
X
X/*
X * Send a function call to the POSTGRES backend.
X *
X * fnid         : function id
X * result_buf   : pointer to result buffer (&int if integer)
X * result_len   : length of return value.
X * result_is_int: If the result is an integer, this must be non-zero
X * args         : pointer to a NULL terminated arg array.
X *                      (length, if integer, and result-pointer)
X * nargs        : # of arguments in args array.
X */
XCASE char* PQfn 
XI int         fnid
XI void*       result_buf
XI int         result_len
XI int         result_is_int
XI PQArgBlock* args
XI int         nargs
XEND
X
X/*
X * Return the name of a field.
X */
XCASE char* PQfname
XI PortalBuffer* portal
XI int           tuple_index
XI int 		field_number
XEND
X
X/* Return the field (attribute) name given the group index
X * and field index.
X */
XCASE char* PQfnameGroup
XI PortalBuffer* portal
XI int           group_index
XI int           field_number
XEND
X
X/*
X * Return the field index of a given field name within a tuple.
X */
XCASE int PQfnumber
XI PortalBuffer* portal
XI int           tuple_index
XI char*         field_name
XEND
X
X/* Return the field number (index) given the group index and
X * the field name.
X */
XCASE int PQfnumberGroup
XI  PortalBuffer* portal
XI int            group_index
XI char*          field_name
XEND
X
X/*
X * Return the type of a field.
X */
XCASE int PQftype
XI PortalBuffer* portal
XI int           tuple_index
XI int 		field_number
XEND
X
X/*
X * Return the index of the group that a particular tuple is in.
X */
XCASE int PQgetgroup
XI PortalBuffer* portal
XI int           tuple_index
XEND
X
X/* 
X * USER FUNCTION - gets a newline-terminated string from the backend.
X */
XCASE int PQgetline
XIO char* s
XI int    maxlen
XEND
X
X/* 
X * Return an attribute (field) value.
X */
XCASE char* PQgetvalue
XI PortalBuffer* portal
XI int           tuple_index
XI int 		field_number
XEND
X
X/*
X * Return the tuple group that a particular tuple is in.
X */
XCASE GroupBuffer* PQgroup
XI PortalBuffer* portal
XI int           tuple_index
XEND
X
X/*
X * Return the number of fields in a tuple.
X */
XCASE int PQnfields
XI PortalBuffer* portal
XI int           tuple_index
XEND
X
X/*
X * Return the number of fields in a tuple group.
X */
XCASE int PQnfieldsGroup
XI  PortalBuffer* portal
XI int            group_index
XEND
X
X/*
X * Return the number of tuple groups in a portal buffer.
X */
XCASE int PQngroups
XI  PortalBuffer* portal
XEND
X
X/*
X *
X */
XCASE int PQninstances
XI PortalBuffer* portal
XEND
X
X/*
X *
X */
XCASE int PQninstancesGroup
XI PortalBuffer* portal
XI int           group_index
XEND
X
X/* 
X * Return the number of open portals. 
X * If rule_p, only return asynchronized portals. 
X */
XCASE int PQnportals
XI int rule_p
XEND
X
X/*
X * Return the number of tuples in a portal buffer.
X */
XCASE int PQntuples
XI  PortalBuffer* portal
XEND
X
X/*
X * Return the number of tuples in a tuple group.
X */
XCASE int PQntuplesGroup
XI  PortalBuffer* portal
XI int            group_index
XEND
X
X/*
X * Return the portal buffer given a portal name.
X */
XCASE PortalBuffer* PQparray
XI char* pname
XEND
X
X/* 
X * Return all the portal names.
X * If rule_p, only return asynchronized portals. 
X */
XCASE void PQpnames
XI char** pnames
XI int    rule_p
XEND
X
X/*
X * USER FUNCTION - sends a string to the backend.
X */
XCASE int PQputline
XI char* s
XEND
X
X/*
X * Reset the communication port with the backend.
X */
XCASE void PQreset 
XEND
X
X/*
X * Return 1 if an asynchronized portal.
X */
XCASE int PQrulep
XI  PortalBuffer* portal
XEND
X
X/* Return 1 if the two tuples have the same type (in the
X * same group).
X */
XCASE int PQsametype
XI PortalBuffer* portal
XI int           tuple_index1
XI int           tuple_index2
XEND
X
X/*
X * Make the specified database the current database.
X */
XCASE void PQsetdb 
XI  char* dbname
XEND
X
X/*
X * turn on pqdebug() tracing.
X */
XCASE void PQtrace 
XEND
X
X/*
X * turn off pqdebug() tracing.
X */
XCASE void PQuntrace 
XEND
X
X  default:
X    fatal("Unimplemented user-defined subroutine");
X  }
X  return sp;
X}
X
Xstatic int
Xuserval(ix, str)
X     int ix;
X     STR *str;
X{
X  switch (ix) {
X  case UV_PQhost:
X    str_set(str, PQhost);
X    break;
X  case UV_PQport:
X    str_set(str, PQport);
X    break;
X  case UV_PQtty:
X    str_set(str, PQtty);
X    break;
X  case UV_PQoption:
X    str_set(str, PQoption);
X    break;
X  case UV_PQdatabase:
X    str_set(str, PQdatabase);
X    break;
X  case UV_PQportset:
X    str_numset(str, PQportset);
X    break;
X  case UV_PQxactid:
X    str_numset(str, PQxactid);
X    break;
X  case UV_PQtracep:
X    str_numset(str, PQtracep);
X    break;
X  }
X  return 0;
X}
X
Xstatic int
Xuserset(ix, str)
X     int ix;
X     STR *str;
X{
X  switch (ix) {
X  case UV_PQhost:
X    strcpy(PQhost, str_get(str));		/* hope it fits */
X    break;
X  case UV_PQport:
X    strcpy(PQport, str_get(str));		/* hope it fits */
X    break;
X  case UV_PQtty:
X    strcpy(PQtty, str_get(str));		/* hope it fits */
X    break;
X  case UV_PQoption:
X    strcpy(PQoption, str_get(str));		/* hope it fits */
X    break;
X  case UV_PQdatabase:
X    strcpy(PQdatabase, str_get(str));		/* hope it fits */
X    break;
X  case UV_PQportset:
X    PQportset = dbl2uint(str_gnum(str));
X    break;
X  case UV_PQxactid:
X    PQxactid = dbl2uint(str_gnum(str));
X    break;
X  case UV_PQtracep:
X    PQtracep = dbl2uint(str_gnum(str));
X    break;
X  }
X  return 0;
X}
END_OF_FILE
if test 11125 -ne `wc -c <'pg-libpq.mus'`; then
    echo shar: \"'pg-libpq.mus'\" unpacked with wrong size!
fi
# end of 'pg-libpq.mus'
fi
if test -f 'testlibpq.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'testlibpq.pl'\"
else
echo shar: Extracting \"'testlibpq.pl'\" \(3438 characters\)
sed "s/^X//" >'testlibpq.pl' <<'END_OF_FILE'
X#!./pgperl
X# An example of how to use Postgres 2.0 from perl.
X# This example is modelled after the example in the libpq reference manual.
X# $Id: testlibpq.pl,v 1.2 92/02/07 16:33:47 hartzell Exp $
X# $Log:	testlibpq.pl,v $
X#% Revision 1.2  92/02/07  16:33:47  hartzell
X#% *** empty log message ***
X#% 
X#% Revision 1.1  92/01/29  15:10:42  hartzell
X#% Initial revision
X#% 
X#% Revision 1.2  91/03/08  13:22:41  kemnitz
X#% added RCS header.
X#% 
X#
X# $Header: /genome/src/postgres/src/contrib/pgperl/RCS/testlibpq.pl,v 1.2 92/02/07 16:33:47 hartzell Exp $
X#
X#% Revision 1.1  90/10/24  20:31:22  cimarron
X#% Initial revision
X#% 
X
X&init_handler();
X
X# specify the database to access
X&PQsetdb ("cimarron");
X
Xprintf("creating relation person:\n\n");
X&test_create();
X
Xprintf("Relation person before appends:\n\n");
X&test_functions();
X&test_append();
X
Xprintf("Relation person after appends:\n\n");
X&test_functions();
X&PQreset (); # why do I have to reset the line ?? :-(
X&test_remove();
X
Xprintf("Relation person after removes:\n\n");
X&test_functions();
X&test_vars();
X
X# finish execution
X&PQfinish ();
X
Xexit(0);
X
Xsub test_create {
X    local($query);
X
X    $query = "create person (name = char16, age = int4, location = point)";
X    printf("query = %s\n", $query);
X    &PQexec($query);
X}
X
Xsub test_append {
X    local($i, $query);
X
X    &PQexec("begin"); # transaction
X    for ($i=50; $i <= 150; $i = $i + 10) {
X	$query = "append person (name = \"fred\", age = $i, location = \"($i,10)\"::point)";
X	printf("query = %s\n", $query);
X	&PQexec($query);
X    }
X    &PQexec("end"); # transaction
X}
X
Xsub test_remove {
X    local($i, $query);
X    for ($i=50; $i <= 150; $i = $i + 10) {
X	$query = "delete person where person.age = $i ";
X	printf("query = %s\n", $query);
X	&PQexec($query);
X    }
X}
X
Xsub test_functions {
X    local($p, $g, $t, $n, $m, $k, $i, $j);
X
X    # fetch tuples from the person table
X    &PQexec ("begin");
X    &PQexec ("retrieve portal eportal (person.all)");
X    &PQexec ("fetch all in eportal");
X    
X    # examine all the tuples fetched
X    $p = &PQparray ("eportal");	# remember: $p is a pointer !
X    $g = &PQngroups ($p);
X    $t = 0;
X
X    for ($k=0; $k < $g; $k++) {
X	printf("\nNew tuple group:\n");
X	$n = &PQntuplesGroup($p, $k);
X	$m = &PQnfieldsGroup($p, $k);
X	
X	# print out the attribute names
X	for ($i=0; $i < $m; $i++) {
X	    printf("%-15s", &PQfnameGroup($p, $k, $i));
X	}
X	printf("\n");
X	
X	# print out the tuples
X	for ($i=0; $i < $n; $i++) {
X	    for ($j=0; $j < $m; $j++) {
X		printf("%-15s", &PQgetvalue($p, $t + $i, $j));
X	    }
X	    printf("\n");
X	}
X	$t = $t + $n;
X    }
X    
X    # close the portal
X    &PQexec ("close eportal");
X    &PQexec ("end");
X
X    # try some other functions
X    printf("\nNumber of portals open: %d\n", &PQnportals(0));
X}
X
Xsub test_vars {
X    printf("PQhost = %s\n", 	$PQhost);
X    printf("PQport = %s\n",  	$PQport);
X    printf("PQtty = %s\n",  	$PQtty);
X    printf("PQoption = %s\n",  	$PQoption);
X    printf("PQdatabase = %s\n", $PQdatabase);
X    printf("PQportset = %d\n", 	$PQportset);
X    printf("PQxactid = %d\n",  	$PQxactid);
X    printf("PQinitstr = %s\n", 	$PQinitstr);
X    printf("PQtracep = %d\n",  	$PQtracep);
X}
X
Xsub init_handler {
X    $SIG{'HUP'} = 'handler';
X    $SIG{'INT'} = 'handler';
X    $SIG{'QUIT'} = 'handler';
X}
X
Xsub handler {  # 1st argument is signal name
X    local($sig) = @_;
X    print "Caught a SIG$sig--shutting down connection to Postgres.\n";
X    &PQfinish();
X    exit(0);
X}
END_OF_FILE
if test 3438 -ne `wc -c <'testlibpq.pl'`; then
    echo shar: \"'testlibpq.pl'\" unpacked with wrong size!
fi
chmod +x 'testlibpq.pl'
# end of 'testlibpq.pl'
fi
echo shar: End of shell archive.
exit 0