mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
Edmund Mergl 1997-09-17 20:46:29 +00:00
parent b02086b303
commit 9e74edda05
10 changed files with 131 additions and 817 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/interfaces/perl5/ApachePg.pl
View File

@ -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,
"<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;

79
src/interfaces/perl5/Changes
View File

@ -1,20 +1,40 @@
Revision history for Perl extension Pg. Revision history for Perl extension Pg.
1.0 Mar 24, 1995 1.6.2 Sep 20 1997
- creation - 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 1.6.1 Jun 02 1997
- Bug fix in PQgetline. - 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 1.5.4 Feb 12, 1997
- adapted to postgres95-beta0.03 - changed test.pl for large objects:
- Note: the libpq interface has changed completely ! test only lo_import and lo_export
1.2.0 Oct 15, 1995 1.5.3 Jan 2, 1997
- adapted to Postgres95-1.0 - adapted to PostgreSQL-6.0
- README updated - new functions PQconnectdb, PQuser
- doQuery() in Pg.pm now returns 0 upon success - changed name of method 'new' to 'setdb'
- testlibpq.pl: added test for PQgetline()
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 1.3.1 Oct 22, 1996
- adapted to Postgres95-1.08 - adapted to Postgres95-1.08
@ -30,29 +50,18 @@ Revision history for Perl extension Pg.
- PQnotifies() works now - PQnotifies() works now
- enhanced doQuery() - enhanced doQuery()
1.3.2 Nov 11, 1996 1.2.0 Oct 15, 1995
- adapted to Postgres95-1.09 - adapted to Postgres95-1.0
- test.pl adapted to postgres95-1.0.9: - README updated
PQputline expects now '\.' as last input - doQuery() in Pg.pm now returns 0 upon success
and PQgetline outputs '\.' as last line. - 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.4.2 Nov 21, 1996 1.1 Jun 6, 1995
- added a more Perl-like syntax - Bug fix in PQgetline.
1.0 Mar 24, 1995
1.5.3 Jan 2, 1997 - creation
- 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.1 Jun 02 1997
- renamed to pgsql_perl5
- adapted to PostgreSQL-6.1
- test only functions, which are also
tested in pgsql regression tests

6
src/interfaces/perl5/MANIFEST
View File

@ -1,11 +1,11 @@
ApachePg.pl
Changes Changes
MANIFEST MANIFEST
Makefile.PL Makefile.PL
Pg.pm Pg.pm
Pg.xs Pg.xs
README README
eg/ApachePg.pl
eg/example.newstyle
eg/example.oldstyle
test.pl test.pl
test.pl.newstyle
test.pl.oldstyle
typemap typemap

18
src/interfaces/perl5/Makefile.PL
View File

@ -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 # Copyright (c) 1997 Edmund Mergl
# #
@ -12,27 +12,27 @@ print "\nConfiguring Pg\n";
print "Remember to actually read the README file !\n"; print "Remember to actually read the README file !\n";
die "\nYou didn't read the README file !\n" unless ($] >= 5.003); die "\nYou didn't read the README file !\n" unless ($] >= 5.003);
if (! $ENV{POSTGRESHOME}) { if (! $ENV{POSTGRES_HOME}) {
warn "\$POSTGRESHOME not defined. Searching for Postgres...\n"; 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)) { foreach(qw(/usr/pgsql /usr/local/pgsql /usr/pgsql-6.1 /usr/local/pgsql-6.1)) {
if (-d "$_/lib") { if (-d "$_/lib") {
$ENV{POSTGRESHOME} = $_; $ENV{POSTGRES_HOME} = $_;
last; last;
} }
} }
} }
if ($ENV{POSTGRESHOME}) { if ($ENV{POSTGRES_HOME}) {
print "\nFound Postgres in $ENV{POSTGRESHOME}\n"; print "\nFound PostgreSQL in $ENV{POSTGRES_HOME}\n";
} else { } else {
die "Unable to determine \$POSTGRESHOME !\n"; die "Unable to determine \$POSTGRES_HOME !\n";
} }
WriteMakefile( WriteMakefile(
'NAME' => 'Pg', 'NAME' => 'Pg',
'VERSION_FROM' => 'Pg.pm', 'VERSION_FROM' => 'Pg.pm',
'LIBS' => ["-L$ENV{POSTGRESHOME}/lib -lpq"], 'LIBS' => ["-L$ENV{POSTGRES_HOME}/lib -lpq"],
'INC' => "-I$ENV{POSTGRESHOME}/include", 'INC' => "-I$ENV{POSTGRES_HOME}/include",
); );
# EOF # EOF

32
src/interfaces/perl5/Pg.pm
View File

@ -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 # Copyright (c) 1997 Edmund Mergl
# #
@ -15,7 +15,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
require Exporter; require Exporter;
require DynaLoader; require DynaLoader;
require AutoLoader; require AutoLoader;
require 5.003; require 5.002;
@ISA = qw(Exporter DynaLoader); @ISA = qw(Exporter DynaLoader);
@ -50,6 +50,7 @@ require 5.003;
PQfsize PQfsize
PQcmdStatus PQcmdStatus
PQoidStatus PQoidStatus
PQcmdTuples
PQgetvalue PQgetvalue
PQgetlength PQgetlength
PQgetisnull PQgetisnull
@ -83,7 +84,7 @@ require 5.003;
PGRES_InvalidOid PGRES_InvalidOid
); );
$VERSION = '1.6.1'; $Pg::VERSION = '1.6.2';
sub AUTOLOAD { sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant() # This AUTOLOAD is used to 'autoload' constants from the constant()
@ -140,7 +141,7 @@ __END__
=head1 NAME =head1 NAME
Pg - Perl extension for PostgreSQL Pg - Perl5 extension for PostgreSQL
=head1 SYNOPSIS =head1 SYNOPSIS
@ -194,7 +195,7 @@ to an object goes away.
=head2 old style =head2 old style
All functions and constants are imported into the calling 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 all functions start with 'PQ' (e.g. PQlo_open) and all
constants start with 'PGRES_' (e.g. PGRES_CONNECTION_OK). 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 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 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 to the PGconn structure ) must be used in subsequent commands for unique
identification. Before using $conn you should call $conn->status to ensure, identification. Before using $conn you should call $conn->status to ensure,
that the connection was properly made. Use the methods below to access 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. 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. Returns the number of tuples in the query result.
@ -430,13 +431,22 @@ command executed:
$cmdStatus = $result->cmdStatus $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 $oid = $result->oidStatus
In case the last query was an INSERT command it returns the oid of the In case the last query was an INSERT command it returns the oid of the
inserted tuple. 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) $result->printTuples($fout, $printAttName, $terseOutput, $width)
Kept for backward compatibility. Use print. 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. These functions provide file-oriented access to user data.
The large object interface is modeled after the Unix file 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 lseek, tell. In order to get a consistent naming, all function
names have been prepended with 'PQ' (old style only). names have been prepended with 'PQ' (old style only).
$lobjId = $conn->lo_creat($mode) $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: different attributes of the new object. Use the following constants:
- PGRES_INV_SMGRMASK - PGRES_INV_SMGRMASK
@ -529,6 +539,6 @@ Returns -1 upon failure, 1 otherwise.
=head1 SEE ALSO =head1 SEE ALSO
libpq(3), large_objects(3). L<libpq>, L<large_objects>
=cut =cut

44
src/interfaces/perl5/Pg.xs
View File

@ -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 * Copyright (c) 1997 Edmund Mergl
* *
@ -10,21 +10,9 @@
#include "perl.h" #include "perl.h"
#include "XSUB.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" #include "libpq-fe.h"
typedef struct pg_conn* PG_conn; typedef struct pg_conn* PG_conn;
typedef struct pg_result* PG_result; typedef struct pg_result* PG_result;
@ -375,7 +363,7 @@ PQftype(res, field_num)
int field_num int field_num
int2 short
PQfsize(res, field_num) PQfsize(res, field_num)
PGresult * res PGresult * res
int field_num int field_num
@ -398,6 +386,18 @@ PQoidStatus(res)
RETVAL RETVAL
char *
PQcmdTuples(res)
PGresult * res
PREINIT:
const char *GAGA;
CODE:
GAGA = PQcmdTuples(res);
RETVAL = (char *)GAGA;
OUTPUT:
RETVAL
char * char *
PQgetvalue(res, tup_num, field_num) PQgetvalue(res, tup_num, field_num)
PGresult * res PGresult * res
@ -872,7 +872,7 @@ PQftype(res, field_num)
int field_num int field_num
int2 short
PQfsize(res, field_num) PQfsize(res, field_num)
PG_result res PG_result res
int field_num int field_num
@ -895,6 +895,18 @@ PQoidStatus(res)
RETVAL RETVAL
char *
PQcmdTuples(res)
PG_result res
PREINIT:
const char *GAGA;
CODE:
GAGA = PQcmdTuples(res);
RETVAL = (char *)GAGA;
OUTPUT:
RETVAL
char * char *
PQgetvalue(res, tup_num, field_num) PQgetvalue(res, tup_num, field_num)
PG_result res PG_result res

56
src/interfaces/perl5/README
View File

@ -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 # Copyright (c) 1997 Edmund Mergl
# #
@ -9,32 +9,27 @@
DESCRIPTION: 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 Pgsql_perl5 is an interface between Larry Wall's language perl version 5 and
database PostgreSQL (previously Postgres95). This has been done by using the the database PostgreSQL (previously Postgres95). This has been done by using
Perl5 application programming interface for C extensions which calls the the Perl5 application programming interface for C extensions which calls the
Postgres programmer's interface LIBQ. Pgsql_perl5 tries to implement the LIBPQ- Postgres programmer's interface LIBPQ. Pgsql_perl5 tries to implement the LIBPQ-
interface as close, as possible. 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 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 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++- perl. The new style uses class packages and might be more familiar for C++-
programmers. programmers.
COPYRIGHT: COPYRIGHT:
---------- ----------
This program is free software; you can redistribute it and/or modify You may distribute under the terms of either the GNU General Public
it under the terms of either: License or the Artistic License, as specified in the Perl README file.
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.
@ -53,8 +48,8 @@ in your bug-report.
REQUIREMENTS: REQUIREMENTS:
------------- -------------
- perl5.003 - build, test and install Perl 5 (at least 5.002)
- PostgreSQL-6.1 - build, test and install PostgreSQL (at least 6.2)
PLATFORMS: PLATFORMS:
@ -62,18 +57,18 @@ PLATFORMS:
This release of pgsql_perl5 has been developed using Linux 2.0 with 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 dynamic loading for the perl extensions. Let me know, if there are
any problems with other platforms. any problems with other platforms.
INSTALLATION: INSTALLATION:
------------- -------------
Using dynamic loading for perl extensions, the preferred method is to unpack 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 the tar file outside the perl source tree. This assumes, that you already
have installed perl5. have installed perl5.
The Makefile checks the environment variable POSTGRESHOME as well some The Makefile checks the environment variable POSTGRES_HOME as well some
standard locations, to find the root directory of your Postgres installation. standard locations, to find the root directory of your Postgres installation.
1. perl Makefile.PL 1. perl Makefile.PL
2. make 2. make
@ -87,19 +82,18 @@ TESTING:
-------- --------
Run 'make test'. Run 'make test'.
Note, that the user running this script must have been created with Note, that the user running this script must have been created with the access
the access rights to create databases *AND* users ! Do not run this rights to create databases *AND* users ! Do not run this script as root !
script as root !
If you are using the shared library libpq.so, make sure, your dynamic loader 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 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 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. Some linux distributions have an incomplete perl installation.
If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a
'find /usr/lib/perl5 -name XSUB.h -print' '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: DOCUMENTATION:
@ -111,6 +105,6 @@ installation to read the documentation.
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
Edmund Mergl <E.Mergl@bawue.de> June 02, 1997 Edmund Mergl <E.Mergl@bawue.de> September 20, 1997
--------------------------------------------------------------------------- ---------------------------------------------------------------------------

320
src/interfaces/perl5/test.pl.newstyle
View File

@ -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

344
src/interfaces/perl5/test.pl.oldstyle
View File

@ -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

2
src/interfaces/perl5/typemap
View File

@ -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 # Copyright (c) 1997 Edmund Mergl
# #