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               | 322 +++++++++----
 src/interfaces/perl5/Pg.xs               | 588 ++++++++++++++++-------
 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             | 247 +++++-----
 src/interfaces/perl5/typemap             |   5 +-
 10 files changed, 989 insertions(+), 728 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
-	PQgetline
-	PQendcopy
-	PQputline
 	PQnotifies
+	PQsendQuery
+	PQgetResult
+	PQisBusy
+	PQconsumeInput
+	PQgetline
+	PQputline
+	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,14 +329,14 @@ Returns the database name of the connection.
 
 Returns the Postgres user name of the connection.
 
+    $pguser = $conn->pass
+
+Returns the Postgres password of the connection.
+
     $pghost = $conn->host
 
 Returns the host name of the connection.
 
-    $pgoptions = $conn->options
-
-Returns the options used in the connection.
-
     $pgport = $conn->port
 
 Returns the port of the connection.
@@ -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,28 +390,6 @@ structure has to be freed using PQfree. Before using $result you
 should call resultStatus to ensure, that the query was 
 properly executed. 
 
-    $ret = $conn->getline($string, $length)
-
-Reads a string up to $length - 1 characters from the backend. 
-getline returns EOF at EOF, 0 if the entire line has been read, 
-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)
-
-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->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. 
-
     ($table, $pid) = $conn->notifies
 
 Checks for asynchronous notifications. This functions differs from 
@@ -368,6 +398,69 @@ 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. 
+getline returns EOF at EOF, 0 if the entire line has been read, 
+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. 
+
+    $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, 1 on failure. 
+
+    $result = $conn->makeEmptyPGresult($status);
+
+Returns a newly allocated, initialized result with given status. 
+
+
 =head2 2. Result
 
 With these functions you can send commands to a database and
@@ -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)
+    $fmod = $result->fmod($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. 
-
-    $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,19 +224,15 @@ PQconnectdb(conninfo)
 		RETVAL
 
 
-HV *
-PQconndefaults()
-	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++;
-			}
-		}
-	OUTPUT:
-		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 *
@@ -250,6 +244,25 @@ PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
 	char *	dbname
 
 
+HV *
+PQconndefaults()
+	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
+
+
 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,37 +350,13 @@ 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
 
 
-int
-PQgetline(conn, string, length)
-	PREINIT:
-		SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
-	INPUT:
-		PGconn *	conn
-		int	length
-		char *	string = sv_grow(sv_buffer, length);
-	CODE:
-		RETVAL = PQgetline(conn, string, length);
-	OUTPUT:
-		RETVAL
-		string
-
-
-int
-PQendcopy(conn)
-	PGconn *	conn
-
-
-void
-PQputline(conn, string)
-	PGconn *	conn
-	char *	string
-
-
 void
 PQnotifies(conn)
 	PGconn *	conn
@@ -363,6 +371,88 @@ PQnotifies(conn)
 		}
 
 
+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 *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+	INPUT:
+		PGconn *	conn
+		int	length
+		char *	string = sv_grow(bufsv, length);
+	CODE:
+		RETVAL = PQgetline(conn, string, length);
+	OUTPUT:
+		RETVAL
+		string
+
+
+int
+PQputline(conn, string)
+	PGconn *	conn
+	char *	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 *	buffer
+	int	nbytes
+
+
+int
+PQendcopy(conn)
+	PGconn *	conn
+
+
+PGresult *
+PQmakeEmptyPGresult(conn, status)
+	PGconn *	conn
+	ExecStatusType	status
+
+
 ExecStatusType
 PQresultStatus(res)
 	PGresult *	res
@@ -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,39 +891,13 @@ 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
 
 
-int
-PQgetline(conn, string, length)
-	PREINIT:
-		SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
-	INPUT:
-		PG_conn	conn
-		int	length
-		char *	string = sv_grow(sv_buffer, length);
-	CODE:
-		RETVAL = PQgetline(conn, string, length);
-	OUTPUT:
-		RETVAL
-		string
-
-
-int
-PQendcopy(conn)
-	PG_conn	conn
-
-
-void
-PQputline(conn, string)
-	PG_conn	conn
-	char *	string
-
-
 void
 PQnotifies(conn)
 	PG_conn	conn
@@ -799,6 +912,94 @@ PQnotifies(conn)
 		}
 
 
+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 *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+	INPUT:
+		PG_conn	conn
+		int	length
+		char *	string = sv_grow(bufsv, length);
+	CODE:
+		RETVAL = PQgetline(conn, string, length);
+	OUTPUT:
+		RETVAL
+		string
+
+
+int
+PQputline(conn, string)
+	PG_conn	conn
+	char *	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
+
+
+PG_results
+PQmakeEmptyPGresult(conn, status)
+	PG_conn	conn
+	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
 lo_open(conn, lobjId, mode)
 	PG_conn	conn
@@ -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)
+PQfetchrow(res)
 	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)
-	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;
 
-cmp_ne(-1, $conn->lo_unlink($lobjOid));
-unlink "/tmp/$filename";
+print "comparing imported file with exported file: ";
+print "not " unless (-s "$lobject_in" == -s "$lobject_out");
+print "ok\n";
 
-######################### debug, PQuntrace
+die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid);
+unlink $lobject_in;
+unlink $lobject_out;
+print "unlink large object\n";
+
+######################### 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);
+$lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn);
+print "importing file as large object, Oid = ", $lobjOid, "\n";
 
-cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename"));
-
-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);
+die $conn->errorMessage unless PGRES_TUPLES_OK eq $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);
-}
+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);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
 
-######################### hopefully
-
-print "test sequence finished.\n" if 51 == $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++;
-}
+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