1.7.0

src/interfaces/perl5/Changes

 Revision history for Perl extension Pg.
 
+1.7.0   Feb 20 1998
+	- adapted to PostgreSQL-6.3:
+	  add host=localhost to the conninfo-string
+	  of test.pl and example-scripts
+	- connectdb() converts dbname to lower case,
+	  unless it is surrounded by double quotes
+	- added new method fetchrow, now you can do:
+	  while (@row = $result->fetchrow)
+
 1.6.3   Sep 25 1997
 	- README update
 

src/interfaces/perl5/Makefile.PL

 #-------------------------------------------------------
 #
-# $Id: Makefile.PL,v 1.4 1997/09/25 21:14:41 mergl Exp $
+# $Id: Makefile.PL,v 1.5 1998/02/20 21:25:32 mergl Exp $
 #
 # Copyright (c) 1997  Edmund Mergl
 #

src/interfaces/perl5/Pg.pm

 #-------------------------------------------------------
 #
-# $Id: Pg.pm,v 1.4 1997/09/25 21:14:43 mergl Exp $
+# $Id: Pg.pm,v 1.5 1998/02/20 21:25:35 mergl Exp $
 #
 # Copyright (c) 1997  Edmund Mergl
 #
@@ -8,7 +8,7 @@
 
 package Pg;
 
-use strict;
+#use strict;
 use Carp;
 use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
 
@@ -84,7 +84,7 @@ require 5.002;
 	PGRES_InvalidOid
 );
 
-$Pg::VERSION = '1.6.3';
+$Pg::VERSION = '1.7.0';
 
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -115,25 +115,21 @@ sub doQuery {
     my $query     = shift;
     my $array_ref = shift;
 
-    my ($result, $status, $nfields, $ntuples, $i, $j);
+    my ($result, $status, $i, $j);
 
-    $result = PQexec($conn, $query);
-    $status = PQresultStatus($result);
-    return($status) if (2 != $status);
-
-    $nfields = PQnfields($result);
-    $ntuples = PQntuples($result);
-    for ($i=0; $i < $ntuples; $i++) {
-        for ($j=0; $j < $nfields; $j++) {
-            $$array_ref[$i][$j] = PQgetvalue($result, $i, $j);
+    if ($result = $conn->exec($query)) {
+        if (2 == ($status = $result->resultStatus)) {
+            for $i (0..$result->ntuples - 1) {
+                for $j (0..$result->nfields - 1) {
+                    $$array_ref[$i][$j] = $result->getvalue($i, $j);
                 }
             }
-
-    PQclear($result);
-
-    return 1;
+        }
+    }
+    return $status;
 }
 
+
 1;
 
 __END__
@@ -192,6 +188,11 @@ about freeing the connection- and result-structures.
 Perl calls the destructor whenever the last reference 
 to an object goes away. 
 
+The method fetchrow can be used to fetch the next row from 
+the server: while (@row = $result->fetchrow).
+Columns which have NULL as value will be set to C<undef>.
+
+
 =head2 old style
 
 All functions and constants are imported into the calling 
@@ -205,7 +206,6 @@ to be freed by the user:
     PQsetdb, use PQfinish to free memory.
     PQexec,  use PQclear to free memory.
 
-
 Pg.pm contains one convenience function: doQuery. It fills a
 two-dimensional array with the result of your query. Usage:
 
@@ -252,12 +252,14 @@ identification. Before using $conn you should call $conn->status to ensure,
 that the connection was properly made. Use the methods below to access 
 the contents of the PGconn structure.
 
-    $conn = Pg::connectdb("option = value")
+    $conn = Pg::connectdb("option1=value option2=value ...")
 
 Opens a new connection to the backend using connection information in a string. 
-The connection identifier $conn ( a pointer to the PGconn structure ) must be 
-used in subsequent commands for unique identification. Before using $conn you 
-should call $conn->status to ensure, that the connection was properly made. 
+Possible options are: dbname, host, user, password, authtype, port, tty, options. 
+The database-name will be converted to lower-case, unless it is surrounded by 
+double quotes. The connection identifier $conn (a pointer to the PGconn structure) 
+must be used in subsequent commands for unique identification. Before using $conn 
+you should call $conn->status to ensure, that the connection was properly made. 
 Use the methods below to access the contents of the PGconn structure.
 
     $Option_ref = Pg::conndefaults()

src/interfaces/perl5/Pg.xs

 /*-------------------------------------------------------
  *
- * $Id: Pg.xs,v 1.4 1997/09/25 21:14:44 mergl Exp $
+ * $Id: Pg.xs,v 1.5 1998/02/20 21:25:36 mergl Exp $
  *
  * Copyright (c) 1997  Edmund Mergl
  *
@@ -9,12 +9,21 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include <string.h>
 
 #include "libpq-fe.h"
 
+typedef struct pg_conn *PG_conn;
+typedef struct pg_result *PG_result;
+
+typedef struct pg_results
+{
+  PGresult *result;
+  int row;
+} PGresults;
+
+typedef struct pg_results *PG_results;
 
-typedef struct pg_conn* PG_conn;
-typedef struct pg_result* PG_result;
 
 static double
 constant(name, arg)
@@ -188,6 +197,30 @@ PGconn *
 PQconnectdb(conninfo)
 	char *	conninfo
 	CODE:
+		/* convert dbname to lower case if not surrounded by double quotes */
+		char *ptr = strstr(conninfo, "dbname");
+		if (ptr) {
+			ptr += 6;
+			while (*ptr && *ptr++ != '=') {
+				;
+			}
+			while (*ptr && (*ptr == ' ' || *ptr == '\t')) {
+				ptr++;
+			}
+			if (*ptr == '"') {
+				*ptr++ = ' ';
+				while (*ptr && *ptr != '"') {
+					ptr++;
+				}
+				if (*ptr == '"') {
+					*ptr++ = ' ';
+				}
+			} else {
+				while (*ptr && *ptr != ' ' && *ptr != '\t') {
+					*ptr++ = tolower(*ptr);
+				}
+			}
+		}
 		RETVAL = PQconnectdb((const char *)conninfo);
 	OUTPUT:
 		RETVAL
@@ -377,11 +410,8 @@ PQcmdStatus(res)
 char *
 PQoidStatus(res)
 	PGresult *	res
-	PREINIT:
-		const char *GAGA;
 	CODE:
-		GAGA = PQoidStatus(res);
-		RETVAL = (char *)GAGA;
+		RETVAL = (char *)PQoidStatus(res);
 	OUTPUT:
 		RETVAL
 
@@ -389,11 +419,8 @@ PQoidStatus(res)
 char *
 PQcmdTuples(res)
 	PGresult *	res
-	PREINIT:
-		const char *GAGA;
 	CODE:
-		GAGA = PQcmdTuples(res);
-		RETVAL = (char *)GAGA;
+		RETVAL = (char *)PQcmdTuples(res);
 	OUTPUT:
 		RETVAL
 
@@ -585,6 +612,30 @@ PG_conn
 connectdb(conninfo)
 	char *	conninfo
 	CODE:
+		/* convert dbname to lower case if not surrounded by double quotes */
+		char *ptr = strstr(conninfo, "dbname");
+		if (ptr) {
+			ptr += 6;
+			while (*ptr && *ptr++ != '=') {
+				;
+			}
+			while (*ptr && (*ptr == ' ' || *ptr == '\t')) {
+				ptr++;
+			}
+			if (*ptr == '"') {
+				*ptr++ = ' ';
+				while (*ptr && *ptr != '"') {
+					ptr++;
+				}
+				if (*ptr == '"') {
+					*ptr++ = ' ';
+				}
+			} else {
+				while (*ptr && *ptr != ' ' && *ptr != '\t') {
+					*ptr++ = tolower(*ptr);
+				}
+			}
+		}
 		RETVAL = PQconnectdb((const char *)conninfo);
 	OUTPUT:
 		RETVAL
@@ -692,14 +743,18 @@ PQuntrace(conn)
 	PG_conn	conn
 
 
-
-PG_result
+PG_results
 PQexec(conn, query)
 	PG_conn	conn
 	char *	query
 	CODE:
-		RETVAL = PQexec(conn, query);
-                if (! RETVAL) { RETVAL = (PGresult *)calloc(1, sizeof(PGresult)); }
+		RETVAL = (PG_results)calloc(1, sizeof(PGresults));
+		if (RETVAL) {
+			RETVAL->result = PQexec((PGconn *)conn, query);
+			if (!RETVAL->result) {
+				RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
+			}
+		}
 	OUTPUT:
 		RETVAL
 
@@ -826,133 +881,172 @@ lo_export(conn, lobjId, filename)
 
 
 
-MODULE = Pg		PACKAGE = PG_result		PREFIX = PQ
+MODULE = Pg		PACKAGE = PG_results		PREFIX = PQ
 
 PROTOTYPES: DISABLE
 
 
 void
 DESTROY(res)
-	PG_result	res
+	PG_results	res
 	CODE:
 		/* printf("DESTROY result\n"); */
-		PQclear(res);
-
+		PQclear(res->result);
+		Safefree(res);
 
 ExecStatusType
 PQresultStatus(res)
-	PG_result	res
-
+	PG_results	res
+	CODE:
+		RETVAL = PQresultStatus(res->result);
+	OUTPUT:
+		RETVAL
 
 int
 PQntuples(res)
-	PG_result	res
+	PG_results	res
+	CODE:
+		RETVAL = PQntuples(res->result);
+	OUTPUT:
+		RETVAL
 
 
 int
 PQnfields(res)
-	PG_result	res
+	PG_results	res
+	CODE:
+		RETVAL = PQnfields(res->result);
+	OUTPUT:
+		RETVAL
 
 
 char *
 PQfname(res, field_num)
-	PG_result	res
+	PG_results	res
 	int	field_num
+	CODE:
+		RETVAL = PQfname(res->result, field_num);
+	OUTPUT:
+		RETVAL
 
 
 int
 PQfnumber(res, field_name)
-	PG_result	res
+	PG_results	res
 	char *	field_name
+	CODE:
+		RETVAL = PQfnumber(res->result, field_name);
+	OUTPUT:
+		RETVAL
 
 
 Oid
 PQftype(res, field_num)
-	PG_result	res
+	PG_results	res
 	int	field_num
+	CODE:
+		RETVAL = PQftype(res->result, field_num);
+	OUTPUT:
+		RETVAL
 
 
 short
 PQfsize(res, field_num)
-	PG_result	res
+	PG_results	res
 	int	field_num
+	CODE:
+		RETVAL = PQfsize(res->result, field_num);
+	OUTPUT:
+		RETVAL
 
 
 char *
 PQcmdStatus(res)
-	PG_result	res
+	PG_results	res
+	CODE:
+		RETVAL = PQcmdStatus(res->result);
+	OUTPUT:
+		RETVAL
 
 
 char *
 PQoidStatus(res)
-	PG_result	res
-	PREINIT:
-		const char *GAGA;
+	PG_results	res
 	CODE:
-		GAGA = PQoidStatus(res);
-		RETVAL = (char *)GAGA;
+		RETVAL = (char *)PQoidStatus(res->result);
 	OUTPUT:
 		RETVAL
 
 
 char *
 PQcmdTuples(res)
-	PG_result	res
-	PREINIT:
-		const char *GAGA;
+	PG_results	res
 	CODE:
-		GAGA = PQcmdTuples(res);
-		RETVAL = (char *)GAGA;
+		RETVAL = (char *)PQcmdTuples(res->result);
 	OUTPUT:
 		RETVAL
 
 
 char *
 PQgetvalue(res, tup_num, field_num)
-	PG_result	res
+	PG_results	res
 	int	tup_num
 	int	field_num
+	CODE:
+		RETVAL = PQgetvalue(res->result, tup_num, field_num);
+	OUTPUT:
+		RETVAL
 
 
 int
 PQgetlength(res, tup_num, field_num)
-	PG_result	res
+	PG_results	res
 	int	tup_num
 	int	field_num
+	CODE:
+		RETVAL = PQgetlength(res->result, tup_num, field_num);
+	OUTPUT:
+		RETVAL
 
 
 int
 PQgetisnull(res, tup_num, field_num)
-	PG_result	res
+	PG_results	res
 	int	tup_num
 	int	field_num
+	CODE:
+		RETVAL = PQgetisnull(res->result, tup_num, field_num);
+	OUTPUT:
+		RETVAL
 
 
 void
 PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
-	PGresult *	res
+	PG_results	res
 	FILE *	fp
 	int	fillAlign
 	char *	fieldSep
 	int	printHeader
 	int	quiet
 	CODE:
-		PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
+		PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
 
 
 void
 PQprintTuples(res, fout, printAttName, terseOutput, width)
-	PG_result	res
+	PG_results	res
 	FILE *	fout
 	int	printAttName
 	int	terseOutput
 	int	width
+	CODE:
+		PQprintTuples(res->result, fout, printAttName, terseOutput, width);
 
 
 void
 PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
 	FILE *	fout
-	PG_result	res
+	PG_results	res
 	bool	header
 	bool	align
 	bool	standard
@@ -979,6 +1073,28 @@ PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, ta
 		for (i = 11; i < items; i++) {
 			ps.fieldName[i - 11] = (char *)SvPV(ST(i), na);
 		}
-		PQprint(fout, res, &ps);
+		PQprint(fout, res->result, &ps);
 		Safefree(ps.fieldName);
 
+
+void
+PQfetchrow(res)
+	PG_results	res
+	PPCODE:
+		if (res && res->result) {
+			int cols = PQnfields(res->result);
+			if (PQntuples(res->result) > res->row) {
+				int col = 0;
+				EXTEND(sp, cols);
+				while (col < cols) {
+					if (PQgetisnull(res->result, res->row, col)) {
+						PUSHs(&sv_undef);
+					} else {
+						char *val = PQgetvalue(res->result, res->row, col);
+						PUSHs(sv_2mortal((SV*)newSVpv(val, 0)));
+					}
+					++col;
+				}
+				++res->row;
+			}
+		}

src/interfaces/perl5/README

 #-------------------------------------------------------
 #
-# $Id: README,v 1.4 1997/09/25 21:14:46 mergl Exp $
+# $Id: README,v 1.5 1998/02/20 21:25:42 mergl Exp $
 #
 # Copyright (c) 1997  Edmund Mergl
 #
@@ -9,7 +9,7 @@
 DESCRIPTION:
 ------------
 
-This is version 1.6.3 of pgsql_perl5 (previously called pg95perl5).
+This is version 1.7.0 of pgsql_perl5 (previously called pg95perl5).
 
 Pgsql_perl5 is an interface between Larry Wall's language perl version 5 and 
 the database PostgreSQL (previously Postgres95). This has been done by using 
@@ -49,7 +49,7 @@ REQUIREMENTS:
 -------------
 
   - build, test and install Perl 5         (at least 5.002)
-  - build, test and install PostgreSQL     (at least 6.2)
+  - build, test and install PostgreSQL     (at least 6.3)
 
 
 PLATFORMS:
@@ -85,6 +85,9 @@ Run 'make test'.
 Note, that the user running this script must have been created with the access 
 rights to create databases *AND* users ! Do not run this script as root ! 
 
+If testing fails with the message 'login failed', please check if access 
+to the database template1 as well as pgperltest is not protected via pg_hba.conf. 
+
 If you are using the shared library libpq.so check if your dynamic loader 
 finds libpq.so. With Linux the command /sbin/ldconfig -v should tell you, 
 where it finds libpq.so. If ldconfig does not find libpq.so, either add an 
@@ -98,6 +101,22 @@ If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a
           'find .../lib/perl5 -name XSUB.h -print'
 If this file is not present, you need to recompile and reinstall perl. 
 
+Also RedHat 5.0 seems to have an incomplete perl-installation: if 
+you get error message during the installation complaining about a 
+missing perllocal.pod, you need to recompile and reinstall perl. 
+
+SGI users: if you get segmentation faults make sure, you use the malloc which 
+           comes with perl when compiling perl (the default is not to).
+           "David R. Noble" <drnoble@engsci.sandia.gov>
+
+HP users: if you get error messages like:
+              can't open shared library: .../lib/libpq.sl
+              No such file or directory
+          when running the test script, try to replace the
+          'shared' option in the LDDFLAGS with 'archive'.
+          Dan Lauterbach <danla@dimensional.com>
+
+
 
 DOCUMENTATION:
 --------------
@@ -108,6 +127,6 @@ installation to read the documentation.
 
 ---------------------------------------------------------------------------
 
-   Edmund Mergl <E.Mergl@bawue.de>                       September 25, 1997
+   Edmund Mergl <E.Mergl@bawue.de>                       February 20, 1998
 
 ---------------------------------------------------------------------------

src/interfaces/perl5/test.pl

@@ -2,7 +2,7 @@
 
 #-------------------------------------------------------
 #
-# $Id: test.pl,v 1.5 1997/09/25 21:14:47 mergl Exp $
+# $Id: test.pl,v 1.6 1998/02/20 21:25:45 mergl Exp $
 #
 # Copyright (c) 1997  Edmund Mergl
 #
@@ -13,7 +13,7 @@
 
 ######################### We start with some black magic to print on failure.
 
-BEGIN { $| = 1; print "1..50\n"; }
+BEGIN { $| = 1; print "1..46\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Pg;
 $loaded = 1;
@@ -23,6 +23,7 @@ print "ok 1\n";
 
 $dbmain = 'template1';
 $dbname = 'pgperltest';
+$dbhost = 'localhost';
 $trace  = '/tmp/pgtrace.out';
 $cnt    = 2;
 $DEBUG  = 0; # set this to 1 for traces
@@ -88,7 +89,7 @@ $SIG{PIPE} = sub { print "broken pipe\n" };
 ######################### create and connect to test database
 # 2-4
 
-$conn = Pg::connectdb("dbname=$dbmain");
+$conn = Pg::connectdb("dbname=$dbmain host=$dbhost");
 cmp_eq(PGRES_CONNECTION_OK, $conn->status);
 
 # might fail if $dbname doesn't exist => don't check resultStatus
@@ -97,7 +98,7 @@ $result = $conn->exec("DROP DATABASE $dbname");
 $result = $conn->exec("CREATE DATABASE $dbname");
 cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
 
-$conn = Pg::connectdb("dbname=$dbname");
+$conn = Pg::connectdb("dbname=$dbname host=$dbhost");
 cmp_eq(PGRES_CONNECTION_OK, $conn->status);
 
 ######################### debug, PQtrace
@@ -178,7 +179,7 @@ $result = $conn->exec("END");
 cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
 
 ######################### select from person, PQgetvalue
-# 35-48
+# 31-44
 
 $result = $conn->exec("SELECT * FROM person");
 cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
@@ -200,14 +201,11 @@ for ($k = 0; $k < $result->nfields; $k++) {
     cmp_eq($k, $fnumber);
 }
 
-for ($k = 0; $k < $result->ntuples; $k++) {
-    $string = "";
-    for ($l = 0; $l < $result->nfields; $l++) {
-        $string .= $result->getvalue($k, $l) . " ";
-    }
-    $i = $k + 1;
-    cmp_eq("$i Edmund Mergl ", $string);
+$string = "";
+while (@row = $result->fetchrow) {
+    $string = join(" ", @row);
 }
+cmp_eq("5 Edmund Mergl", $string);
 
 ######################### debug, PQuntrace
 
@@ -217,9 +215,9 @@ if ($DEBUG) {
 }
 
 ######################### disconnect and drop test database
-# 49-50
+# 45-46
 
-$conn = Pg::connectdb("dbname=$dbmain");
+$conn = Pg::connectdb("dbname=$dbmain host=$dbhost");
 cmp_eq(PGRES_CONNECTION_OK, $conn->status);
 
 $result = $conn->exec("DROP DATABASE $dbname");

src/interfaces/perl5/typemap

 #-------------------------------------------------------
 #
-# $Id: typemap,v 1.4 1997/09/25 21:14:49 mergl Exp $
+# $Id: typemap,v 1.5 1998/02/20 21:25:47 mergl Exp $
 #
 # Copyright (c) 1997  Edmund Mergl
 #
@@ -11,6 +11,7 @@ PGconn *	T_PTRREF
 PGresult *	T_PTRREF
 PG_conn		T_PTROBJ
 PG_result	T_PTROBJ
+PG_results	T_PTROBJ
 ConnStatusType	T_IV
 ExecStatusType	T_IV
 Oid		T_IV