--- /dev/null
+#!/usr/local/bin/perl
+
+# demo script, has been tested with:
+# - Postgres-6.1
+# - apache_1.2b8
+# - mod_perl-0.97
+# - perl5.003_93
+
+use CGI::Apache;
+use Pg;
+use strict;
+
+my $query = new CGI;
+
+print $query->header,
+ $query->start_html(-title=>'A Simple Example'),
+ $query->startform,
+ "<CENTER><H3>Testing Module Pg</H3></CENTER>",
+ "Enter the database name: ",
+ $query->textfield(-name=>'dbname'),
+ "<P>",
+ "Enter the select command: ",
+ $query->textfield(-name=>'cmd', -size=>40),
+ "<P>",
+ $query->submit(-value=>'Submit'),
+ $query->endform;
+
+if ($query->param) {
+
+ my $dbname = $query->param('dbname');
+ my $conn = Pg::connectdb("dbname = $dbname");
+ my $cmd = $query->param('cmd');
+ my $result = $conn->exec($cmd);
+ my $i, $j;
+ print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
+ for ($i=0; $i < $result->ntuples; $i++) {
+ print "<TR>\n";
+ for ($j=0; $j < $result->nfields; $j++) {
+ print "<TD ALIGN=CENTER>", $result->getvalue($i, $j), "\n";
+ }
+ }
+
+ print "</TABLE></CENTER><P>\n";
+}
+
+print $query->end_html;
+
--- /dev/null
+Revision history for Perl extension Pg.
+
+1.0 Mar 24, 1995
+ - creation
+
+1.1 Jun 6, 1995
+ - Bug fix in PQgetline.
+
+1.1.1 Aug 5, 95
+ - adapted to postgres95-beta0.03
+ - Note: the libpq interface has changed completely !
+
+1.2.0 Oct 15, 1995
+ - adapted to Postgres95-1.0
+ - README updated
+ - doQuery() in Pg.pm now returns 0 upon success
+ - testlibpq.pl: added test for PQgetline()
+
+1.3.1 Oct 22, 1996
+ - adapted to Postgres95-1.08
+ - large-object interface added, thanks to
+ Sven Verdoolaege (skimo@breughel.ufsia.ac.be)
+ - PQgetline() changed. This breaks old scripts !
+ - PQexec now returns in any case a valid pointer.
+ This fixes the annoying message:
+ 'res is not of type PGresultPtr at ...'
+ - testsuite completely rewritten, contains
+ now examples for almost all functions
+ - resturn codes are now available as constants (PGRES_xxx)
+ - PQnotifies() works now
+ - enhanced doQuery()
+
+1.3.2 Nov 11, 1996
+ - adapted to Postgres95-1.09
+ - test.pl adapted to postgres95-1.0.9:
+ PQputline expects now '\.' as last input
+ and PQgetline outputs '\.' as last line.
+
+
+1.4.2 Nov 21, 1996
+ - added a more Perl-like syntax
+
+
+1.5.3 Jan 2, 1997
+ - adapted to PostgreSQL-6.0
+ - new functions PQconnectdb, PQuser
+ - changed name of method 'new' to 'setdb'
+
+
+1.5.4 Feb 12, 1997
+ - changed test.pl for large objects:
+ test only lo_import and lo_export
+
+1.6.0 Apr 29, 1997
+ - renamed to pgsql_perl5
+ - adapted to PostgreSQL-6.1
+ - test only functions, which are also
+ tested in pgsql regression tests
--- /dev/null
+ApachePg.pl
+Changes
+MANIFEST
+Makefile.PL
+Pg.pm
+Pg.xs
+README
+test.pl
+test.pl.newstyle
+test.pl.oldstyle
+typemap
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: Makefile.PL,v 1.1.1.1 1997/04/29 19:37:09 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+use ExtUtils::MakeMaker;
+
+print "\nConfiguring Pg\n";
+print "Remember to actually read the README file !\n";
+die "\nYou didn't read the README file !\n" unless ($] >= 5.003);
+
+if (! $ENV{POSTGRESHOME}) {
+ warn "\$POSTGRESHOME not defined. Searching for Postgres...\n";
+ foreach(qw(/usr/pgsql /usr/local/pgsql /usr/pgsql-6.1 /usr/local/pgsql-6.1)) {
+ if (-d "$_/lib") {
+ $ENV{POSTGRESHOME} = $_;
+ last;
+ }
+ }
+}
+
+if ($ENV{POSTGRESHOME}) {
+ print "\nFound Postgres in $ENV{POSTGRESHOME}\n";
+} else {
+ die "Unable to determine \$POSTGRESHOME !\n";
+}
+
+WriteMakefile(
+ 'NAME' => 'Pg',
+ 'VERSION_FROM' => 'Pg.pm',
+ 'LIBS' => ["-L$ENV{POSTGRESHOME}/lib -lpq"],
+ 'INC' => "-I$ENV{POSTGRESHOME}/include",
+);
+
+# EOF
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: Pg.pm,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+package Pg;
+
+use strict;
+use Carp;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
+
+require Exporter;
+require DynaLoader;
+require AutoLoader;
+require 5.003;
+
+@ISA = qw(Exporter DynaLoader);
+
+# Items to export into callers namespace by default.
+@EXPORT = qw(
+ PQconnectdb
+ PQconndefaults
+ PQsetdb
+ PQfinish
+ PQreset
+ PQdb
+ PQuser
+ PQhost
+ PQoptions
+ PQport
+ PQtty
+ PQstatus
+ PQerrorMessage
+ PQtrace
+ PQuntrace
+ PQexec
+ PQgetline
+ PQendcopy
+ PQputline
+ PQnotifies
+ PQresultStatus
+ PQntuples
+ PQnfields
+ PQfname
+ PQfnumber
+ PQftype
+ PQfsize
+ PQcmdStatus
+ PQoidStatus
+ PQgetvalue
+ PQgetlength
+ PQgetisnull
+ PQclear
+ PQprintTuples
+ PQprint
+ PQlo_open
+ PQlo_close
+ PQlo_read
+ PQlo_write
+ PQlo_lseek
+ PQlo_creat
+ PQlo_tell
+ PQlo_unlink
+ PQlo_import
+ PQlo_export
+ PGRES_CONNECTION_OK
+ PGRES_CONNECTION_BAD
+ PGRES_EMPTY_QUERY
+ PGRES_COMMAND_OK
+ PGRES_TUPLES_OK
+ PGRES_COPY_OUT
+ PGRES_COPY_IN
+ PGRES_BAD_RESPONSE
+ PGRES_NONFATAL_ERROR
+ PGRES_FATAL_ERROR
+ PGRES_INV_SMGRMASK
+ PGRES_INV_ARCHIVE
+ PGRES_INV_WRITE
+ PGRES_INV_READ
+ PGRES_InvalidOid
+);
+
+$VERSION = '1.6.0';
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my $constname;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+ if ($! =~ /Invalid/) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ croak "Your vendor has not defined Pg macro $constname";
+ }
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+bootstrap Pg $VERSION;
+
+sub doQuery {
+
+ my $conn = shift;
+ my $query = shift;
+ my $array_ref = shift;
+
+ my ($result, $status, $nfields, $ntuples, $i, $j);
+
+ $result = PQexec($conn, $query);
+ $status = PQresultStatus($result);
+ return($status) if (2 != $status);
+
+ $nfields = PQnfields($result);
+ $ntuples = PQntuples($result);
+ for ($i=0; $i < $ntuples; $i++) {
+ for ($j=0; $j < $nfields; $j++) {
+ $$array_ref[$i][$j] = PQgetvalue($result, $i, $j);
+ }
+ }
+
+ PQclear($result);
+
+ return 1;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Pg - Perl extension for PostgreSQL
+
+
+=head1 SYNOPSIS
+
+new style:
+
+ use Pg;
+ $conn = Pg::connectdb("dbname = template1");
+ $result = $conn->exec("create database test");
+
+
+you may also use the old style:
+
+ use Pg;
+ $conn = PQsetdb('', '', '', '', template1);
+ $result = PQexec($conn, "create database test");
+ PQclear($result);
+ PQfinish($conn);
+
+
+=head1 DESCRIPTION
+
+The Pg module permits you to access all functions of the
+Libpq interface of PostgreSQL. Libpq is the programmer's
+interface to PostgreSQL. Pg tries to resemble this
+interface as close as possible. For examples of how to
+use this module, look at the file test.pl. For further
+examples look at the Libpq applications in
+../src/test/examples and ../src/test/regress.
+
+You have the choice between the old C-style and a
+new, more Perl-ish style. The old style has the
+benefit, that existing Libpq applications can be
+ported to perl just by prepending every variable
+with a '$'. The new style uses class packages and
+might be more familiar for C++-programmers.
+
+
+=head1 GUIDELINES
+
+=head2 new style
+
+The new style uses blessed references as objects.
+After creating a new connection or result object,
+the relevant Libpq functions serve as virtual methods.
+One benefit of the new style: you do not have to care
+about freeing the connection- and result-structures.
+Perl calls the destructor whenever the last reference
+to an object goes away.
+
+=head2 old style
+
+All functions and constants are imported into the calling
+packages namespace. In order to to get a uniform naming,
+all functions start with 'PQ' (e.g. PQlo_open) and all
+constants start with 'PGRES_' (e.g. PGRES_CONNECTION_OK).
+
+There are two functions, which allocate memory, that has
+to be freed by the user:
+
+ PQsetdb, use PQfinish to free memory.
+ PQexec, use PQclear to free memory.
+
+
+Pg.pm contains one convenience function: doQuery. It fills a
+two-dimensional array with the result of your query. Usage:
+
+ Pg::doQuery($conn, "select attr1, attr2 from tbl", \@ary);
+
+ for $i ( 0 .. $#ary ) {
+ for $j ( 0 .. $#{$ary[$i]} ) {
+ print "$ary[$i][$j]\t";
+ }
+ print "\n";
+ }
+
+Notice the inner loop !
+
+
+=head1 CAVEATS
+
+There are few exceptions, where the perl-functions differs
+from the C-counterpart: PQprint, PQnotifies and PQconndefaults.
+These functions deal with structures, which have been
+implemented in perl using lists or hash.
+
+
+=head1 FUNCTIONS
+
+The functions have been divided into three sections:
+Connection, Result, Large Objects.
+
+
+=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.
+
+ $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
+hardcoded 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.
+
+ $conn = Pg::connectdb("option = value")
+
+Opens a new connection to the backend using connection information in a string.
+The connection identifier $conn ( a pointer to the PGconn structure ) must be
+used in subsequent commands for unique identification. Before using $conn you
+should call $conn->status to ensure, that the connection was properly made.
+Use the methods below to access the contents of the PGconn structure.
+
+ $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
+his C-counterpart, which returns the complete conninfoOption structure.
+
+ PQfinish($conn)
+
+Old style only !
+Closes the connection to the backend and frees all memory.
+
+ $conn->reset
+
+Resets the communication port with the backend and tries
+to establish a new connection.
+
+ $dbname = $conn->db
+
+Returns the database name of the connection.
+
+ $pguser = $conn->user
+
+Returns the Postgres user name 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.
+
+ $pgtty = $conn->tty
+
+Returns the tty of the connection.
+
+ $status = $conn->status
+
+Returns the status of the connection. For comparing the status
+you may use the following constants:
+
+ - PGRES_CONNECTION_OK
+ - PGRES_CONNECTION_BAD
+
+ $errorMessage = $conn->errorMessage
+
+Returns the last error message associated with this connection.
+
+ $conn->trace(debug_port)
+
+Messages passed between frontend and backend are echoed to the
+debug_port file stream.
+
+ $conn->untrace
+
+Disables tracing.
+
+ $result = $conn->exec($query)
+
+Submits a query to the backend. The return value is a pointer to
+the PGresult structure, which contains the complete query-result
+returned by the backend. In case of failure, the pointer points
+to an empty structure. In this, the perl implementation differs
+from the C-implementation. Using the old style, even the empty
+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
+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.
+
+
+=head2 2. Result
+
+With these functions you can send commands to a database and
+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.
+
+Use the functions below to access the contents of the PGresult structure.
+
+ $ntups = $result->ntuples
+
+Returns the number of tuples in the query result.
+
+ $nfields = $result->nfields
+
+Returns the number of fields in the query result.
+
+ $fname = $result->fname($field_num)
+
+Returns the field name associated with the given field number.
+
+ $fnumber = $result->fnumber($field_name)
+
+Returns the field number associated with the given field name.
+
+ $ftype = $result->ftype($field_num)
+
+Returns the oid of the type of the given field number.
+
+ $fsize = $result->fsize($field_num)
+
+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.
+
+ $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
+
+ $cmdStatus = $result->cmdStatus
+
+Returns the command status of the last query command.
+
+ $oid = $result->oidStatus
+
+In case the last query was an INSERT command it returns the oid of the
+inserted tuple.
+
+ $result->printTuples($fout, $printAttName, $terseOutput, $width)
+
+Kept for backward compatibility. Use print.
+
+ $result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...)
+
+Prints out all the tuples in an intelligent manner. This function
+differs from the C-counterpart. The struct PQprintOpt has been
+implemented with a list. This list is of variable length, in order
+to care for the character array fieldName in PQprintOpt.
+The arguments $header, $align, $standard, $html3, $expanded, $pager
+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)
+
+Old style only !
+Frees all memory of the given result.
+
+
+=head2 3. Large Objects
+
+These functions provide file-oriented access to user data.
+The large object interface is modeled after the Unix file
+system interface with analogues 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 bitmask 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.
+For the mode bits see lo_create. Returns -1 upon failure.
+
+ $ret = $conn->lo_close($lobj_fd)
+
+Closes an existing large object. Returns 0 upon success
+and -1 upon failure.
+
+ $nbytes = $conn->lo_read($lobj_fd, $buf, $len)
+
+Reads $len bytes into $buf from large object $lobj_fd.
+Returns the number of bytes read and -1 upon failure.
+
+ $nbytes = $conn->lo_write($lobj_fd, $buf, $len)
+
+Writes $len bytes of $buf into the large object $lobj_fd.
+Returns the number of bytes written and -1 upon failure.
+
+ $ret = $conn->lo_lseek($lobj_fd, $offset, $whence)
+
+Change the current read or write location on the large object
+$obj_id. Currently $whence can only be 0 (L_SET).
+
+ $location = $conn->lo_tell($lobj_fd)
+
+Returns the current read or write location on the large object
+$lobj_fd.
+
+ $lobjId = $conn->lo_import($filename)
+
+Imports a Unix file as large object and returns
+the object id of the new object.
+
+ $ret = $conn->lo_export($lobjId, $filename)
+
+Exports a large object into a Unix file.
+Returns -1 upon failure, 1 otherwise.
+
+
+=head1 AUTHOR
+
+ Edmund Mergl <E.Mergl@bawue.de>
+
+=head1 SEE ALSO
+
+libpq(3), large_objects(3).
+
+=cut
--- /dev/null
+/*-------------------------------------------------------
+ *
+ * $Id: Pg.xs,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+ *
+ * Copyright (c) 1997 Edmund Mergl
+ *
+ *-------------------------------------------------------*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef bool
+#undef bool
+#endif
+
+#ifdef DEBUG
+#undef DEBUG
+#endif
+
+#ifdef ABORT
+#undef ABORT
+#endif
+
+#include "postgres.h"
+#include "libpq-fe.h"
+
+typedef struct pg_conn* PG_conn;
+typedef struct pg_result* PG_result;
+
+static double
+constant(name, arg)
+char *name;
+int arg;
+{
+ errno = 0;
+ switch (*name) {
+ case 'A':
+ break;
+ case 'B':
+ break;
+ case 'C':
+ break;
+ case 'D':
+ break;
+ case 'E':
+ break;
+ case 'F':
+ break;
+ case 'G':
+ break;
+ case 'H':
+ break;
+ case 'I':
+ break;
+ case 'J':
+ break;
+ case 'K':
+ break;
+ case 'L':
+ break;
+ case 'M':
+ break;
+ case 'N':
+ break;
+ case 'O':
+ break;
+ case 'P':
+ if (strEQ(name, "PGRES_CONNECTION_OK"))
+ return 0;
+ if (strEQ(name, "PGRES_CONNECTION_BAD"))
+ return 1;
+ if (strEQ(name, "PGRES_INV_SMGRMASK"))
+ return 0x0000ffff;
+ if (strEQ(name, "PGRES_INV_ARCHIVE"))
+ return 0x00010000;
+ if (strEQ(name, "PGRES_INV_WRITE"))
+ return 0x00020000;
+ if (strEQ(name, "PGRES_INV_READ"))
+ return 0x00040000;
+ if (strEQ(name, "PGRES_InvalidOid"))
+ return 0;
+ if (strEQ(name, "PGRES_EMPTY_QUERY"))
+ return 0;
+ if (strEQ(name, "PGRES_COMMAND_OK"))
+ return 1;
+ if (strEQ(name, "PGRES_TUPLES_OK"))
+ return 2;
+ if (strEQ(name, "PGRES_COPY_OUT"))
+ return 3;
+ if (strEQ(name, "PGRES_COPY_IN"))
+ return 4;
+ if (strEQ(name, "PGRES_BAD_RESPONSE"))
+ return 5;
+ if (strEQ(name, "PGRES_NONFATAL_ERROR"))
+ return 6;
+ if (strEQ(name, "PGRES_FATAL_ERROR"))
+ return 7;
+ break;
+ case 'Q':
+ break;
+ case 'R':
+ break;
+ case 'S':
+ break;
+ case 'T':
+ break;
+ case 'U':
+ break;
+ case 'V':
+ break;
+ case 'W':
+ break;
+ case 'X':
+ break;
+ case 'Y':
+ break;
+ case 'Z':
+ break;
+ case 'a':
+ break;
+ case 'b':
+ break;
+ case 'c':
+ break;
+ case 'd':
+ break;
+ case 'e':
+ break;
+ case 'f':
+ break;
+ case 'g':
+ break;
+ case 'h':
+ break;
+ case 'i':
+ break;
+ case 'j':
+ break;
+ case 'k':
+ break;
+ case 'l':
+ break;
+ case 'm':
+ break;
+ case 'n':
+ break;
+ case 'o':
+ break;
+ case 'p':
+ break;
+ case 'q':
+ break;
+ case 'r':
+ break;
+ case 's':
+ break;
+ case 't':
+ break;
+ case 'u':
+ break;
+ case 'v':
+ break;
+ case 'w':
+ break;
+ case 'x':
+ break;
+ case 'y':
+ break;
+ case 'z':
+ break;
+ }
+ errno = EINVAL;
+ return 0;
+
+not_there:
+ errno = ENOENT;
+ return 0;
+}
+
+
+
+
+
+
+
+
+MODULE = Pg PACKAGE = Pg
+
+PROTOTYPES: DISABLE
+
+
+double
+constant(name,arg)
+ char * name
+ int arg
+
+
+PGconn *
+PQconnectdb(conninfo)
+ char * conninfo
+ CODE:
+ RETVAL = PQconnectdb((const char *)conninfo);
+ OUTPUT:
+ 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 *
+PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
+ char * pghost
+ char * pgport
+ char * pgoptions
+ char * pgtty
+ char * dbname
+
+
+void
+PQfinish(conn)
+ PGconn * conn
+
+
+void
+PQreset(conn)
+ PGconn * conn
+
+
+char *
+PQdb(conn)
+ PGconn * conn
+
+
+char *
+PQuser(conn)
+ PGconn * conn
+
+
+char *
+PQhost(conn)
+ PGconn * conn
+
+
+char *
+PQoptions(conn)
+ PGconn * conn
+
+
+char *
+PQport(conn)
+ PGconn * conn
+
+
+char *
+PQtty(conn)
+ PGconn * conn
+
+
+ConnStatusType
+PQstatus(conn)
+ PGconn * conn
+
+
+char *
+PQerrorMessage(conn)
+ PGconn * conn
+
+
+void
+PQtrace(conn, debug_port)
+ PGconn * conn
+ FILE * debug_port
+
+
+void
+PQuntrace(conn)
+ PGconn * conn
+
+
+
+PGresult *
+PQexec(conn, query)
+ PGconn * conn
+ char * query
+ CODE:
+ RETVAL = PQexec(conn, query);
+ 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
+ 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
+PQresultStatus(res)
+ PGresult * res
+
+
+int
+PQntuples(res)
+ PGresult * res
+
+
+int
+PQnfields(res)
+ PGresult * res
+
+
+char *
+PQfname(res, field_num)
+ PGresult * res
+ int field_num
+
+
+int
+PQfnumber(res, field_name)
+ PGresult * res
+ char * field_name
+
+
+Oid
+PQftype(res, field_num)
+ PGresult * res
+ int field_num
+
+
+int2
+PQfsize(res, field_num)
+ PGresult * res
+ int field_num
+
+
+char *
+PQcmdStatus(res)
+ PGresult * res
+
+
+char *
+PQoidStatus(res)
+ PGresult * res
+ PREINIT:
+ const char *GAGA;
+ CODE:
+ GAGA = PQoidStatus(res);
+ RETVAL = (char *)GAGA;
+ OUTPUT:
+ RETVAL
+
+
+char *
+PQgetvalue(res, tup_num, field_num)
+ PGresult * res
+ int tup_num
+ int field_num
+
+
+int
+PQgetlength(res, tup_num, field_num)
+ PGresult * res
+ int tup_num
+ int field_num
+
+
+int
+PQgetisnull(res, tup_num, field_num)
+ PGresult * res
+ int tup_num
+ int field_num
+
+
+void
+PQclear(res)
+ PGresult * res
+
+
+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
+ char * fieldSep
+ char * tableOpt
+ char * caption
+ PREINIT:
+ PQprintOpt ps;
+ int i;
+ CODE:
+ ps.header = header;
+ ps.align = align;
+ ps.standard = standard;
+ ps.html3 = html3;
+ ps.expanded = expanded;
+ ps.pager = pager;
+ ps.fieldSep = fieldSep;
+ ps.tableOpt = tableOpt;
+ ps.caption = caption;
+ Newz(0, ps.fieldName, items + 1 - 11, char*);
+ for (i = 11; i < items; i++) {
+ ps.fieldName[i - 11] = (char *)SvPV(ST(i), na);
+ }
+ PQprint(fout, res, &ps);
+ Safefree(ps.fieldName);
+
+
+int
+lo_open(conn, lobjId, mode)
+ PGconn * conn
+ Oid lobjId
+ int mode
+ ALIAS:
+ PQlo_open = 1
+
+
+int
+lo_close(conn, fd)
+ PGconn * conn
+ int fd
+ ALIAS:
+ PQlo_close = 1
+
+
+int
+lo_read(conn, fd, buf, len)
+ ALIAS:
+ PQlo_read = 1
+ PREINIT:
+ SV *sv_buffer = 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);
+ }
+ }
+
+
+int
+lo_write(conn, fd, buf, len)
+ PGconn * conn
+ int fd
+ char * buf
+ int len
+ ALIAS:
+ PQlo_write = 1
+
+
+int
+lo_lseek(conn, fd, offset, whence)
+ PGconn * conn
+ int fd
+ int offset
+ int whence
+ ALIAS:
+ PQlo_lseek = 1
+
+
+Oid
+lo_creat(conn, mode)
+ PGconn * conn
+ int mode
+ ALIAS:
+ PQlo_creat = 1
+
+
+int
+lo_tell(conn, fd)
+ PGconn * conn
+ int fd
+ ALIAS:
+ PQlo_tell = 1
+
+
+int
+lo_unlink(conn, lobjId)
+ PGconn * conn
+ Oid lobjId
+ ALIAS:
+ PQlo_unlink = 1
+
+
+Oid
+lo_import(conn, filename)
+ PGconn * conn
+ char * filename
+ ALIAS:
+ PQlo_import = 1
+
+
+int
+lo_export(conn, lobjId, filename)
+ PGconn * conn
+ Oid lobjId
+ char * filename
+ ALIAS:
+ PQlo_export = 1
+
+
+
+
+PG_conn
+connectdb(conninfo)
+ char * conninfo
+ CODE:
+ RETVAL = PQconnectdb((const char *)conninfo);
+ OUTPUT:
+ RETVAL
+
+
+HV *
+conndefaults()
+ 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
+
+
+PG_conn
+setdb(pghost, pgport, pgoptions, pgtty, dbname)
+ char * pghost
+ char * pgport
+ char * pgoptions
+ char * pgtty
+ char * dbname
+ CODE:
+ RETVAL = PQsetdb(pghost, pgport, pgoptions, pgtty, dbname);
+ OUTPUT:
+ RETVAL
+
+
+
+
+
+
+
+MODULE = Pg PACKAGE = PG_conn PREFIX = PQ
+
+PROTOTYPES: DISABLE
+
+
+void
+DESTROY(conn)
+ PG_conn conn
+ CODE:
+ /* printf("DESTROY connection\n"); */
+ PQfinish(conn);
+
+
+void
+PQreset(conn)
+ PG_conn conn
+
+
+char *
+PQdb(conn)
+ PG_conn conn
+
+
+char *
+PQuser(conn)
+ PG_conn conn
+
+
+char *
+PQhost(conn)
+ PG_conn conn
+
+
+char *
+PQoptions(conn)
+ PG_conn conn
+
+
+char *
+PQport(conn)
+ PG_conn conn
+
+
+char *
+PQtty(conn)
+ PG_conn conn
+
+
+ConnStatusType
+PQstatus(conn)
+ PG_conn conn
+
+
+char *
+PQerrorMessage(conn)
+ PG_conn conn
+
+
+void
+PQtrace(conn, debug_port)
+ PG_conn conn
+ FILE * debug_port
+
+
+void
+PQuntrace(conn)
+ PG_conn conn
+
+
+
+PG_result
+PQexec(conn, query)
+ PG_conn conn
+ char * query
+ CODE:
+ RETVAL = PQexec(conn, query);
+ 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:
+ 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
+ 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
+lo_open(conn, lobjId, mode)
+ PG_conn conn
+ Oid lobjId
+ int mode
+
+
+int
+lo_close(conn, fd)
+ PG_conn conn
+ int fd
+
+
+int
+lo_read(conn, fd, buf, len)
+ PREINIT:
+ SV *sv_buffer = 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);
+ }
+ }
+
+
+int
+lo_write(conn, fd, buf, len)
+ PG_conn conn
+ int fd
+ char * buf
+ int len
+
+
+int
+lo_lseek(conn, fd, offset, whence)
+ PG_conn conn
+ int fd
+ int offset
+ int whence
+
+
+Oid
+lo_creat(conn, mode)
+ PG_conn conn
+ int mode
+
+
+int
+lo_tell(conn, fd)
+ PG_conn conn
+ int fd
+
+
+int
+lo_unlink(conn, lobjId)
+ PG_conn conn
+ Oid lobjId
+
+
+Oid
+lo_import(conn, filename)
+ PG_conn conn
+ char * filename
+
+
+int
+lo_export(conn, lobjId, filename)
+ PG_conn conn
+ Oid lobjId
+ char * filename
+
+
+
+
+MODULE = Pg PACKAGE = PG_result PREFIX = PQ
+
+PROTOTYPES: DISABLE
+
+
+void
+DESTROY(res)
+ PG_result res
+ CODE:
+ /* printf("DESTROY result\n"); */
+ PQclear(res);
+
+
+ExecStatusType
+PQresultStatus(res)
+ PG_result res
+
+
+int
+PQntuples(res)
+ PG_result res
+
+
+int
+PQnfields(res)
+ PG_result res
+
+
+char *
+PQfname(res, field_num)
+ PG_result res
+ int field_num
+
+
+int
+PQfnumber(res, field_name)
+ PG_result res
+ char * field_name
+
+
+Oid
+PQftype(res, field_num)
+ PG_result res
+ int field_num
+
+
+int2
+PQfsize(res, field_num)
+ PG_result res
+ int field_num
+
+
+char *
+PQcmdStatus(res)
+ PG_result res
+
+
+char *
+PQoidStatus(res)
+ PG_result res
+ PREINIT:
+ const char *GAGA;
+ CODE:
+ GAGA = PQoidStatus(res);
+ RETVAL = (char *)GAGA;
+ OUTPUT:
+ RETVAL
+
+
+char *
+PQgetvalue(res, tup_num, field_num)
+ PG_result res
+ int tup_num
+ int field_num
+
+
+int
+PQgetlength(res, tup_num, field_num)
+ PG_result res
+ int tup_num
+ int field_num
+
+
+int
+PQgetisnull(res, tup_num, field_num)
+ PG_result res
+ int tup_num
+ int field_num
+
+
+void
+PQprintTuples(res, fout, printAttName, terseOutput, width)
+ PG_result res
+ FILE * fout
+ int printAttName
+ int terseOutput
+ int width
+
+
+void
+PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
+ FILE * fout
+ PG_result res
+ bool header
+ bool align
+ bool standard
+ bool html3
+ bool expanded
+ bool pager
+ char * fieldSep
+ char * tableOpt
+ char * caption
+ PREINIT:
+ PQprintOpt ps;
+ int i;
+ CODE:
+ ps.header = header;
+ ps.align = align;
+ ps.standard = standard;
+ ps.html3 = html3;
+ ps.expanded = expanded;
+ ps.pager = pager;
+ ps.fieldSep = fieldSep;
+ ps.tableOpt = tableOpt;
+ ps.caption = caption;
+ Newz(0, ps.fieldName, items + 1 - 11, char*);
+ for (i = 11; i < items; i++) {
+ ps.fieldName[i - 11] = (char *)SvPV(ST(i), na);
+ }
+ PQprint(fout, res, &ps);
+ Safefree(ps.fieldName);
+
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: README,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+DESCRIPTION:
+------------
+
+This is version 1.6 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 the
+Perl5 application programming interface for C extensions which calls the
+Postgres programmer's interface LIBQ. Pgsql_perl5 tries to implement the LIBPQ-
+interface as close, as possible.
+
+You have the choice between two different interfaces: the old C-style like
+interface and a new one, using a more Perl-ish like style. The old style
+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.
+
+
+
+COPYRIGHT INFO
+--------------
+
+This Postgres-Perl interface is copyright 1996, 1997 Edmund Mergl. You are
+free to use it for any purpose, commercial or noncommercial, provided
+that if you redistribute the source code, this statement of copyright
+remains attached.
+
+
+IF YOU HAVE PROBLEMS:
+---------------------
+
+Please send comments and bug-reports to <E.Mergl@bawue.de>
+
+Please include the output of perl -v,
+ and perl -V,
+ the version of PostgreSQL,
+ and the version of pgsql_perl5
+in your bug-report.
+
+
+REQUIREMENTS:
+-------------
+
+ - perl5.003
+ - PostgreSQL-6.1
+
+
+PLATFORMS:
+----------
+
+ This release of pgsql_perl5 has been developed using Linux 2.0 with
+ dynamic loading for the perl extensions. Let me know, if there are
+ any problems with other platforms.
+
+
+INSTALLATION:
+-------------
+
+Using dynamic loading for perl extensions, the preferred method is to unpack
+the tar file outside the perl source tree. This assumes, that you already
+have installed perl5.
+
+The Makefile checks the environment variable POSTGRESHOME as well some
+standard locations, to find the root directory of your Postgres installation.
+
+1. perl Makefile.PL
+2. make
+3. make test
+4. make install
+
+( 1. to 3. as normal user, not as root ! )
+
+
+TESTING:
+--------
+
+Run 'make test'.
+Note, that the user running this script must have been created with
+the access rights to create databases *AND* users ! Do not run this
+script as root !
+
+If you are using the shared library libpq.so, make sure, your dynamic loader
+is able to find libpq.so. With Linux the command /sbin/ldconfig -v should tell
+you, where it finds libpq.so. If not, you need to add an appropriate entry to
+/etc/ld.so.conf or to the environment variable LD_LIBRARY_PATH.
+
+Some linux distributions (eg slackware) have an incomplete perl installation.
+If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a
+ 'find /usr/lib/perl5 -name XSUB.h -print'
+If this file is not present, you need to recompile and reinstall perl.
+
+
+---------------------------------------------------------------------------
+
+ Edmund Mergl <E.Mergl@bawue.de> April 29, 1997
+
+---------------------------------------------------------------------------
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: test.pl,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+# 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..49\n"; }
+END {print "not ok 1\n" unless $loaded;}
+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
+
+# connectdb
+# db
+# user
+# host
+# port
+# finish
+# status
+# errorMessage
+# trace
+# untrace
+# exec
+# getline
+# endcopy
+# putline
+# resultStatus
+# ntuples
+# nfields
+# fname
+# fnumber
+# ftype
+# fsize
+# cmdStatus
+# oidStatus
+# getvalue
+
+######################### the following methods will not be tested
+
+# setdb
+# conndefaults
+# reset
+# options
+# tty
+# getlength
+# getisnull
+# print
+# notifies
+# printTuples
+# lo_import
+# lo_export
+# lo_unlink
+# lo_open
+# lo_close
+# lo_read
+# lo_write
+# lo_creat
+# lo_seek
+# lo_tell
+
+######################### handles error condition
+
+$SIG{PIPE} = sub { print "broken pipe\n" };
+
+######################### create and connect to test database
+# 2-4
+
+$conn = Pg::connectdb("dbname = $dbmain");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+# might fail if $dbname doesn't exist => don't check resultStatus
+$result = $conn->exec("DROP DATABASE $dbname");
+
+$result = $conn->exec("CREATE DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+$conn = Pg::connectdb("dbname = $dbname");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+######################### debug, PQtrace
+
+if ($DEBUG) {
+ open(TRACE, ">$trace") || die "can not open $trace: $!";
+ $conn->trace(TRACE);
+}
+
+######################### check PGconn
+# 5-8
+
+$db = $conn->db;
+cmp_eq($dbname, $db);
+
+$user = $conn->user;
+cmp_ne("", $user);
+
+$host = $conn->host;
+cmp_ne("", $host);
+
+$port = $conn->port;
+cmp_ne("", $port);
+
+######################### create and insert into table
+# 9-20
+
+$result = $conn->exec("CREATE TABLE person (id int4, name char16)");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+cmp_eq("CREATE", $result->cmdStatus);
+
+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);
+}
+
+######################### copy to stdout, PQgetline
+# 21-27
+
+$result = $conn->exec("COPY person TO STDOUT");
+cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
+
+$i = 1;
+while (-1 != $ret) {
+ $ret = $conn->getline($string, 256);
+ last if $string eq "\\.";
+ cmp_eq("$i Edmund Mergl", $string);
+ $i ++;
+}
+
+cmp_eq(0, $conn->endcopy);
+
+######################### delete and copy from stdin, PQputline
+# 28-33
+
+$result = $conn->exec("BEGIN");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+$result = $conn->exec("DELETE FROM person");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+cmp_eq("DELETE", $result->cmdStatus);
+
+$result = $conn->exec("COPY person FROM STDIN");
+cmp_eq(PGRES_COPY_IN, $result->resultStatus);
+
+for ($i = 1; $i <= 5; $i++) {
+ # watch the tabs and do not forget the newlines
+ $conn->putline("$i Edmund Mergl\n");
+}
+$conn->putline("\\.\n");
+
+cmp_eq(0, $conn->endcopy);
+
+$result = $conn->exec("END");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+######################### select from person, PQgetvalue
+# 34-47
+
+$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(20, $ftype);
+ cmp_eq(16, $fsize);
+ }
+ $fnumber = $result->fnumber($fname);
+ cmp_eq($k, $fnumber);
+}
+
+for ($k = 0; $k < $result->ntuples; $k++) {
+ $string = "";
+ for ($l = 0; $l < $result->nfields; $l++) {
+ $string .= $result->getvalue($k, $l) . " ";
+ }
+ $i = $k + 1;
+ cmp_eq("$i Edmund Mergl ", $string);
+}
+
+######################### debug, PQuntrace
+
+if ($DEBUG) {
+ close(TRACE) || die "bad TRACE: $!";
+ $conn->untrace;
+}
+
+######################### disconnect and drop test database
+# 48-49
+
+$conn = Pg::connectdb("dbname = $dbmain");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+$result = $conn->exec("DROP DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+######################### hopefully
+
+print "all tests passed.\n" if 50 == $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++;
+}
+
+######################### EOF
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: test.pl.newstyle,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+# 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..60\n"; }
+END {print "not ok 1\n" unless $loaded;}
+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
+
+# connectdb
+# db
+# user
+# host
+# port
+# finish
+# status
+# errorMessage
+# trace
+# untrace
+# exec
+# getline
+# endcopy
+# putline
+# resultStatus
+# ntuples
+# nfields
+# fname
+# fnumber
+# ftype
+# fsize
+# cmdStatus
+# oidStatus
+# getvalue
+# print
+# notifies
+# lo_import
+# lo_export
+# lo_unlink
+
+######################### the following methods will not be tested
+
+# setdb
+# conndefaults
+# reset
+# options
+# tty
+# getlength
+# getisnull
+# printTuples
+# lo_open
+# lo_close
+# lo_read
+# lo_write
+# lo_creat
+# lo_seek
+# lo_tell
+
+######################### handles error condition
+
+$SIG{PIPE} = sub { print "broken pipe\n" };
+
+######################### create and connect to test database
+# 2-4
+
+$conn = Pg::connectdb("dbname = $dbmain");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+# might fail if $dbname doesn't exist => don't check resultStatus
+$result = $conn->exec("DROP DATABASE $dbname");
+
+$result = $conn->exec("CREATE DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+$conn = Pg::connectdb("dbname = $dbname");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+######################### debug, PQtrace
+
+if ($DEBUG) {
+ open(TRACE, ">$trace") || die "can not open $trace: $!";
+ $conn->trace(TRACE);
+}
+
+######################### check PGconn
+# 5-8
+
+$db = $conn->db;
+cmp_eq($dbname, $db);
+
+$user = $conn->user;
+cmp_ne("", $user);
+
+$host = $conn->host;
+cmp_ne("", $host);
+
+$port = $conn->port;
+cmp_ne("", $port);
+
+######################### create and insert into table
+# 9-20
+
+$result = $conn->exec("CREATE TABLE person (id int4, name char16)");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+cmp_eq("CREATE", $result->cmdStatus);
+
+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);
+}
+
+######################### copy to stdout, PQgetline
+# 21-27
+
+$result = $conn->exec("COPY person TO STDOUT");
+cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
+
+$i = 1;
+while (-1 != $ret) {
+ $ret = $conn->getline($string, 256);
+ last if $string eq "\\.";
+ cmp_eq("$i Edmund Mergl", $string);
+ $i ++;
+}
+
+cmp_eq(0, $conn->endcopy);
+
+######################### delete and copy from stdin, PQputline
+# 28-33
+
+$result = $conn->exec("BEGIN");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+$result = $conn->exec("DELETE FROM person");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+cmp_eq("DELETE", $result->cmdStatus);
+
+$result = $conn->exec("COPY person FROM STDIN");
+cmp_eq(PGRES_COPY_IN, $result->resultStatus);
+
+for ($i = 1; $i <= 5; $i++) {
+ # watch the tabs and do not forget the newlines
+ $conn->putline("$i Edmund Mergl\n");
+}
+$conn->putline("\\.\n");
+
+cmp_eq(0, $conn->endcopy);
+
+$result = $conn->exec("END");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+######################### select from person, PQgetvalue
+# 34-47
+
+$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(20, $ftype);
+ cmp_eq(16, $fsize);
+ }
+ $fnumber = $result->fnumber($fname);
+ cmp_eq($k, $fnumber);
+}
+
+for ($k = 0; $k < $result->ntuples; $k++) {
+ $string = "";
+ for ($l = 0; $l < $result->nfields; $l++) {
+ $string .= $result->getvalue($k, $l) . " ";
+ }
+ $i = $k + 1;
+ cmp_eq("$i Edmund Mergl ", $string);
+}
+
+######################### PQnotifies
+# 48-50
+
+if (! defined($pid = fork)) {
+ die "can not fork: $!";
+} elsif (! $pid) {
+ # i'm the child
+ sleep 2;
+ bless $conn;
+ $conn = Pg::connectdb("dbname = $dbname");
+ $result = $conn->exec("NOTIFY person");
+ exit;
+}
+
+$result = $conn->exec("LISTEN person");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+cmp_eq("LISTEN", $result->cmdStatus);
+
+while (1) {
+ $result = $conn->exec(" ");
+ ($table, $pid) = $conn->notifies;
+ last if $pid;
+}
+
+cmp_eq("person", $table);
+
+######################### PQprint
+# 51-52
+
+$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: $!";
+
+######################### PQlo_import, PQlo_export, PQlo_unlink
+# 53-58
+
+$filename = 'typemap';
+$cwd = `pwd`;
+chop $cwd;
+
+$result = $conn->exec("BEGIN");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+$lobjOid = $conn->lo_import("$cwd/$filename");
+cmp_ne(0, $lobjOid);
+
+cmp_ne(-1, $conn->lo_export($lobjOid, "/tmp/$filename"));
+
+cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+
+$result = $conn->exec("END");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+cmp_ne(-1, $conn->lo_unlink($lobjOid));
+unlink "/tmp/$filename";
+
+######################### debug, PQuntrace
+
+if ($DEBUG) {
+ close(TRACE) || die "bad TRACE: $!";
+ $conn->untrace;
+}
+
+######################### disconnect and drop test database
+# 59-60
+
+$conn = Pg::connectdb("dbname = $dbmain");
+cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+
+$result = $conn->exec("DROP DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+
+######################### hopefully
+
+print "all tests passed.\n" if 61 == $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++;
+}
+
+######################### EOF
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: test.pl.oldstyle,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+# 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..60\n"; }
+END {print "not ok 1\n" unless $loaded;}
+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()
+# PQhost()
+# PQport()
+# PQfinish()
+# PQstatus()
+# PQerrorMessage()
+# PQtrace()
+# PQuntrace()
+# PQexec()
+# PQgetline()
+# PQendcopy()
+# PQputline()
+# PQresultStatus()
+# PQntuples()
+# PQnfields()
+# PQfname()
+# PQfnumber()
+# PQftype()
+# PQfsize()
+# PQcmdStatus()
+# PQoidStatus()
+# PQgetvalue()
+# PQclear()
+# PQprint()
+# PQnotifies()
+# PQlo_import()
+# PQlo_export()
+# PQlo_unlink()
+
+######################### the following functions will not be tested
+
+# PQconnectdb()
+# PQconndefaults()
+# PQreset()
+# PQoptions()
+# PQtty()
+# PQgetlength()
+# PQgetisnull()
+# PQprintTuples()
+# PQlo_open()
+# PQlo_close()
+# PQlo_read()
+# PQlo_write()
+# PQlo_creat()
+# PQlo_lseek()
+# PQlo_tell()
+
+######################### handles error condition
+
+$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));
+
+# might fail if $dbname doesn't exist => don't check resultStatus
+$result = PQexec($conn, "DROP DATABASE $dbname");
+PQclear($result);
+
+$result = PQexec($conn, "CREATE DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+PQfinish($conn);
+
+$conn = PQsetdb('', '', '', '', $dbname);
+cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+
+######################### debug, PQtrace
+
+if ($DEBUG) {
+ open(TRACE, ">$trace") || die "can not open $trace: $!";
+ PQtrace($conn, TRACE);
+}
+
+######################### check PGconn
+# 5-8
+
+$db = PQdb($conn);
+cmp_eq($dbname, $db);
+
+$user = PQuser($conn);
+cmp_ne("", $user);
+
+$host = PQhost($conn);
+cmp_ne("", $host);
+
+$port = PQport($conn);
+cmp_ne("", $port);
+
+######################### create and insert into table
+# 9-20
+
+$result = PQexec($conn, "CREATE TABLE person (id int4, name char16)");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+cmp_eq("CREATE", PQcmdStatus($result));
+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));
+ PQclear($result);
+}
+
+######################### copy to stdout, PQgetline
+# 21-27
+
+$result = PQexec($conn, "COPY person TO STDOUT");
+cmp_eq(PGRES_COPY_OUT, PQresultStatus($result));
+PQclear($result);
+
+$i = 1;
+while (-1 != $ret) {
+ $ret = PQgetline($conn, $string, 256);
+ last if $string eq "\\.";
+ cmp_eq("$i Edmund Mergl", $string);
+ $i++;
+}
+
+cmp_eq(0, PQendcopy($conn));
+
+######################### delete and copy from stdin, PQputline
+# 28-33
+
+$result = PQexec($conn, "BEGIN");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+$result = PQexec($conn, "DELETE FROM person");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+cmp_eq("DELETE", PQcmdStatus($result));
+PQclear($result);
+
+$result = PQexec($conn, "COPY person FROM STDIN");
+cmp_eq(PGRES_COPY_IN, PQresultStatus($result));
+PQclear($result);
+
+for ($i = 1; $i <= 5; $i++) {
+ # watch the tabs and do not forget the newlines
+ PQputline($conn, "$i Edmund Mergl\n");
+}
+PQputline($conn, "\\.\n");
+
+cmp_eq(0, PQendcopy($conn));
+
+$result = PQexec($conn, "END");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+######################### select from person, PQgetvalue
+# 34-47
+
+$result = PQexec($conn, "SELECT * FROM person");
+cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
+
+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(20, $ftype);
+ cmp_eq(16, $fsize);
+ }
+ $fnumber = PQfnumber($result, $fname);
+ cmp_eq($k, $fnumber);
+}
+
+for ($k = 0; $k < PQntuples($result); $k++) {
+ $string = "";
+ for ($l = 0; $l < PQnfields($result); $l++) {
+ $string .= PQgetvalue($result, $k, $l) . " ";
+ }
+ $i = $k + 1;
+ cmp_eq("$i Edmund Mergl ", $string);
+}
+
+PQclear($result);
+
+######################### PQnotifies
+# 48-50
+
+if (! defined($pid = fork)) {
+ die "can not fork: $!";
+} elsif (! $pid) {
+ # i'm the child
+ sleep 2;
+ $conn = PQsetdb('', '', '', '', $dbname);
+ $result = PQexec($conn, "NOTIFY person");
+ PQclear($result);
+ PQfinish($conn);
+ exit;
+}
+
+$result = PQexec($conn, "LISTEN person");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+cmp_eq("LISTEN", PQcmdStatus($result));
+PQclear($result);
+
+while (1) {
+ $result = PQexec($conn, " ");
+ ($table, $pid) = PQnotifies($conn);
+ PQclear($result);
+ last if $pid;
+}
+
+cmp_eq("person", $table);
+
+######################### 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");
+PQclear($result);
+close(PRINT) || die "bad PRINT: $!";
+
+######################### PQlo_import, PQlo_export, PQlo_unlink
+# 53-59
+
+$filename = 'typemap';
+$cwd = `pwd`;
+chop $cwd;
+
+$result = PQexec($conn, "BEGIN");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+$lobjOid = PQlo_import($conn, "$cwd/$filename");
+cmp_ne( 0, $lobjOid);
+
+cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename"));
+
+cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+
+$result = PQexec($conn, "END");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+cmp_ne(-1, PQlo_unlink($conn, $lobjOid));
+unlink "/tmp/$filename";
+
+######################### debug, PQuntrace
+
+if ($DEBUG) {
+ close(TRACE) || die "bad TRACE: $!";
+ PQuntrace($conn);
+}
+
+######################### disconnect and drop test database
+# 59-60
+
+PQfinish($conn);
+
+$conn = PQsetdb('', '', '', '', $dbmain);
+cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+
+$result = PQexec($conn, "DROP DATABASE $dbname");
+cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+PQclear($result);
+
+PQfinish($conn);
+
+######################### hopefully
+
+print "all tests passed.\n" if 61 == $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
--- /dev/null
+#-------------------------------------------------------
+#
+# $Id: typemap,v 1.1.1.1 1997/04/29 19:37:10 mergl Exp $
+#
+# Copyright (c) 1997 Edmund Mergl
+#
+#-------------------------------------------------------
+
+TYPEMAP
+PGconn * T_PTRREF
+PGresult * T_PTRREF
+PG_conn T_PTROBJ
+PG_result T_PTROBJ
+ConnStatusType T_IV
+ExecStatusType T_IV
+Oid T_IV
+int2 T_IV
+bool T_IV
OSDN Git Service
