diff --git a/src/interfaces/perl5/ApachePg.pl b/src/interfaces/perl5/ApachePg.pl deleted file mode 100644 index 670fbbecb62f1cf2985974301686768237f6de4a..0000000000000000000000000000000000000000 --- a/src/interfaces/perl5/ApachePg.pl +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/local/bin/perl - -# demo script, has been tested with: -# - Postgres-6.1 -# - apache_1.2 -# - mod_perl-1.0 -# - perl5.004 - -use CGI; -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 index cc8ff1a5f1775faa3ac29c22ae43ed1221ce21fd..48438f7ce49ec8c45cd5dbc662efbd612030702c 100644 --- a/src/interfaces/perl5/Changes +++ b/src/interfaces/perl5/Changes @@ -1,20 +1,40 @@ Revision history for Perl extension Pg. -1.0 Mar 24, 1995 - - creation +1.6.2 Sep 20 1997 + - adapted to PostgresqL-6.2: + o added support for new method cmdTuples + o cmdStatus returns now for DELETE the status + followed by the number of affected rows, + - test.pl.newstyle renamed to eg/example.newstyle + - test.pl.oldstyle renamed to eg/example.oldstyle + - example script ApachePg.pl now uses + $result->print with HTML option + - Makefile looks for $ENV{POSTGRES_HOME} instead of + $ENV{POSTGRESHOME} -1.1 Jun 6, 1995 - - Bug fix in PQgetline. +1.6.1 Jun 02 1997 + - renamed to pgsql_perl5 + - adapted to PostgreSQL-6.1 + - test only functions, which are also + tested in pgsql regression tests -1.1.1 Aug 5, 95 - - adapted to postgres95-beta0.03 - - Note: the libpq interface has changed completely ! +1.5.4 Feb 12, 1997 + - changed test.pl for large objects: + test only lo_import and lo_export -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.5.3 Jan 2, 1997 + - adapted to PostgreSQL-6.0 + - new functions PQconnectdb, PQuser + - changed name of method 'new' to 'setdb' + +1.4.2 Nov 21, 1996 + - added a more Perl-like syntax + +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.3.1 Oct 22, 1996 - adapted to Postgres95-1.08 @@ -30,29 +50,18 @@ Revision history for Perl extension Pg. - 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.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.1.1 Aug 5, 95 + - adapted to postgres95-beta0.03 + - Note: the libpq interface has changed completely ! -1.5.4 Feb 12, 1997 - - changed test.pl for large objects: - test only lo_import and lo_export +1.1 Jun 6, 1995 + - Bug fix in PQgetline. -1.6.1 Jun 02 1997 - - renamed to pgsql_perl5 - - adapted to PostgreSQL-6.1 - - test only functions, which are also - tested in pgsql regression tests +1.0 Mar 24, 1995 + - creation diff --git a/src/interfaces/perl5/MANIFEST b/src/interfaces/perl5/MANIFEST index bdf1f694488f9d4354692b4e6e4321e2e105a110..58f0ae98ad93f317d107ecb893084726b78e3a55 100644 --- a/src/interfaces/perl5/MANIFEST +++ b/src/interfaces/perl5/MANIFEST @@ -1,11 +1,11 @@ -ApachePg.pl Changes MANIFEST Makefile.PL Pg.pm Pg.xs README +eg/ApachePg.pl +eg/example.newstyle +eg/example.oldstyle test.pl -test.pl.newstyle -test.pl.oldstyle typemap diff --git a/src/interfaces/perl5/Makefile.PL b/src/interfaces/perl5/Makefile.PL index 7c4579df8eb8994b7f7db9d34e87279323322815..7f3c6461955629a832cf61e45c21f1467f27c87d 100644 --- a/src/interfaces/perl5/Makefile.PL +++ b/src/interfaces/perl5/Makefile.PL @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: Makefile.PL,v 1.2 1997/06/02 19:41:59 mergl Exp $ +# $Id: Makefile.PL,v 1.3 1997/09/17 20:46:20 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -12,27 +12,27 @@ 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"; +if (! $ENV{POSTGRES_HOME}) { + warn "\$POSTGRES_HOME not defined. Searching for PostgreSQL...\n"; foreach(qw(/usr/pgsql /usr/local/pgsql /usr/pgsql-6.1 /usr/local/pgsql-6.1)) { if (-d "$_/lib") { - $ENV{POSTGRESHOME} = $_; + $ENV{POSTGRES_HOME} = $_; last; } } } -if ($ENV{POSTGRESHOME}) { - print "\nFound Postgres in $ENV{POSTGRESHOME}\n"; +if ($ENV{POSTGRES_HOME}) { + print "\nFound PostgreSQL in $ENV{POSTGRES_HOME}\n"; } else { - die "Unable to determine \$POSTGRESHOME !\n"; + die "Unable to determine \$POSTGRES_HOME !\n"; } WriteMakefile( 'NAME' => 'Pg', 'VERSION_FROM' => 'Pg.pm', - 'LIBS' => ["-L$ENV{POSTGRESHOME}/lib -lpq"], - 'INC' => "-I$ENV{POSTGRESHOME}/include", + 'LIBS' => ["-L$ENV{POSTGRES_HOME}/lib -lpq"], + 'INC' => "-I$ENV{POSTGRES_HOME}/include", ); # EOF diff --git a/src/interfaces/perl5/Pg.pm b/src/interfaces/perl5/Pg.pm index ab7dcd789f1d42e32d04e4501c38fb83a95eae5a..4591dcb1faa97784a51cd294a3f33c076a44c75c 100644 --- a/src/interfaces/perl5/Pg.pm +++ b/src/interfaces/perl5/Pg.pm @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: Pg.pm,v 1.2 1997/06/02 19:42:01 mergl Exp $ +# $Id: Pg.pm,v 1.3 1997/09/17 20:46:21 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -15,7 +15,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); require Exporter; require DynaLoader; require AutoLoader; -require 5.003; +require 5.002; @ISA = qw(Exporter DynaLoader); @@ -50,6 +50,7 @@ require 5.003; PQfsize PQcmdStatus PQoidStatus + PQcmdTuples PQgetvalue PQgetlength PQgetisnull @@ -83,7 +84,7 @@ require 5.003; PGRES_InvalidOid ); -$VERSION = '1.6.1'; +$Pg::VERSION = '1.6.2'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -140,7 +141,7 @@ __END__ =head1 NAME -Pg - Perl extension for PostgreSQL +Pg - Perl5 extension for PostgreSQL =head1 SYNOPSIS @@ -194,7 +195,7 @@ 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, +packages name-space. 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). @@ -245,7 +246,7 @@ fields of this structure. 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 +hard-coded defaults are used. The connection identifier $conn ( a pointer to the PGconn structure ) must be used in subsequent commands for unique identification. Before using $conn you should call $conn->status to ensure, that the connection was properly made. Use the methods below to access @@ -374,7 +375,7 @@ 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 + $ntuples = $result->ntuples Returns the number of tuples in the query result. @@ -430,13 +431,22 @@ command executed: $cmdStatus = $result->cmdStatus -Returns the command status of the last query command. +Returns the command status of the last query command. +In case of DELETE it returns also the number of deleted tuples. +In case of INSERT it returns also the OID of the inserted +tuple followed by 1 (the number of affected tuples). + $oid = $result->oidStatus In case the last query was an INSERT command it returns the oid of the inserted tuple. + $oid = $result->cmdTuples + +In case the last query was an INSERT or DELETE command it returns the +number of affected tuples. + $result->printTuples($fout, $printAttName, $terseOutput, $width) Kept for backward compatibility. Use print. @@ -462,13 +472,13 @@ Frees all memory of the given result. 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, +system interface with analogies of open, close, read, write, lseek, tell. In order to get a consistent naming, all function names have been prepended with 'PQ' (old style only). $lobjId = $conn->lo_creat($mode) -Creates a new large object. $mode is a bitmask describing +Creates a new large object. $mode is a bit-mask describing different attributes of the new object. Use the following constants: - PGRES_INV_SMGRMASK @@ -529,6 +539,6 @@ Returns -1 upon failure, 1 otherwise. =head1 SEE ALSO -libpq(3), large_objects(3). +L, L =cut diff --git a/src/interfaces/perl5/Pg.xs b/src/interfaces/perl5/Pg.xs index 771c81db7abf9c0130397e748b7f24c6786a4ec7..f7661d884022ed0d8ea4e247ccc8787bc2b11795 100644 --- a/src/interfaces/perl5/Pg.xs +++ b/src/interfaces/perl5/Pg.xs @@ -1,6 +1,6 @@ /*------------------------------------------------------- * - * $Id: Pg.xs,v 1.2 1997/06/02 19:42:03 mergl Exp $ + * $Id: Pg.xs,v 1.3 1997/09/17 20:46:21 mergl Exp $ * * Copyright (c) 1997 Edmund Mergl * @@ -10,21 +10,9 @@ #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; @@ -375,7 +363,7 @@ PQftype(res, field_num) int field_num -int2 +short PQfsize(res, field_num) PGresult * res int field_num @@ -398,6 +386,18 @@ PQoidStatus(res) RETVAL +char * +PQcmdTuples(res) + PGresult * res + PREINIT: + const char *GAGA; + CODE: + GAGA = PQcmdTuples(res); + RETVAL = (char *)GAGA; + OUTPUT: + RETVAL + + char * PQgetvalue(res, tup_num, field_num) PGresult * res @@ -872,7 +872,7 @@ PQftype(res, field_num) int field_num -int2 +short PQfsize(res, field_num) PG_result res int field_num @@ -895,6 +895,18 @@ PQoidStatus(res) RETVAL +char * +PQcmdTuples(res) + PG_result res + PREINIT: + const char *GAGA; + CODE: + GAGA = PQcmdTuples(res); + RETVAL = (char *)GAGA; + OUTPUT: + RETVAL + + char * PQgetvalue(res, tup_num, field_num) PG_result res diff --git a/src/interfaces/perl5/README b/src/interfaces/perl5/README index 25b79dbb4540d713f00918852333aa07e5674706..4b9a68a47b5c1375deb1d5dea082c17afd089cb8 100644 --- a/src/interfaces/perl5/README +++ b/src/interfaces/perl5/README @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: README,v 1.2 1997/06/02 19:42:05 mergl Exp $ +# $Id: README,v 1.3 1997/09/17 20:46:26 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -9,32 +9,27 @@ DESCRIPTION: ------------ -This is version 1.6 of pgsql_perl5 (previously called pg95perl5). +This is version 1.6.2 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. +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 LIBPQ. 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 +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. +programmers. COPYRIGHT: ---------- -This program is free software; you can redistribute it and/or modify -it under the terms of either: - - a) the GNU General Public License as published by the Free - Software Foundation; or - - b) the "Artistic License", as specified in the Perl README file. +You may distribute under the terms of either the GNU General Public +License or the Artistic License, as specified in the Perl README file. @@ -53,8 +48,8 @@ in your bug-report. REQUIREMENTS: ------------- - - perl5.003 - - PostgreSQL-6.1 + - build, test and install Perl 5 (at least 5.002) + - build, test and install PostgreSQL (at least 6.2) PLATFORMS: @@ -62,18 +57,18 @@ 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. + 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 +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. +The Makefile checks the environment variable POSTGRES_HOME as well some +standard locations, to find the root directory of your Postgres installation. 1. perl Makefile.PL 2. make @@ -87,19 +82,18 @@ 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 ! +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. +/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 +Some linux distributions 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. +If this file is not present, you need to recompile and reinstall perl. DOCUMENTATION: @@ -111,6 +105,6 @@ installation to read the documentation. --------------------------------------------------------------------------- - Edmund Mergl June 02, 1997 + Edmund Mergl September 20, 1997 --------------------------------------------------------------------------- diff --git a/src/interfaces/perl5/test.pl.newstyle b/src/interfaces/perl5/test.pl.newstyle deleted file mode 100644 index 40c5ab355b6f2fd493084ee87170de7a132fd120..0000000000000000000000000000000000000000 --- a/src/interfaces/perl5/test.pl.newstyle +++ /dev/null @@ -1,320 +0,0 @@ -#------------------------------------------------------- -# -# $Id: test.pl.newstyle,v 1.2 1997/06/02 19:42:11 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 -# displayTuples -# 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 deleted file mode 100644 index ad19b15c2f59bb531bdffb5ca76e9e025bcca653..0000000000000000000000000000000000000000 --- a/src/interfaces/perl5/test.pl.oldstyle +++ /dev/null @@ -1,344 +0,0 @@ -#------------------------------------------------------- -# -# $Id: test.pl.oldstyle,v 1.2 1997/06/02 19:42:13 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() -# PQdisplayTuples() -# 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 index 1083ed9ad65b9f3dd2a7d5155c3f1671441c2528..4eefe795e9c41d3cd529631851366892f27522f1 100644 --- a/src/interfaces/perl5/typemap +++ b/src/interfaces/perl5/typemap @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: typemap,v 1.2 1997/06/02 19:42:14 mergl Exp $ +# $Id: typemap,v 1.3 1997/09/17 20:46:29 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl #