*** empty log message ***
This commit is contained in:
Edmund Mergl
parent
b02086b303
commit
9e74edda05
|
|
@ -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;
|
||||
|
||||
|
|
@ -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.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.4.2 Nov 21, 1996
|
||||
- added a more Perl-like syntax
|
||||
1.1 Jun 6, 1995
|
||||
- Bug fix in PQgetline.
|
||||
|
||||
|
||||
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.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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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<libpq>, L<large_objects>
|
||||
|
||||
=cut
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <E.Mergl@bawue.de> June 02, 1997
|
||||
Edmund Mergl <E.Mergl@bawue.de> September 20, 1997
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
#
|
||||
|
|
|
|||
Loading…
Reference in New Issue