From 376fbadbd2332b77f47fff7483ecb5301df0e848 Mon Sep 17 00:00:00 2001
From: Edmund Mergl <E.Mergl@bawue.de>
Date: Sun, 27 Sep 1998 19:12:35 +0000
Subject: [PATCH] pgsql_perl5-1.8.0

---
 src/interfaces/perl5/Changes             |  21 +-
 src/interfaces/perl5/Makefile.PL         |   2 +-
 src/interfaces/perl5/Pg.pm               | 290 ++++++++----
 src/interfaces/perl5/Pg.xs               | 544 ++++++++++++++++-------
 src/interfaces/perl5/README              |  15 +-
 src/interfaces/perl5/eg/ApachePg.pl      |  36 +-
 src/interfaces/perl5/eg/example.newstyle | 253 +++++------
 src/interfaces/perl5/eg/example.oldstyle | 228 ++++------
 src/interfaces/perl5/test.pl             | 249 ++++++-----
 src/interfaces/perl5/typemap             |   5 +-
 10 files changed, 952 insertions(+), 691 deletions(-)

diff --git a/src/interfaces/perl5/Changes b/src/interfaces/perl5/Changes
index 9ed8124721..728e81ae27 100644
--- a/src/interfaces/perl5/Changes
+++ b/src/interfaces/perl5/Changes
@@ -1,6 +1,6 @@
 #-------------------------------------------------------
 #
-# $Id: Changes,v 1.7 1998/06/01 16:41:18 mergl Exp $
+# $Id: Changes,v 1.8 1998/09/27 19:12:20 mergl Exp $
 #
 # Copyright (c) 1997, 1998  Edmund Mergl
 #
@@ -8,6 +8,25 @@
 
 Revision history for Perl extension Pg.
 
+1.8.0   Sep 27 1998
+	- adapted to PostgreSQL-6.4:
+	  added support for 
+	  o PQsetdbLogin
+	  o PQpass
+	  o PQsocket
+	  o PQbackendPID
+	  o PQsendQuery
+	  o PQgetResult
+	  o PQisBusy
+	  o PQconsumeInput
+	  o PQrequestCancel
+	  o PQgetlineAsync
+	  o PQputnbytes
+	  o PQmakeEmptyPGresult
+	  o PQbinaryTuples
+	  o PQfmod
+	- fixed conndefaults()
+	- fixed lo_read
 
 1.7.4   May 28 1998
 	- applied patches from 
diff --git a/src/interfaces/perl5/Makefile.PL b/src/interfaces/perl5/Makefile.PL
index 134c61e8a2..2accab41f9 100644
--- a/src/interfaces/perl5/Makefile.PL
+++ b/src/interfaces/perl5/Makefile.PL
@@ -1,6 +1,6 @@
 #-------------------------------------------------------
 #
-# $Id: Makefile.PL,v 1.8 1998/06/01 16:41:19 mergl Exp $
+# $Id: Makefile.PL,v 1.9 1998/09/27 19:12:21 mergl Exp $
 #
 # Copyright (c) 1997, 1998  Edmund Mergl
 #
diff --git a/src/interfaces/perl5/Pg.pm b/src/interfaces/perl5/Pg.pm
index 8f0ba77edc..2d6f7a15b7 100644
--- a/src/interfaces/perl5/Pg.pm
+++ b/src/interfaces/perl5/Pg.pm
@@ -1,6 +1,6 @@
 #-------------------------------------------------------
 #
-# $Id: Pg.pm,v 1.7 1998/06/01 16:41:19 mergl Exp $
+# $Id: Pg.pm,v 1.8 1998/09/27 19:12:22 mergl Exp $
 #
 # Copyright (c) 1997, 1998  Edmund Mergl
 #
@@ -22,32 +22,46 @@ require 5.002;
 # Items to export into callers namespace by default.
 @EXPORT = qw(
 	PQconnectdb
-	PQconndefaults
+	PQsetdbLogin
 	PQsetdb
+	PQconndefaults
 	PQfinish
 	PQreset
+	PQrequestCancel
 	PQdb
 	PQuser
+	PQpass
 	PQhost
-	PQoptions
 	PQport
 	PQtty
+	PQoptions
 	PQstatus
 	PQerrorMessage
+	PQsocket
+	PQbackendPID
 	PQtrace
 	PQuntrace
 	PQexec
+	PQnotifies
+	PQsendQuery
+	PQgetResult
+	PQisBusy
+	PQconsumeInput
 	PQgetline
-	PQendcopy
 	PQputline
-	PQnotifies
+	PQgetlineAsync
+	PQputnbytes
+	PQendcopy
+	PQmakeEmptyPGresult
 	PQresultStatus
 	PQntuples
 	PQnfields
+	PQbinaryTuples
 	PQfname
 	PQfnumber
 	PQftype
 	PQfsize
+	PQfmod
 	PQcmdStatus
 	PQoidStatus
 	PQcmdTuples
@@ -55,8 +69,9 @@ require 5.002;
 	PQgetlength
 	PQgetisnull
 	PQclear
-	PQprintTuples
 	PQprint
+	PQdisplayTuples
+	PQprintTuples
 	PQlo_open
 	PQlo_close
 	PQlo_read
@@ -84,7 +99,7 @@ require 5.002;
 	PGRES_InvalidOid
 );
 
-$Pg::VERSION = '1.7.4';
+$Pg::VERSION = '1.8.0';
 
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -145,15 +160,15 @@ Pg - Perl5 extension for PostgreSQL
 new style:
 
     use Pg;
-    $conn = Pg::connectdb("dbname = template1");
-    $result = $conn->exec("create database test");
+    $conn = Pg::connectdb("dbname=template1");
+    $result = $conn->exec("create database pgtest");
 
 
-you may also use the old style:
+old style (depreciated):
 
     use Pg;
     $conn = PQsetdb('', '', '', '', template1);
-    $result = PQexec($conn, "create database test");
+    $result = PQexec($conn, "create database pgtest");
     PQclear($result);
     PQfinish($conn);
 
@@ -232,41 +247,58 @@ implemented in perl using lists or hash.
 =head1 FUNCTIONS
 
 The functions have been divided into three sections: 
-Connection, Result, Large Objects.
+Connection, Result, Large Objects. For details please 
+read L<libpq>.
 
 
 =head2 1. Connection
 
 With these functions you can establish and close a connection to a 
 database. In Libpq a connection is represented by a structure called
-PGconn. Using the appropriate methods you can access almost all 
-fields of this structure.
+PGconn. 
+
+When opening a connection a given database name is always converted to 
+lower-case, unless it is surrounded by double quotes. All unspecified 
+parameters are replaced by environment variables or by hard coded defaults: 
+
+    parameter  environment variable  hard coded default
+    --------------------------------------------------
+    host       PGHOST                localhost
+    port       PGPORT                5432
+    options    PGOPTIONS             ""
+    tty        PGTTY                 ""
+    dbname     PGDATABASE            current userid
+    user       PGUSER                current userid
+    password   PGPASSWORD            ""
+
+Using appropriate methods you can access almost all fields of the 
+returned PGconn structure. 
+
+    $conn = Pg::setdbLogin($pghost, $pgport, $pgoptions, $pgtty, $dbname, $login, $pwd)
+
+Opens a new connection to the backend. 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. 
 
     $conn = Pg::setdb($pghost, $pgport, $pgoptions, $pgtty, $dbname)
 
-Opens a new connection to the backend. You may use an empty string for
-any argument, in which case first the environment is checked and then 
-hard-coded defaults are used. 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.
+The method setdb should be used when username/password authentication is 
+not needed. 
 
     $conn = Pg::connectdb("option1=value option2=value ...")
 
-Opens a new connection to the backend using connection information in a string. 
-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.
+Opens a new connection to the backend using connection information in a 
+string. Possible options are: host, port, options, tty, dbname, user, password. 
+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. 
 
     $Option_ref = Pg::conndefaults()
 
     while(($key, $val) = each %$Option_ref) {
         print "$key, $val\n";
-    }
 
 Returns a reference to a hash containing as keys all possible options for 
 connectdb(). The values are the current defaults. This function differs from 
@@ -275,13 +307,20 @@ his C-counterpart, which returns the complete conninfoOption structure.
     PQfinish($conn)
 
 Old style only !
-Closes the connection to the backend and frees all memory. 
+Closes the connection to the backend and frees the connection data structure. 
 
     $conn->reset
 
 Resets the communication port with the backend and tries
 to establish a new connection.
 
+    $ret = $conn->requestCancel
+
+Abandon processing of the current query. Regardless  of the return value of 
+requestCancel, the application must continue with the normal result-reading 
+sequence using getResult. If the current query is part of a transaction, 
+cancellation will abort the whole transaction. 
+
     $dbname = $conn->db
 
 Returns the database name of the connection.
@@ -290,13 +329,13 @@ Returns the database name of the connection.
 
 Returns the Postgres user name of the connection.
 
-    $pghost = $conn->host
+    $pguser = $conn->pass
 
-Returns the host name of the connection.
+Returns the Postgres password of the connection.
 
-    $pgoptions = $conn->options
+    $pghost = $conn->host
 
-Returns the options used in the connection.
+Returns the host name of the connection.
 
     $pgport = $conn->port
 
@@ -306,6 +345,10 @@ Returns the port of the connection.
 
 Returns the tty of the connection.
 
+    $pgoptions = $conn->options
+
+Returns the options used in the connection.
+
     $status = $conn->status
 
 Returns the status of the connection. For comparing the status 
@@ -318,6 +361,15 @@ you may use the following constants:
 
 Returns the last error message associated with this connection.
 
+    $fd = $conn->socket
+
+Obtain the file descriptor number for the backend connection socket. 
+A result of -1 indicates that no backend connection is currently open. 
+
+    $pid = $conn->backendPID
+
+Returns the process-id of the corresponding backend proceess. 
+
     $conn->trace(debug_port)
 
 Messages passed between frontend and backend are echoed to the 
@@ -338,6 +390,39 @@ structure has to be freed using PQfree. Before using $result you
 should call resultStatus to ensure, that the query was 
 properly executed. 
 
+    ($table, $pid) = $conn->notifies
+
+Checks for asynchronous notifications. This functions differs from 
+the C-counterpart which returns a pointer to a new allocated structure, 
+whereas the perl implementation returns a list. $table is the table 
+which has been listened to and $pid is the process id of the backend. 
+
+
+    $ret = $conn->sendQuery($string, $query)
+
+Submit a query to Postgres without waiting for the result(s). After 
+successfully calling PQsendQuery, call PQgetResult one or more times 
+to obtain the query results.  PQsendQuery may not be called again until 
+getResult has returned NULL, indicating that the query is done. 
+
+    $result = $conn->getResult
+
+Wait for the next result from a prior PQsendQuery, and return it.  NULL 
+is returned when the query is complete and there will be no more results. 
+getResult  will block only if a query is active and the necessary response 
+data has not yet been read by PQconsumeInput. 
+
+    $ret = $conn->isBusy
+
+Returns TRUE if a query is busy, that is, PQgetResult would block waiting 
+for input.  A FALSE  return indicates that PQgetResult can be called with 
+assurance of not blocking.
+
+    $result = $conn->consumeInput
+
+If input is available from the backend, consume it. After calling consumeInput, 
+the application may check isBusy and/or notifies to see if their state has changed. 
+
     $ret = $conn->getline($string, $length)
 
 Reads a string up to $length - 1 characters from the backend. 
@@ -346,26 +431,34 @@ and 1 if the buffer is full. If a line consists of the two
 characters "\." the backend has finished sending the results of 
 the copy command. 
 
-    $conn->putline($string)
+    $ret = $conn->putline($string)
 
 Sends a string to the backend. The application must explicitly 
 send the two characters "\." to indicate to the backend that 
 it has finished sending its data. 
 
+    $ret = $conn->getlineAsync($buffer, $bufsize)
+
+Non-blocking version of getline. It reads up to $bufsize 
+characters from the backend. getlineAsync returns -1 if 
+the end-of-copy-marker has been recognized, 0 if no data 
+is avilable, and >0 the number of bytes returned. 
+
+    $ret = $conn->putnbytes($buffer, $nbytes)
+
+Sends n bytes to the backend. Returns 0 if OK, EOF if not. 
+
     $ret = $conn->endcopy
 
 This function waits  until the backend has finished the copy. 
 It should either be issued when the last string has been sent 
 to  the  backend  using  putline or when the last string has 
 been received from the backend using getline. endcopy returns 
-0 on success, nonzero otherwise. 
+0 on success, 1 on failure. 
 
-    ($table, $pid) = $conn->notifies
+    $result = $conn->makeEmptyPGresult($status);
 
-Checks for asynchronous notifications. This functions differs from 
-the C-counterpart which returns a pointer to a new allocated structure, 
-whereas the perl implementation returns a list. $table is the table 
-which has been listened to and $pid is the process id of the backend. 
+Returns a newly allocated, initialized result with given status. 
 
 
 =head2 2. Result
@@ -375,6 +468,21 @@ investigate the results. In Libpq the result of a command is
 represented by a structure called PGresult. Using the appropriate 
 methods you can access almost all fields of this structure.
 
+    $result_status = $result->resultStatus
+
+Returns the status of the result. For comparing the status you 
+may use one of the following constants depending upon the 
+command executed:
+
+  - PGRES_EMPTY_QUERY
+  - PGRES_COMMAND_OK
+  - PGRES_TUPLES_OK
+  - PGRES_COPY_OUT
+  - PGRES_COPY_IN
+  - PGRES_BAD_RESPONSE
+  - PGRES_NONFATAL_ERROR
+  - PGRES_FATAL_ERROR
+
 Use the functions below to access the contents of the PGresult structure.
 
     $ntuples = $result->ntuples
@@ -385,6 +493,10 @@ Returns the number of tuples in the query result.
 
 Returns the number of fields in the query result.
 
+    $ret = $result->binaryTuples
+
+Returns 1 if the tuples in the query result are bianry. 
+
     $fname = $result->fname($field_num)
 
 Returns the field name associated with the given field number. 
@@ -402,34 +514,10 @@ Returns the oid of the type of the given field number.
 Returns the size in bytes of the type of the given field number. 
 It returns -1 if the field has a variable length.
 
-    $value = $result->getvalue($tup_num, $field_num)
-
-Returns the value of the given tuple and field. This is 
-a null-terminated ASCII string. Binary cursors will not
-work. 
-
-    $length = $result->getlength($tup_num, $field_num)
-
-Returns the length of the value for a given tuple and field. 
-
-    $null_status = $result->getisnull($tup_num, $field_num)
-
-Returns the NULL status for a given tuple and field. 
+    $fmod = $result->fmod($field_num)
 
-    $result_status = $result->resultStatus
-
-Returns the status of the result. For comparing the status you 
-may use one of the following constants depending upon the 
-command executed:
-
-  - PGRES_EMPTY_QUERY
-  - PGRES_COMMAND_OK
-  - PGRES_TUPLES_OK
-  - PGRES_COPY_OUT
-  - PGRES_COPY_IN
-  - PGRES_BAD_RESPONSE
-  - PGRES_NONFATAL_ERROR
-  - PGRES_FATAL_ERROR
+Returns the type-specific modification data of the field associated  
+with the given field index. Field indices start at 0. 
 
     $cmdStatus = $result->cmdStatus
 
@@ -449,9 +537,30 @@ inserted tuple.
 In case the last query was an INSERT or DELETE command it returns the 
 number of affected tuples. 
 
-    $result->printTuples($fout, $printAttName, $terseOutput, $width)
+    $value = $result->getvalue($tup_num, $field_num)
 
-Kept for backward compatibility. Use print.
+Returns the value of the given tuple and field. This is 
+a null-terminated ASCII string. Binary cursors will not
+work. 
+
+    $length = $result->getlength($tup_num, $field_num)
+
+Returns the length of the value for a given tuple and field. 
+
+    $null_status = $result->getisnull($tup_num, $field_num)
+
+Returns the NULL status for a given tuple and field. 
+
+    PQclear($result)
+
+Old style only !
+Frees all memory of the given result. 
+
+    $res->fetchrow
+
+New style only ! 
+Fetches the next row from the server and returns NULL if all rows 
+have been processed. Columns which have NULL as value will be set to C<undef>.
 
     $result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...)
 
@@ -464,10 +573,13 @@ are boolean flags. The arguments $fieldSep, $tableOpt, $caption
 are strings. You may append additional strings, which will be 
 taken as replacement for the field names. 
 
-    PQclear($result)
+    $result->displayTuples($fp, $fillAlign, $fieldSep, $printHeader, qiet)
 
-Old style only !
-Frees all memory of the given result. 
+Kept for backward compatibility. Use print.
+
+    $result->printTuples($fout, $printAttName, $terseOutput, $width)
+
+Kept for backward compatibility. Use print.
 
 
 =head2 3. Large Objects
@@ -478,22 +590,6 @@ system interface with analogies of open, close, read, write,
 lseek, tell. In order to get a consistent naming, all function 
 names have been prepended with 'PQ' (old style only). 
 
-    $lobjId = $conn->lo_creat($mode)
-
-Creates a new large object. $mode is a bit-mask describing 
-different attributes of the new object. Use the following constants: 
-
-  - PGRES_INV_SMGRMASK
-  - PGRES_INV_ARCHIVE
-  - PGRES_INV_WRITE
-  - PGRES_INV_READ
-
-Upon failure it returns PGRES_InvalidOid. 
-
-    $ret = $conn->lo_unlink($lobjId)
-
-Deletes a large object. Returns -1 upon failure. 
-
     $lobj_fd = $conn->lo_open($lobjId, $mode)
 
 Opens an existing large object and returns an object id. 
@@ -519,11 +615,27 @@ Returns the number of bytes written and -1 upon failure.
 Change the current read or write location on the large object 
 $obj_id. Currently $whence can only be 0 (L_SET). 
 
+    $lobjId = $conn->lo_creat($mode)
+
+Creates a new large object. $mode is a bit-mask describing 
+different attributes of the new object. Use the following constants: 
+
+  - PGRES_INV_SMGRMASK
+  - PGRES_INV_ARCHIVE
+  - PGRES_INV_WRITE
+  - PGRES_INV_READ
+
+Upon failure it returns PGRES_InvalidOid. 
+
     $location = $conn->lo_tell($lobj_fd)
 
 Returns the current read or write location on the large object 
 $lobj_fd. 
 
+    $ret = $conn->lo_unlink($lobjId)
+
+Deletes a large object. Returns -1 upon failure. 
+
     $lobjId = $conn->lo_import($filename)
 
 Imports a Unix file as large object and returns 
diff --git a/src/interfaces/perl5/Pg.xs b/src/interfaces/perl5/Pg.xs
index f66936cbc1..5d8777dae8 100644
--- a/src/interfaces/perl5/Pg.xs
+++ b/src/interfaces/perl5/Pg.xs
@@ -1,6 +1,6 @@
 /*-------------------------------------------------------
  *
- * $Id: Pg.xs,v 1.8 1998/09/03 02:10:56 momjian Exp $
+ * $Id: Pg.xs,v 1.9 1998/09/27 19:12:23 mergl Exp $
  *
  * Copyright (c) 1997, 1998  Edmund Mergl
  *
@@ -10,8 +10,11 @@
 #include "perl.h"
 #include "XSUB.h"
 #include <string.h>
+#include <stdio.h>
+#include <fcntl.h>
 
 #include "libpq-fe.h"
+#include "libpq-int.h" /* need this for sizeof(PGresult) */
 
 typedef struct pg_conn *PG_conn;
 typedef struct pg_result *PG_result;
@@ -28,8 +31,7 @@ typedef struct pg_results *PG_results;
 static double
 constant(name, arg)
 char *name;
-int arg;
-{
+int arg; {
     errno = 0;
     switch (*name) {
     case 'A':
@@ -178,10 +180,6 @@ not_there:
 
 
 
-
-
-
-
 MODULE = Pg		PACKAGE = Pg
 
 PROTOTYPES: DISABLE
@@ -200,11 +198,11 @@ PQconnectdb(conninfo)
 		/* 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++;
 			}
-			while (*ptr && (*ptr == ' ' || *ptr == '\t')) {
+                        ptr++;
+			while (*ptr == ' ' || *ptr == '\t') {
 				ptr++;
 			}
 			if (*ptr == '"') {
@@ -226,6 +224,26 @@ PQconnectdb(conninfo)
 		RETVAL
 
 
+PGconn *
+PQsetdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd)
+	char *	pghost
+	char *	pgport
+	char *	pgoptions
+	char *	pgtty
+	char *	dbname
+	char *	login
+	char *	pwd
+
+
+PGconn *
+PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
+	char *	pghost
+	char *	pgport
+	char *	pgoptions
+	char *	pgtty
+	char *	dbname
+
+
 HV *
 PQconndefaults()
 	CODE:
@@ -233,7 +251,11 @@ PQconndefaults()
 		RETVAL = newHV();
                 if (infoOption = PQconndefaults()) {
 			while (infoOption->keyword != NULL) {
-				hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
+				if (infoOption->val != NULL) {
+					hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
+				} else {
+					hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv("", 0), 0);
+				}
 				infoOption++;
 			}
 		}
@@ -241,15 +263,6 @@ PQconndefaults()
 		RETVAL
 
 
-PGconn *
-PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
-	char *	pghost
-	char *	pgport
-	char *	pgoptions
-	char *	pgtty
-	char *	dbname
-
-
 void
 PQfinish(conn)
 	PGconn *	conn
@@ -260,6 +273,10 @@ PQreset(conn)
 	PGconn *	conn
 
 
+int
+PQrequestCancel(conn)
+	PGconn *	conn
+
 char *
 PQdb(conn)
 	PGconn *	conn
@@ -271,12 +288,12 @@ PQuser(conn)
 
 
 char *
-PQhost(conn)
+PQpass(conn)
 	PGconn *	conn
 
 
 char *
-PQoptions(conn)
+PQhost(conn)
 	PGconn *	conn
 
 
@@ -290,6 +307,11 @@ PQtty(conn)
 	PGconn *	conn
 
 
+char *
+PQoptions(conn)
+	PGconn *	conn
+
+
 ConnStatusType
 PQstatus(conn)
 	PGconn *	conn
@@ -300,6 +322,16 @@ PQerrorMessage(conn)
 	PGconn *	conn
 
 
+int
+PQsocket(conn)
+	PGconn *	conn
+
+
+int
+PQbackendPID(conn)
+	PGconn *	conn
+
+
 void
 PQtrace(conn, debug_port)
 	PGconn *	conn
@@ -318,19 +350,63 @@ PQexec(conn, query)
 	char *	query
 	CODE:
 		RETVAL = PQexec(conn, query);
-                if (! RETVAL) { RETVAL = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR); }
+		if (! RETVAL) {
+			RETVAL = (PGresult *)calloc(1, sizeof(PGresult));
+		}
+	OUTPUT:
+		RETVAL
+
+
+void
+PQnotifies(conn)
+	PGconn *	conn
+	PREINIT:
+		PGnotify *notify;
+	PPCODE:
+		notify = PQnotifies(conn);
+		if (notify) {
+			XPUSHs(sv_2mortal(newSVpv((char *)notify->relname, 0)));
+			XPUSHs(sv_2mortal(newSViv(notify->be_pid)));
+			free(notify);
+		}
+
+
+int
+PQsendQuery(conn, query)
+	PGconn *	conn
+	char *	query
+
+
+PGresult *
+PQgetResult(conn)
+	PGconn *	conn
+	CODE:
+		RETVAL = PQgetResult(conn);
+		if (! RETVAL) {
+			RETVAL = (PGresult *)calloc(1, sizeof(PGresult));
+		}
 	OUTPUT:
 		RETVAL
 
 
+int
+PQisBusy(conn)
+	PGconn *	conn
+
+
+int
+PQconsumeInput(conn)
+	PGconn *	conn
+
+
 int
 PQgetline(conn, string, length)
 	PREINIT:
-		SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+		SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
 	INPUT:
 		PGconn *	conn
 		int	length
-		char *	string = sv_grow(sv_buffer, length);
+		char *	string = sv_grow(bufsv, length);
 	CODE:
 		RETVAL = PQgetline(conn, string, length);
 	OUTPUT:
@@ -339,28 +415,42 @@ PQgetline(conn, string, length)
 
 
 int
-PQendcopy(conn)
+PQputline(conn, string)
 	PGconn *	conn
+	char *	string
 
 
-void
-PQputline(conn, string)
+int
+PQgetlineAsync(conn, buffer, bufsize)
+	PREINIT:
+		SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+	INPUT:
+		PGconn *	conn
+		int	bufsize
+		char *	buffer = sv_grow(bufsv, bufsize);
+	CODE:
+		RETVAL = PQgetlineAsync(conn, buffer, bufsize);
+	OUTPUT:
+		RETVAL
+		buffer
+
+
+int
+PQputnbytes(conn, buffer, nbytes)
 	PGconn *	conn
-	char *	string
+	char *	buffer
+	int	nbytes
 
 
-void
-PQnotifies(conn)
+int
+PQendcopy(conn)
 	PGconn *	conn
-	PREINIT:
-		PGnotify *notify;
-	PPCODE:
-		notify = PQnotifies(conn);
-		if (notify) {
-			XPUSHs(sv_2mortal(newSVpv((char *)notify->relname, 0)));
-			XPUSHs(sv_2mortal(newSViv(notify->be_pid)));
-			free(notify);
-		}
+
+
+PGresult *
+PQmakeEmptyPGresult(conn, status)
+	PGconn *	conn
+	ExecStatusType	status
 
 
 ExecStatusType
@@ -378,6 +468,11 @@ PQnfields(res)
 	PGresult *	res
 
 
+int
+PQbinaryTuples(res)
+	PGresult *	res
+
+
 char *
 PQfname(res, field_num)
 	PGresult *	res
@@ -402,6 +497,12 @@ PQfsize(res, field_num)
 	int	field_num
 
 
+int
+PQfmod(res, field_num)
+	PGresult *	res
+	int	field_num
+
+
 char *
 PQcmdStatus(res)
 	PGresult *	res
@@ -451,37 +552,16 @@ PQclear(res)
 	PGresult *	res
 
 
-void
-PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
-	PGresult *	res
-	FILE *	fp
-	int	fillAlign
-	char *	fieldSep
-	int	printHeader
-	int	quiet
-	CODE:
-		PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
-
-
-void
-PQprintTuples(res, fout, printAttName, terseOutput, width)
-	PGresult *	res
-	FILE *	fout
-	int	printAttName
-	int	terseOutput
-	int	width
-
-
 void
 PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
 	FILE *	fout
 	PGresult *	res
-	bool	header
-	bool	align
-	bool	standard
-	bool	html3
-	bool	expanded
-	bool	pager
+	pqbool	header
+	pqbool	align
+	pqbool	standard
+	pqbool	html3
+	pqbool	expanded
+	pqbool	pager
 	char *	fieldSep
 	char *	tableOpt
 	char *	caption
@@ -506,6 +586,27 @@ PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, ta
 		Safefree(ps.fieldName);
 
 
+void
+PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
+	PGresult *	res
+	FILE *	fp
+	int	fillAlign
+	char *	fieldSep
+	int	printHeader
+	int	quiet
+	CODE:
+		PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
+
+
+void
+PQprintTuples(res, fout, printAttName, terseOutput, width)
+	PGresult *	res
+	FILE *	fout
+	int	printAttName
+	int	terseOutput
+	int	width
+
+
 int
 lo_open(conn, lobjId, mode)
 	PGconn *	conn
@@ -528,22 +629,21 @@ lo_read(conn, fd, buf, len)
 	ALIAS:
 		PQlo_read = 1
 	PREINIT:
-		SV *sv_buffer = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
+		SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
 	INPUT:
 		PGconn *	conn
 		int	fd
 		int	len
-		char *	buf = sv_grow(sv_buffer, len + 1);
-	CLEANUP:
-		if (RETVAL >= 0) {
-			SvCUR(sv_buffer) = RETVAL;
-			SvPOK_only(sv_buffer);
-			*SvEND(sv_buffer) = '\0';
-			if (tainting) {
-				sv_magic(sv_buffer, 0, 't', 0, 0);
-			}
+		char *	buf = sv_grow(bufsv, len + 1);
+	CODE:
+		RETVAL = lo_read(conn, fd, buf, len);
+		if (RETVAL > 0) {
+			SvCUR_set(bufsv, RETVAL);
+			*SvEND(bufsv) = '\0';
 		}
-
+	OUTPUT:
+		RETVAL
+		buf
 
 int
 lo_write(conn, fd, buf, len)
@@ -641,17 +741,17 @@ connectdb(conninfo)
 		RETVAL
 
 
-HV *
-conndefaults()
+PG_conn
+setdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd)
+	char *	pghost
+	char *	pgport
+	char *	pgoptions
+	char *	pgtty
+	char *	dbname
+	char *	login
+	char *	pwd
 	CODE:
-		PQconninfoOption *infoOption;
-		RETVAL = newHV();
-                if (infoOption = PQconndefaults()) {
-			while (infoOption->keyword != NULL) {
-				hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
-				infoOption++;
-			}
-		}
+		RETVAL = PQsetdb(pghost, pgport, pgoptions, pgtty, dbname);
 	OUTPUT:
 		RETVAL
 
@@ -669,6 +769,25 @@ setdb(pghost, pgport, pgoptions, pgtty, dbname)
 		RETVAL
 
 
+HV *
+conndefaults()
+	CODE:
+		PQconninfoOption *infoOption;
+		RETVAL = newHV();
+                if (infoOption = PQconndefaults()) {
+			while (infoOption->keyword != NULL) {
+				if (infoOption->val != NULL) {
+					hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
+				} else {
+					hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv("", 0), 0);
+				}
+				infoOption++;
+			}
+		}
+	OUTPUT:
+		RETVAL
+
+
 
 
 
@@ -692,6 +811,11 @@ PQreset(conn)
 	PG_conn	conn
 
 
+int
+PQrequestCancel(conn)
+	PG_conn	conn
+
+
 char *
 PQdb(conn)
 	PG_conn	conn
@@ -703,12 +827,12 @@ PQuser(conn)
 
 
 char *
-PQhost(conn)
+PQpass(conn)
 	PG_conn	conn
 
 
 char *
-PQoptions(conn)
+PQhost(conn)
 	PG_conn	conn
 
 
@@ -722,6 +846,11 @@ PQtty(conn)
 	PG_conn	conn
 
 
+char *
+PQoptions(conn)
+	PG_conn	conn
+
+
 ConnStatusType
 PQstatus(conn)
 	PG_conn	conn
@@ -732,6 +861,16 @@ PQerrorMessage(conn)
 	PG_conn	conn
 
 
+int
+PQsocket(conn)
+	PG_conn	conn
+
+
+int
+PQbackendPID(conn)
+	PG_conn	conn
+
+
 void
 PQtrace(conn, debug_port)
 	PG_conn	conn
@@ -752,21 +891,66 @@ PQexec(conn, query)
 		if (RETVAL) {
 			RETVAL->result = PQexec((PGconn *)conn, query);
 			if (!RETVAL->result) {
-				RETVAL->result = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR);
+				RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
+			}
+		}
+	OUTPUT:
+		RETVAL
+
+
+void
+PQnotifies(conn)
+	PG_conn	conn
+	PREINIT:
+		PGnotify *notify;
+	PPCODE:
+		notify = PQnotifies(conn);
+		if (notify) {
+			XPUSHs(sv_2mortal(newSVpv((char *)notify->relname, 0)));
+			XPUSHs(sv_2mortal(newSViv(notify->be_pid)));
+			free(notify);
+		}
+
+
+int
+PQsendQuery(conn, query)
+	PG_conn	conn
+	char *	query
+
+
+PG_results
+PQgetResult(conn)
+	PG_conn	conn
+	CODE:
+		RETVAL = (PG_results)calloc(1, sizeof(PGresults));
+		if (RETVAL) {
+			RETVAL->result = PQgetResult((PGconn *)conn);
+			if (!RETVAL->result) {
+				RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
 			}
 		}
 	OUTPUT:
 		RETVAL
 
 
+int
+PQisBusy(conn)
+	PG_conn	conn
+
+
+int
+PQconsumeInput(conn)
+	PG_conn	conn
+
+
 int
 PQgetline(conn, string, length)
 	PREINIT:
-		SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+		SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
 	INPUT:
 		PG_conn	conn
 		int	length
-		char *	string = sv_grow(sv_buffer, length);
+		char *	string = sv_grow(bufsv, length);
 	CODE:
 		RETVAL = PQgetline(conn, string, length);
 	OUTPUT:
@@ -775,28 +959,45 @@ PQgetline(conn, string, length)
 
 
 int
-PQendcopy(conn)
+PQputline(conn, string)
 	PG_conn	conn
+	char *	string
 
 
-void
-PQputline(conn, string)
+int
+PQgetlineAsync(conn, buffer, bufsize)
+	PREINIT:
+		SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+	INPUT:
+		PG_conn	conn
+		int	bufsize
+		char *	buffer = sv_grow(bufsv, bufsize);
+	CODE:
+		RETVAL = PQgetline(conn, buffer, bufsize);
+	OUTPUT:
+		RETVAL
+		buffer
+
+
+int
+PQendcopy(conn)
 	PG_conn	conn
-	char *	string
 
 
-void
-PQnotifies(conn)
+PG_results
+PQmakeEmptyPGresult(conn, status)
 	PG_conn	conn
-	PREINIT:
-		PGnotify *notify;
-	PPCODE:
-		notify = PQnotifies(conn);
-		if (notify) {
-			XPUSHs(sv_2mortal(newSVpv((char *)notify->relname, 0)));
-			XPUSHs(sv_2mortal(newSViv(notify->be_pid)));
-			free(notify);
+	ExecStatusType	status
+	CODE:
+		RETVAL = (PG_results)calloc(1, sizeof(PGresults));
+		if (RETVAL) {
+			RETVAL->result = PQmakeEmptyPGresult((PGconn *)conn, status);
+			if (!RETVAL->result) {
+				RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
+			}
 		}
+	OUTPUT:
+		RETVAL
 
 
 int
@@ -815,21 +1016,21 @@ lo_close(conn, fd)
 int
 lo_read(conn, fd, buf, len)
 	PREINIT:
-		SV *sv_buffer = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
+		SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
 	INPUT:
 		PG_conn	conn
 		int	fd
 		int	len
-		char *	buf = sv_grow(sv_buffer, len + 1);
-	CLEANUP:
-		if (RETVAL >= 0) {
-			SvCUR(sv_buffer) = RETVAL;
-			SvPOK_only(sv_buffer);
-			*SvEND(sv_buffer) = '\0';
-			if (tainting) {
-				sv_magic(sv_buffer, 0, 't', 0, 0);
-			}
+		char *	buf = sv_grow(bufsv, len + 1);
+	CODE:
+		RETVAL = lo_read(conn, fd, buf, len);
+		if (RETVAL > 0) {
+			SvCUR_set(bufsv, RETVAL);
+			*SvEND(bufsv) = '\0';
 		}
+	OUTPUT:
+		RETVAL
+		buf
 
 
 int
@@ -920,6 +1121,15 @@ PQnfields(res)
 		RETVAL
 
 
+int
+PQbinaryTuples(res)
+	PG_results	res
+	CODE:
+		RETVAL = PQbinaryTuples(res->result);
+	OUTPUT:
+		RETVAL
+
+
 char *
 PQfname(res, field_num)
 	PG_results	res
@@ -960,6 +1170,16 @@ PQfsize(res, field_num)
 		RETVAL
 
 
+int
+PQfmod(res, field_num)
+	PG_results	res
+	int	field_num
+	CODE:
+		RETVAL = PQfmod(res->result, field_num);
+	OUTPUT:
+		RETVAL
+
+
 char *
 PQcmdStatus(res)
 	PG_results	res
@@ -1021,38 +1241,38 @@ PQgetisnull(res, tup_num, field_num)
 
 
 void
-PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
-	PG_results	res
-	FILE *	fp
-	int	fillAlign
-	char *	fieldSep
-	int	printHeader
-	int	quiet
-	CODE:
-		PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
-
-
-void
-PQprintTuples(res, fout, printAttName, terseOutput, width)
+PQfetchrow(res)
 	PG_results	res
-	FILE *	fout
-	int	printAttName
-	int	terseOutput
-	int	width
-	CODE:
-		PQprintTuples(res->result, fout, printAttName, terseOutput, width);
+	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;
+			}
+		}
 
 
 void
 PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
 	FILE *	fout
 	PG_results	res
-	bool	header
-	bool	align
-	bool	standard
-	bool	html3
-	bool	expanded
-	bool	pager
+	pqbool	header
+	pqbool	align
+	pqbool	standard
+	pqbool	html3
+	pqbool	expanded
+	pqbool	pager
 	char *	fieldSep
 	char *	tableOpt
 	char *	caption
@@ -1078,23 +1298,23 @@ PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, ta
 
 
 void
-PQfetchrow(res)
+PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
 	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;
-			}
-		}
+	FILE *	fp
+	int	fillAlign
+	char *	fieldSep
+	int	printHeader
+	int	quiet
+	CODE:
+		PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
+
+
+void
+PQprintTuples(res, fout, printAttName, terseOutput, width)
+	PG_results	res
+	FILE *	fout
+	int	printAttName
+	int	terseOutput
+	int	width
+	CODE:
+		PQprintTuples(res->result, fout, printAttName, terseOutput, width);
diff --git a/src/interfaces/perl5/README b/src/interfaces/perl5/README
index 99c861dd3d..7332ffc0b9 100644
--- a/src/interfaces/perl5/README
+++ b/src/interfaces/perl5/README
@@ -1,6 +1,6 @@
 #-------------------------------------------------------
 #
-# $Id: README,v 1.7 1998/06/01 16:41:19 mergl Exp $
+# $Id: README,v 1.8 1998/09/27 19:12:24 mergl Exp $
 #
 # Copyright (c) 1997, 1998  Edmund Mergl
 #
@@ -9,7 +9,7 @@
 DESCRIPTION:
 ------------
 
-This is version 1.7.4 of pgsql_perl5 (previously called pg95perl5).
+This is version 1.8.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 
@@ -23,6 +23,9 @@ has the benefit, that existing Libpq applications can easily be ported to
 perl. The new style uses class packages and might be more familiar for C++-
 programmers. 
 
+NOTE: it is planned to drop the old C-style interface in the next major release 
+      of PostgreSQL. 
+
 
 
 COPYRIGHT:
@@ -36,7 +39,7 @@ License or the Artistic License, as specified in the Perl README file.
 IF YOU HAVE PROBLEMS:
 ---------------------
 
-Please send comments and bug-reports to <E.Mergl@bawue.de>
+Please send comments and bug-reports to <pgsql-interfaces@postgresql.org>
 
 Please include the output of perl -v,
                          and perl -V,
@@ -48,8 +51,8 @@ in your bug-report.
 REQUIREMENTS:
 -------------
 
-  - build, test and install Perl 5         (at least 5.002)
-  - build, test and install PostgreSQL     (at least 6.3)
+  - build, test and install Perl5          (at least 5.002)
+  - build, test and install PostgreSQL     (at least 6.4)
 
 
 PLATFORMS:
@@ -129,6 +132,6 @@ installation to read the documentation.
 
 ---------------------------------------------------------------------------
 
-   Edmund Mergl <E.Mergl@bawue.de>                            May 28, 1998
+   Edmund Mergl <E.Mergl@bawue.de>                       September 27, 1998
 
 ---------------------------------------------------------------------------
diff --git a/src/interfaces/perl5/eg/ApachePg.pl b/src/interfaces/perl5/eg/ApachePg.pl
index 26fdc2cd1b..136d6122d8 100644
--- a/src/interfaces/perl5/eg/ApachePg.pl
+++ b/src/interfaces/perl5/eg/ApachePg.pl
@@ -1,18 +1,12 @@
 #!/usr/local/bin/perl
 
-#-------------------------------------------------------
-#
-# $Id: ApachePg.pl,v 1.4 1998/06/01 16:41:26 mergl Exp $
-#
-# Copyright (c) 1997, 1998  Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: ApachePg.pl,v 1.5 1998/09/27 19:12:33 mergl Exp $
 
 # demo script, tested with:
-#  - PostgreSQL-6.3
-#  - apache_1.3
-#  - mod_perl-1.08
-#  - perl5.004_04
+#  - PostgreSQL-6.4
+#  - apache_1.3.1
+#  - mod_perl-1.15
+#  - perl5.005_02
 
 use CGI;
 use Pg;
@@ -26,7 +20,7 @@ print  $query->header,
        "<CENTER><H3>Testing Module Pg</H3></CENTER>",
        "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
        "<TR><TD>Enter conninfo string: </TD>",
-           "<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1 host=localhost'), "</TD>",
+           "<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "</TD>",
        "</TR>",
        "<TR><TD>Enter select command: </TD>",
            "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
@@ -39,17 +33,21 @@ if ($query->param) {
 
     my $conninfo = $query->param('conninfo');
     my $conn = Pg::connectdb($conninfo);
-    if ($conn->status == PGRES_CONNECTION_OK) {
+    if (PGRES_CONNECTION_OK == $conn->status) {
         my $cmd = $query->param('cmd');
         my $result = $conn->exec($cmd);
-        print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
-        my @row;
-        while (@row = $result->fetchrow) {
-            print "<TR><TD>", join("</TD><TD>", @row), "</TD></TR>";
+        if (PGRES_TUPLES_OK == $result->resultStatus) {
+            print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
+            my @row;
+            while (@row = $result->fetchrow) {
+                print "<TR><TD>", join("</TD><TD>", @row), "</TD></TR>";
+            }
+            print "</TABLE></CENTER><P>\n";
+        } else {
+            print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
         }
-        print "</TABLE></CENTER><P>\n";
     } else {
-        print "<CENTER><H2>Connect to database failed</H2></CENTER>\n";
+        print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
     }
 }
 
diff --git a/src/interfaces/perl5/eg/example.newstyle b/src/interfaces/perl5/eg/example.newstyle
index f2c6a572cb..9cccaa983f 100644
--- a/src/interfaces/perl5/eg/example.newstyle
+++ b/src/interfaces/perl5/eg/example.newstyle
@@ -1,49 +1,33 @@
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl
 
-#-------------------------------------------------------
-#
-# $Id: example.newstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
-#
-# Copyright (c) 1997, 1998  Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: example.newstyle,v 1.6 1998/09/27 19:12:34 mergl Exp $
 
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+######################### globals
 
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; print "1..56\n"; }
-END {print "not ok 1\n" unless $loaded;}
+$| = 1;
 use Pg;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
 
 $dbmain = 'template1';
 $dbname = 'pgperltest';
 $trace  = '/tmp/pgtrace.out';
-$cnt    = 2;
 $DEBUG  = 0; # set this to 1 for traces
 
-$| = 1;
-
-######################### the following methods will be tested
+######################### the following methods will be used
 
 #	connectdb
+#	conndefaults
 #	db
 #	user
 #	port
-#	finish
 #	status
 #	errorMessage
 #	trace
 #	untrace
 #	exec
+#	consumeInput
 #	getline
-#	endcopy
 #	putline
+#	endcopy
 #	resultStatus
 #	ntuples
 #	nfields
@@ -61,14 +45,25 @@ $| = 1;
 #	lo_export
 #	lo_unlink
 
-######################### the following methods will not be tested
+######################### the following methods will not be used
 
 #	setdb
-#	conndefaults
+#	setdbLogin
 #	reset
-#	options
+#	requestCancel
+#	pass
 #	host
 #	tty
+#	options
+#	socket
+#	backendPID
+#	sendQuery
+#	getResult
+#	isBusy
+#	getlineAsync
+#	putnbytes
+#	makeEmptyPGresult
+#	fmod
 #	getlength
 #	getisnull
 #	displayTuples
@@ -86,82 +81,89 @@ $| = 1;
 $SIG{PIPE} = sub { print "broken pipe\n" };
 
 ######################### create and connect to test database
-# 2-4
+
+$Option_ref = Pg::conndefaults();
+($key, $val);
+print "connection defaults:\n";
+while (($key, $val) = each %$Option_ref) {
+    printf "  keyword = %-12.12s val = >%s<\n", $key, $val;
+}
 
 $conn = Pg::connectdb("dbname=$dbmain");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
+print "connected to $dbmain\n";
 
-# might fail if $dbname doesn't exist => don't check resultStatus
-$result = $conn->exec("DROP DATABASE $dbname");
+# do not complain when dropping $dbname
+$conn->exec("DROP DATABASE $dbname");
 
 $result = $conn->exec("CREATE DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "created database $dbname\n";
 
 $conn = Pg::connectdb("dbname=$dbname");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
+print "connected to $dbname\n";
 
-######################### debug, PQtrace
+######################### debug, trace
 
 if ($DEBUG) {
     open(TRACE, ">$trace") || die "can not open $trace: $!";
     $conn->trace(TRACE);
+    print "enabled tracing into $trace\n";
 }
 
 ######################### check PGconn
-# 5-7
 
 $db = $conn->db;
-cmp_eq($dbname, $db);
+print "  database: $db\n";
 
 $user = $conn->user;
-cmp_ne("", $user);
+print "  user:     $user\n";
 
 $port = $conn->port;
-cmp_ne("", $port);
+print "  port:     $port\n";
 
 ######################### create and insert into table
-# 8-19
 
 $result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("CREATE", $result->cmdStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "created table, status = ", $result->cmdStatus, "\n";
 
 for ($i = 1; $i <= 5; $i++) {
     $result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
-    cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-    cmp_ne(0, $result->oidStatus);
+    die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 }
+print "insert into table, last oid = ", $result->oidStatus, "\n";
 
-######################### copy to stdout, PQgetline
-# 20-26
+######################### copy to stdout, getline
 
 $result = $conn->exec("COPY person TO STDOUT");
-cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
+print "copy table to STDOUT:\n";
 
-$i   = 1;
 $ret = 0;
+$i   = 1;
 while (-1 != $ret) {
     $ret = $conn->getline($string, 256);
     last if $string eq "\\.";
-    cmp_eq("$i	Edmund Mergl    ", $string);
+    print "  ", $string, "\n";
     $i ++;
 }
 
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage unless 0 == $conn->endcopy;
 
-######################### delete and copy from stdin, PQputline
-# 27-33
+######################### delete and copy from stdin, putline
 
 $result = $conn->exec("BEGIN");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
 $result = $conn->exec("DELETE FROM person");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("DELETE 5", $result->cmdStatus);
-cmp_eq("5", $result->cmdTuples);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "delete from table, command status = ", $result->cmdStatus, ", no. of tuples = ", $result->cmdTuples, "\n";
 
 $result = $conn->exec("COPY person FROM STDIN");
-cmp_eq(PGRES_COPY_IN, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus;
+print "copy table from STDIN: ";
 
 for ($i = 1; $i <= 5; $i++) {
     # watch the tabs and do not forget the newlines
@@ -169,47 +171,32 @@ for ($i = 1; $i <= 5; $i++) {
 }
 $conn->putline("\\.\n");
 
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage unless 0 == $conn->endcopy;
 
 $result = $conn->exec("END");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "ok\n";
 
-######################### select from person, PQgetvalue
-# 34-47
+######################### select from person, getvalue
 
 $result = $conn->exec("SELECT * FROM person");
-cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
+print "select from table:\n";
 
 for ($k = 0; $k < $result->nfields; $k++) {
-    $fname = $result->fname($k);
-    $ftype = $result->ftype($k);
-    $fsize = $result->fsize($k);
-    if (0 == $k) {
-        cmp_eq("id", $fname);
-        cmp_eq(23, $ftype);
-        cmp_eq(4, $fsize);
-    } else {
-        cmp_eq("name", $fname);
-        cmp_eq(1042, $ftype);
-        cmp_eq(-1, $fsize);
-    }
-    $fnumber = $result->fnumber($fname);
-    cmp_eq($k, $fnumber);
+    print "  field = ", $k, "\tfname = ", $result->fname($k), "\tftype = ", $result->ftype($k), "\tfsize = ", $result->fsize($k), "\tfnumber = ", $result->fnumber($result->fname($k)), "\n";
 }
 
-$string = "";
 while (@row = $result->fetchrow) {
-    $string = join(" ", @row);
+    print " ", join(" ", @row), "\n";
 }
-cmp_eq("5 Edmund Mergl    ", $string);
 
-######################### PQnotifies
-# 43-46
+######################### notifies
 
 if (! defined($pid = fork)) {
     die "can not fork: $!";
 } elsif (! $pid) {
-    # i'm the child
+    # I'm the child
     sleep 2;
     bless $conn;
     $conn = Pg::connectdb("dbname=$dbname");
@@ -218,102 +205,70 @@ if (! defined($pid = fork)) {
 }
 
 $result = $conn->exec("LISTEN person");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("LISTEN", $result->cmdStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "listen table: status = ", $result->cmdStatus, "\n";
 
 while (1) {
-    $result = $conn->exec(" ");
+    $conn->consumeInput;
     ($table, $pid) = $conn->notifies;
     last if $pid;
 }
+print "got notification: table = ", $table, "  pid = ", $pid, "\n";
 
-cmp_eq("person", $table);
+######################### print
 
-######################### PQprint
-# 47-48
+$result = $conn->exec("SELECT * FROM person");
+die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
+print "select from table and print:\n";
+$result->print(STDOUT, 0, 0, 0, 0, 0, 0, " ", "", "", "");
 
-$result = $conn->exec("SELECT name FROM person WHERE id = 2");
-cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
-open(PRINT, "| read IN; read IN; if [ \"\$IN\" = \"myName Edmund Mergl\" ]; then echo \"ok $cnt\"; else echo \"not ok $cnt\"; fi ") || die "can not fork: $|";
-$cnt ++;
-$result->print(PRINT, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
-close(PRINT) || die "bad PRINT: $!";
+######################### lo_import, lo_export, lo_unlink
 
-######################### PQlo_import, PQlo_export, PQlo_unlink
-# 49-54
+$lobject_in  = '/tmp/gaga.in';
+$lobject_out = '/tmp/gaga.out';
 
-$filename = 'ApachePg.pl';
-$cwd = `pwd`;
-chop $cwd;
+$data = "testing large objects using lo_import and lo_export";
+open(FD, ">$lobject_in") or die "can not open $lobject_in";
+print(FD $data);
+close(FD);
 
 $result = $conn->exec("BEGIN");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
-$lobjOid = $conn->lo_import("$cwd/$filename");
-cmp_ne(0, $lobjOid);
+$lobjOid = $conn->lo_import("$lobject_in") or die $conn->errorMessage;
+print "importing file as large object, Oid = ", $lobjOid, "\n";
 
-cmp_ne(-1, $conn->lo_export($lobjOid, "/tmp/$filename"));
-
-cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+die $conn->errorMessage unless 1 == $conn->lo_export($lobjOid, "$lobject_out");
+print "exporting large object as temporary file\n";
 
 $result = $conn->exec("END");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+
+print "comparing imported file with exported file: ";
+print "not " unless (-s "$lobject_in" == -s "$lobject_out");
+print "ok\n";
 
-cmp_ne(-1, $conn->lo_unlink($lobjOid));
-unlink "/tmp/$filename";
+die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid);
+unlink $lobject_in;
+unlink $lobject_out;
+print "unlink large object\n";
 
-######################### debug, PQuntrace
+######################### debug, untrace
 
 if ($DEBUG) {
     close(TRACE) || die "bad TRACE: $!";
     $conn->untrace;
+    print "tracing disabled\n";
 }
 
 ######################### disconnect and drop test database
-# 55-56
 
 $conn = Pg::connectdb("dbname=$dbmain");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
+print "connected to $dbmain\n";
 
 $result = $conn->exec("DROP DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-
-######################### hopefully
-
-print "test sequence finished.\n" if 62 == $cnt;
-
-######################### utility functions
-
-sub cmp_eq {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" eq "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = $conn->errorMessage;
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
-
-sub cmp_ne {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" ne "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = $conn->errorMessage;
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "drop database\n";
 
 ######################### EOF
diff --git a/src/interfaces/perl5/eg/example.oldstyle b/src/interfaces/perl5/eg/example.oldstyle
index a4771a0c78..95ed3afd97 100644
--- a/src/interfaces/perl5/eg/example.oldstyle
+++ b/src/interfaces/perl5/eg/example.oldstyle
@@ -1,48 +1,33 @@
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl
 
-#-------------------------------------------------------
-#
-# $Id: example.oldstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
-#
-# Copyright (c) 1997, 1998  Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: example.oldstyle,v 1.6 1998/09/27 19:12:35 mergl Exp $
 
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+######################### globals
 
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; print "1..60\n"; }
-END {print "not ok 1\n" unless $loaded;}
+$| = 1;
 use Pg;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
 
 $dbmain = 'template1';
 $dbname = 'pgperltest';
 $trace  = '/tmp/pgtrace.out';
-$cnt    = 2;
 $DEBUG  = 0; # set this to 1 for traces
 
-$| = 1;
-
 ######################### the following functions will be tested
 
 #	PQsetdb()
 #	PQdb()
+#	PQuser()
 #	PQport()
-#	PQfinish()
 #	PQstatus()
+#	PQfinish()
 #	PQerrorMessage()
 #	PQtrace()
 #	PQuntrace()
 #	PQexec()
+#	PQconsumeInput
 #	PQgetline()
-#	PQendcopy()
 #	PQputline()
+#	PQendcopy()
 #	PQresultStatus()
 #	PQntuples()
 #	PQnfields()
@@ -65,10 +50,22 @@ $| = 1;
 
 #	PQconnectdb()
 #	PQconndefaults()
+#	PQsetdbLogin()
 #	PQreset()
-#	PQoptions()
+#	PQrequestCancel()
+#	PQpass()
 #	PQhost()
 #	PQtty()
+#	PQoptions()
+#	PQsocket()
+#	PQbackendPID()
+#	PQsendQuery()
+#	PQgetResult()
+#	PQisBusy()
+#	PQgetlineAsync()
+#	PQputnbytes()
+#	PQmakeEmptyPGresult()
+#	PQfmod()
 #	PQgetlength()
 #	PQgetisnull()
 #	PQdisplayTuples()
@@ -86,91 +83,91 @@ $| = 1;
 $SIG{PIPE} = sub { print "broken pipe\n" };
 
 ######################### create and connect to test database
-# 2-4
 
 $conn = PQsetdb('', '', '', '', $dbmain);
-cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
+print "connected to $dbmain\n";
 
-# might fail if $dbname doesn't exist => don't check resultStatus
+# do not complain when dropping $dbname
 $result = PQexec($conn, "DROP DATABASE $dbname");
 PQclear($result);
 
 $result = PQexec($conn, "CREATE DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "created database $dbname\n";
 PQclear($result);
 
 PQfinish($conn);
 
 $conn = PQsetdb('', '', '', '', $dbname);
-cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
+print "connected to $dbname\n";
 
 ######################### debug, PQtrace
 
 if ($DEBUG) {
     open(TRACE, ">$trace") || die "can not open $trace: $!";
     PQtrace($conn, TRACE);
+    print "enabled tracing into $trace\n";
 }
 
 ######################### check PGconn
-# 5-7
 
 $db = PQdb($conn);
-cmp_eq($dbname, $db);
+print "  database: $db\n";
 
 $user = PQuser($conn);
-cmp_ne("", $user);
+print "  user:     $user\n";
 
 $port = PQport($conn);
-cmp_ne("", $port);
+print "  port:     $port\n";
 
 ######################### create and insert into table
-# 8-19
 
 $result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("CREATE", PQcmdStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "created table, status = ", PQcmdStatus($result), "\n";
 PQclear($result);
 
 for ($i = 1; $i <= 5; $i++) {
     $result = PQexec($conn, "INSERT INTO person VALUES ($i, 'Edmund Mergl')");
-    cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-    cmp_ne(0, PQoidStatus($result));
+    die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
     PQclear($result);
 }
+print "insert into table, last oid = ", PQoidStatus($result), "\n";
 
 ######################### copy to stdout, PQgetline
-# 20-26
 
 $result = PQexec($conn, "COPY person TO STDOUT");
-cmp_eq(PGRES_COPY_OUT, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COPY_OUT eq PQresultStatus($result);
+print "copy table to STDOUT:\n";
 PQclear($result);
 
-$i   = 1;
 $ret = 0;
+$i   = 1;
 while (-1 != $ret) {
     $ret = PQgetline($conn, $string, 256);
     last if $string eq "\\.";
-    cmp_eq("$i	Edmund Mergl    ", $string);
+    print "  ", $string, "\n";
     $i++;
 }
 
-cmp_eq(0, PQendcopy($conn));
+die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
 
 ######################### delete and copy from stdin, PQputline
-# 27-33
 
 $result = PQexec($conn, "BEGIN");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
 PQclear($result);
 
 $result = PQexec($conn, "DELETE FROM person");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("DELETE 5", PQcmdStatus($result));
-cmp_eq("5", PQcmdTuples($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "delete from table, command status = ", PQcmdStatus($result), ", no. of tuples = ", PQcmdTuples($result), "\n";
 PQclear($result);
 
 $result = PQexec($conn, "COPY person FROM STDIN");
-cmp_eq(PGRES_COPY_IN, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COPY_IN eq PQresultStatus($result);
+print "copy table from STDIN:\n";
 PQclear($result);
 
 for ($i = 1; $i <= 5; $i++) {
@@ -179,53 +176,37 @@ for ($i = 1; $i <= 5; $i++) {
 }
 PQputline($conn, "\\.\n");
 
-cmp_eq(0, PQendcopy($conn));
+die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
 
 $result = PQexec($conn, "END");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
 PQclear($result);
 
 ######################### select from person, PQgetvalue
-# 34-47
 
 $result = PQexec($conn, "SELECT * FROM person");
-cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result);
+print "select from table:\n";
 
 for ($k = 0; $k < PQnfields($result); $k++) {
-    $fname = PQfname($result, $k);
-    $ftype = PQftype($result, $k);
-    $fsize = PQfsize($result, $k);
-    if (0 == $k) {
-        cmp_eq("id", $fname);
-        cmp_eq(23, $ftype);
-        cmp_eq(4, $fsize);
-    } else { 
-        cmp_eq("name", $fname);
-        cmp_eq(1042, $ftype);
-        cmp_eq(-1, $fsize);
-    }
-    $fnumber = PQfnumber($result, $fname);
-    cmp_eq($k, $fnumber);
+    print "  field = ", $k, "\tfname = ", PQfname($result, $k), "\tftype = ", PQftype($result, $k), "\tfsize = ", PQfsize($result, $k), "\tfnumber = ", PQfnumber($result, PQfname($result, $k)), "\n";
 }
 
 for ($k = 0; $k < PQntuples($result); $k++) {
-    $string = "";
     for ($l = 0; $l < PQnfields($result); $l++) {
-        $string .= PQgetvalue($result, $k, $l) . " ";
+        print " ", PQgetvalue($result, $k, $l);
     }
-    $i = $k + 1;
-    cmp_eq("$i Edmund Mergl     ", $string);
+    print "\n";
 }
 
 PQclear($result);
 
 ######################### PQnotifies
-# 48-50
 
 if (! defined($pid = fork)) {
     die "can not fork: $!";
 } elsif (! $pid) {
-    # i'm the child
+    # I'm the child
     sleep 2;
     $conn = PQsetdb('', '', '', '', $dbname);
     $result = PQexec($conn, "NOTIFY person");
@@ -235,112 +216,79 @@ if (! defined($pid = fork)) {
 }
 
 $result = PQexec($conn, "LISTEN person");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("LISTEN", PQcmdStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "listen table: status = ", PQcmdStatus($result), "\n";
 PQclear($result);
 
 while (1) {
-    $result = PQexec($conn, " ");
+    PQconsumeInput($conn);
     ($table, $pid) = PQnotifies($conn);
-    PQclear($result);
     last if $pid;
 }
-
-cmp_eq("person", $table);
+print "got notification: table = ", $table, "  pid = ", $pid, "\n";
 
 ######################### PQprint
-# 51-52
 
-$result = PQexec($conn, "SELECT name FROM person WHERE id = 2");
-cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
-open(PRINT, "| read IN; read IN; if [ \"\$IN\" = \"myName Edmund Mergl\" ]; then echo \"ok $cnt\"; else echo \"not ok $cnt\"; fi ") || die "can not fork: $|";
-$cnt ++;
-PQprint(PRINT, $result, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
+$result = PQexec($conn, "SELECT * FROM person");
+die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result);
+print "select from table and print:\n";
+PQprint(STDOUT, $result, 0, 0, 0, 0, 0, 0, " ", "", "", "");
 PQclear($result);
-close(PRINT) || die "bad PRINT: $!";
 
 ######################### PQlo_import, PQlo_export, PQlo_unlink
-# 53-59
 
-$filename = 'ApachePg.pl';
-$cwd = `pwd`;
-chop $cwd;
+$lobject_in  = '/tmp/gaga.in';
+$lobject_out = '/tmp/gaga.out';
+
+$data = "testing large objects using lo_import and lo_export";
+open(FD, ">$lobject_in") or die "can not open $lobject_in";
+print(FD $data);
+close(FD);
 
 $result = PQexec($conn, "BEGIN");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
 PQclear($result);
 
-$lobjOid = PQlo_import($conn, "$cwd/$filename");
-cmp_ne( 0, $lobjOid);
-
-cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename"));
+$lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn);
+print "importing file as large object, Oid = ", $lobjOid, "\n";
 
-cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+die PQerrorMessage($conn) unless 1 == PQlo_export($conn, $lobjOid, "$lobject_out");
+print "exporting large object as temporary file\n";
 
 $result = PQexec($conn, "END");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
 PQclear($result);
 
-cmp_ne(-1, PQlo_unlink($conn, $lobjOid));
-unlink "/tmp/$filename";
+print "comparing imported file with exported file: ";
+print "not " unless (-s "$lobject_in" == -s "$lobject_out");
+print "ok\n";
+
+die PQerrorMessage($conn) if -1 == PQlo_unlink($conn, $lobjOid);
+unlink $lobject_in;
+unlink $lobject_out;
+print "unlink large object\n";
 
 ######################### debug, PQuntrace
 
 if ($DEBUG) {
     close(TRACE) || die "bad TRACE: $!";
     PQuntrace($conn);
+    print "tracing disabled\n";
 }
 
 ######################### disconnect and drop test database
-# 59-60
 
 PQfinish($conn);
 
 $conn = PQsetdb('', '', '', '', $dbmain);
-cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
+print "connected to $dbmain\n";
 
 $result = PQexec($conn, "DROP DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "drop database\n";
 PQclear($result);
 
 PQfinish($conn);
 
-######################### hopefully
-
-print "test sequence finished.\n" if 62 == $cnt;
-
-######################### utility functions
-
-sub cmp_eq {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" eq "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = PQerrorMessage($conn);
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
-
-sub cmp_ne {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" ne "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = PQerrorMessage($conn);
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
-
 ######################### EOF
diff --git a/src/interfaces/perl5/test.pl b/src/interfaces/perl5/test.pl
index 009bd138ef..6d4b5a31ed 100644
--- a/src/interfaces/perl5/test.pl
+++ b/src/interfaces/perl5/test.pl
@@ -1,52 +1,43 @@
 #!/usr/local/bin/perl -w
 
-#-------------------------------------------------------
-#
-# $Id: test.pl,v 1.8 1998/06/01 16:41:20 mergl Exp $
-#
-# Copyright (c) 1997, 1998  Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: test.pl,v 1.9 1998/09/27 19:12:26 mergl Exp $
 
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
 ######################### We start with some black magic to print on failure.
 
-BEGIN { $| = 1; print "1..45\n"; }
-END {print "not ok 1\n" unless $loaded;}
+BEGIN { $| = 1; }
+END {print "test failed\n" unless $loaded;}
 use Pg;
 $loaded = 1;
-print "ok 1\n";
+use strict;
 
 ######################### End of black magic.
 
-$dbmain = 'template1';
-$dbname = 'pgperltest';
-$trace  = '/tmp/pgtrace.out';
-$cnt    = 2;
-$DEBUG  = 0; # set this to 1 for traces
+my $dbmain = 'template1';
+my $dbname = 'pgperltest';
+my $trace  = '/tmp/pgtrace.out';
+my ($conn, $result, $i);
 
-$| = 1;
+my $DEBUG  = 0; # set this to 1 for traces
 
 ######################### the following methods will be tested
 
 #	connectdb
+#	conndefaults
 #	db
 #	user
 #	port
-#	finish
 #	status
 #	errorMessage
 #	trace
 #	untrace
 #	exec
 #	getline
-#	endcopy
 #	putline
+#	endcopy
 #	resultStatus
-#	ntuples
-#	nfields
 #	fname
 #	fnumber
 #	ftype
@@ -54,20 +45,36 @@ $| = 1;
 #	cmdStatus
 #	oidStatus
 #	cmdTuples
-#	getvalue
+#	fetchrow
 
 ######################### the following methods will not be tested
 
 #	setdb
-#	conndefaults
+#	setdbLogin
 #	reset
-#	options
+#	requestCancel
+#	pass
 #	host
 #	tty
+#	options
+#	socket
+#	backendPID
+#	notifies
+#	sendQuery
+#	getResult
+#	isBusy
+#	consumeInput
+#	getlineAsync
+#	putnbytes
+#	makeEmptyPGresult
+#	ntuples
+#	nfields
+#	binaryTuples
+#	fmod
+#	getvalue
 #	getlength
 #	getisnull
 #	print
-#	notifies
 #	displayTuples
 #	printTuples
 #	lo_import
@@ -86,82 +93,114 @@ $| = 1;
 $SIG{PIPE} = sub { print "broken pipe\n" };
 
 ######################### create and connect to test database
-# 2-4
+
+my $Option_ref = Pg::conndefaults();
+my ($key, $val);
+( $$Option_ref{port} ne "" && $$Option_ref{dbname} ne "" && $$Option_ref{user} ne "" )
+    and print "Pg::conndefaults ........ ok\n"
+    or  die   "Pg::conndefaults ........ not ok: ", $conn->errorMessage;
 
 $conn = Pg::connectdb("dbname=$dbmain");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+( PGRES_CONNECTION_OK eq $conn->status )
+    and print "Pg::connectdb ........... ok\n"
+    or  die   "Pg::connectdb ........... not ok: ", $conn->errorMessage;
 
-# might fail if $dbname doesn't exist => don't check resultStatus
-$result = $conn->exec("DROP DATABASE $dbname");
+# do not complain when dropping $dbname
+$conn->exec("DROP DATABASE $dbname");
 
 $result = $conn->exec("CREATE DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+( PGRES_COMMAND_OK eq $result->resultStatus )
+    and print "\$conn->exec ............. ok\n"
+    or  die   "\$conn->exec ............. not ok: ", $conn->errorMessage;
+
+$conn = Pg::connectdb("dbname=rumpumpel");
+( $conn->errorMessage =~ 'Database rumpumpel does not exist' )
+    and print "\$conn->errorMessage ..... ok\n"
+    or  die   "\$conn->errorMessage ..... not ok: ", $conn->errorMessage;
 
 $conn = Pg::connectdb("dbname=$dbname");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
 
 ######################### debug, PQtrace
 
 if ($DEBUG) {
-    open(TRACE, ">$trace") || die "can not open $trace: $!";
-    $conn->trace(TRACE);
+    open(FD, ">$trace") || die "can not open $trace: $!";
+    $conn->trace("FD");
 }
 
 ######################### check PGconn
-# 5-7
 
-$db = $conn->db;
-cmp_eq($dbname, $db);
+my $db = $conn->db;
+( $dbname eq $db )
+    and print "\$conn->db ............... ok\n"
+    or  print "\$conn->db ............... not ok: $db\n";
 
-$user = $conn->user;
-cmp_ne("", $user);
+my $user = $conn->user;
+( "" ne $user )
+    and print "\$conn->user ............. ok\n"
+    or  print "\$conn->user ............. not ok: $user\n";
 
-$port = $conn->port;
-cmp_ne("", $port);
+my $port = $conn->port;
+( "" ne $port )
+    and print "\$conn->port ............. ok\n"
+    or  print "\$conn->port ............. not ok: $port\n";
 
 ######################### create and insert into table
-# 8-19
 
 $result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("CREATE", $result->cmdStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+my $cmd = $result->cmdStatus;
+( "CREATE" eq $cmd )
+    and print "\$conn->cmdStatus ........ ok\n"
+    or  print "\$conn->cmdStatus ........ not ok: $cmd\n";
 
 for ($i = 1; $i <= 5; $i++) {
     $result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
-    cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-    cmp_ne(0, $result->oidStatus);
+    die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 }
+my $oid = $result->oidStatus;
+( 0 != $oid )
+    and print "\$conn->oidStatus ........ ok\n"
+    or  print "\$conn->oidStatus ........ not ok: $oid\n";
 
 ######################### copy to stdout, PQgetline
-# 20-26
 
 $result = $conn->exec("COPY person TO STDOUT");
-cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
 
-$i   = 1;
-$ret = 0;
+my $ret = 0;
+my $buf;
+my $string;
+$i = 1;
 while (-1 != $ret) {
-    $ret = $conn->getline($string, 256);
-    last if $string eq "\\.";
-    cmp_eq("$i	Edmund Mergl    ", $string);
+    $ret = $conn->getline($buf, 256);
+    last if $buf eq "\\.";
+    $string = $buf if 1 == $i;
     $i++;
 }
+( "1	Edmund Mergl    " eq $string )
+    and print "\$conn->getline .......... ok\n"
+    or  print "\$conn->getline .......... not ok: $string\n";
 
-cmp_eq(0, $conn->endcopy);
+$ret = $conn->endcopy;
+( 0 == $ret )
+    and print "\$conn->endcopy .......... ok\n"
+    or  print "\$conn->endcopy .......... not ok: $ret\n";
 
 ######################### delete and copy from stdin, PQputline
-# 27-33
 
 $result = $conn->exec("BEGIN");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
 $result = $conn->exec("DELETE FROM person");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("DELETE 5", $result->cmdStatus);
-cmp_eq("5", $result->cmdTuples);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+$ret = $result->cmdTuples;
+( 5 == $ret )
+    and print "\$result->cmdTuples ...... ok\n"
+    or  print "\$result->cmdTuples ...... not ok: $ret\n";
 
 $result = $conn->exec("COPY person FROM STDIN");
-cmp_eq(PGRES_COPY_IN, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus;
 
 for ($i = 1; $i <= 5; $i++) {
     # watch the tabs and do not forget the newlines
@@ -169,92 +208,60 @@ for ($i = 1; $i <= 5; $i++) {
 }
 $conn->putline("\\.\n");
 
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage if $conn->endcopy;
 
 $result = $conn->exec("END");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
 ######################### select from person, PQgetvalue
-# 34-43
 
 $result = $conn->exec("SELECT * FROM person");
-cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
-
-for ($k = 0; $k < $result->nfields; $k++) {
-    $fname = $result->fname($k);
-    $ftype = $result->ftype($k);
-    $fsize = $result->fsize($k);
-    if (0 == $k) {
-        cmp_eq("id", $fname);
-        cmp_eq(23, $ftype);
-        cmp_eq(4, $fsize);
-    } else {
-        cmp_eq("name", $fname);
-        cmp_eq(1042, $ftype);
-        cmp_eq(-1, $fsize);
-    }
-    $fnumber = $result->fnumber($fname);
-    cmp_eq($k, $fnumber);
-}
+die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
+
+my $fname = $result->fname(0);
+( "id" eq $fname )
+    and print "\$result->fname .......... ok\n"
+    or  print "\$result->fname .......... not ok: $fname\n";
+
+my $ftype = $result->ftype(0);
+( 23 == $ftype )
+    and print "\$result->ftype .......... ok\n"
+    or  print "\$result->ftype .......... not ok: $ftype\n";
+
+my $fsize = $result->fsize(0);
+( 4 == $fsize )
+    and print "\$result->fsize .......... ok\n"
+    or  print "\$result->fsize .......... not ok: $fsize\n";
+
+my $fnumber = $result->fnumber($fname);
+( 0 == $fnumber )
+    and print "\$result->fnumber ........ ok\n"
+    or  print "\$result->fnumber ........ not ok: $fnumber\n";
 
 $string = "";
+my @row;
 while (@row = $result->fetchrow) {
     $string = join(" ", @row);
 }
-cmp_eq("5 Edmund Mergl    ", $string);
+( "5 Edmund Mergl    " eq $string )
+    and print "\$result->fetchrow ....... ok\n"
+    or  print "\$result->fetchrow ....... not ok: $string\n";
 
 ######################### debug, PQuntrace
 
 if ($DEBUG) {
-    close(TRACE) || die "bad TRACE: $!";
+    close(FD) || die "bad TRACE: $!";
     $conn->untrace;
 }
 
 ######################### disconnect and drop test database
-# 44-45
 
 $conn = Pg::connectdb("dbname=$dbmain");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
 
 $result = $conn->exec("DROP DATABASE $dbname");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-
-######################### hopefully
-
-print "test sequence finished.\n" if 51 == $cnt;
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
-######################### utility functions
-
-sub cmp_eq {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" eq "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = $conn->errorMessage;
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
-
-sub cmp_ne {
-
-    my $cmp = shift;
-    my $ret = shift;
-    my $msg;
-
-    if ("$cmp" ne "$ret") {
-	print "ok $cnt\n";
-    } else {
-        $msg = $conn->errorMessage;
-	print "not ok $cnt: $cmp, $ret\n$msg\n";
-        exit;
-    }
-    $cnt++;
-}
+print "test sequence finished.\n";
 
 ######################### EOF
diff --git a/src/interfaces/perl5/typemap b/src/interfaces/perl5/typemap
index 2fa20093fa..e42d6c2a3b 100644
--- a/src/interfaces/perl5/typemap
+++ b/src/interfaces/perl5/typemap
@@ -1,6 +1,6 @@
 #-------------------------------------------------------
 #
-# $Id: typemap,v 1.7 1998/06/01 16:41:20 mergl Exp $
+# $Id: typemap,v 1.8 1998/09/27 19:12:27 mergl Exp $
 #
 # Copyright (c) 1997, 1998  Edmund Mergl
 #
@@ -15,5 +15,4 @@ PG_results	T_PTROBJ
 ConnStatusType	T_IV
 ExecStatusType	T_IV
 Oid		T_IV
-int2		T_IV
-bool		T_IV
+pqbool		T_IV
-- 
2.40.0