From: Edmund Mergl Date: Tue, 29 Apr 1997 19:37:10 +0000 (+0000) Subject: creation for postgresql-6.1 X-Git-Tag: REL6_1~217 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=0aba92a2c5684ec141ba3dfcab808d86cd7c2882;p=postgresql creation for postgresql-6.1 --- diff --git a/src/interfaces/perl5/ApachePg.pl b/src/interfaces/perl5/ApachePg.pl new file mode 100644 index 0000000000..53bd6b8916 --- /dev/null +++ b/src/interfaces/perl5/ApachePg.pl @@ -0,0 +1,47 @@ +#!/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, + "

Testing Module Pg

", + "Enter the database name: ", + $query->textfield(-name=>'dbname'), + "

", + "Enter the select command: ", + $query->textfield(-name=>'cmd', -size=>40), + "

", + $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 "

\n"; + for ($i=0; $i < $result->ntuples; $i++) { + print "\n"; + for ($j=0; $j < $result->nfields; $j++) { + print "
", $result->getvalue($i, $j), "\n"; + } + } + + print "

\n"; +} + +print $query->end_html; + diff --git a/src/interfaces/perl5/Changes b/src/interfaces/perl5/Changes new file mode 100644 index 0000000000..60d6709bf1 --- /dev/null +++ b/src/interfaces/perl5/Changes @@ -0,0 +1,58 @@ +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 diff --git a/src/interfaces/perl5/MANIFEST b/src/interfaces/perl5/MANIFEST new file mode 100644 index 0000000000..bdf1f69448 --- /dev/null +++ b/src/interfaces/perl5/MANIFEST @@ -0,0 +1,11 @@ +ApachePg.pl +Changes +MANIFEST +Makefile.PL +Pg.pm +Pg.xs +README +test.pl +test.pl.newstyle +test.pl.oldstyle +typemap diff --git a/src/interfaces/perl5/Makefile.PL b/src/interfaces/perl5/Makefile.PL new file mode 100644 index 0000000000..afd3473496 --- /dev/null +++ b/src/interfaces/perl5/Makefile.PL @@ -0,0 +1,38 @@ +#------------------------------------------------------- +# +# $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 diff --git a/src/interfaces/perl5/Pg.pm b/src/interfaces/perl5/Pg.pm new file mode 100644 index 0000000000..adff08d53e --- /dev/null +++ b/src/interfaces/perl5/Pg.pm @@ -0,0 +1,534 @@ +#------------------------------------------------------- +# +# $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 + +=head1 SEE ALSO + +libpq(3), large_objects(3). + +=cut diff --git a/src/interfaces/perl5/Pg.xs b/src/interfaces/perl5/Pg.xs new file mode 100644 index 0000000000..8cffb5afd6 --- /dev/null +++ b/src/interfaces/perl5/Pg.xs @@ -0,0 +1,948 @@ +/*------------------------------------------------------- + * + * $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); + diff --git a/src/interfaces/perl5/README b/src/interfaces/perl5/README new file mode 100644 index 0000000000..869aeeff0e --- /dev/null +++ b/src/interfaces/perl5/README @@ -0,0 +1,105 @@ +#------------------------------------------------------- +# +# $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 + +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 April 29, 1997 + +--------------------------------------------------------------------------- diff --git a/src/interfaces/perl5/test.pl b/src/interfaces/perl5/test.pl new file mode 100644 index 0000000000..3d5b513e9f --- /dev/null +++ b/src/interfaces/perl5/test.pl @@ -0,0 +1,260 @@ +#------------------------------------------------------- +# +# $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 diff --git a/src/interfaces/perl5/test.pl.newstyle b/src/interfaces/perl5/test.pl.newstyle new file mode 100644 index 0000000000..5d6a1e3d3c --- /dev/null +++ b/src/interfaces/perl5/test.pl.newstyle @@ -0,0 +1,319 @@ +#------------------------------------------------------- +# +# $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 diff --git a/src/interfaces/perl5/test.pl.oldstyle b/src/interfaces/perl5/test.pl.oldstyle new file mode 100644 index 0000000000..408c2b66c6 --- /dev/null +++ b/src/interfaces/perl5/test.pl.oldstyle @@ -0,0 +1,343 @@ +#------------------------------------------------------- +# +# $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 diff --git a/src/interfaces/perl5/typemap b/src/interfaces/perl5/typemap new file mode 100644 index 0000000000..a57abcfabb --- /dev/null +++ b/src/interfaces/perl5/typemap @@ -0,0 +1,18 @@ +#------------------------------------------------------- +# +# $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