database/postgres
database/postgres
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-04-24 10:47:04 +03:00
Code

pgsql_perl5-1.8.0

Browse Source
This commit is contained in:
Edmund Mergl 1998-09-27 19:12:35 +00:00
parent bd041d82bf
commit 376fbadbd2
10 changed files with 989 additions and 728 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/interfaces/perl5/Changes
View File

@ -1,6 +1,6 @@
#------------------------------------------------------- #-------------------------------------------------------
# #
# $Id: Changes,v 1.7 1998/06/01 16:41:18 mergl Exp $ # $Id: Changes,v 1.8 1998/09/27 19:12:20 mergl Exp $
# #
# Copyright (c) 1997, 1998 Edmund Mergl # Copyright (c) 1997, 1998 Edmund Mergl
# #
@ -8,6 +8,25 @@
Revision history for Perl extension Pg. Revision history for Perl extension Pg.
1.8.0 Sep 27 1998
- adapted to PostgreSQL-6.4:
added support for
o PQsetdbLogin
o PQpass
o PQsocket
o PQbackendPID
o PQsendQuery
o PQgetResult
o PQisBusy
o PQconsumeInput
o PQrequestCancel
o PQgetlineAsync
o PQputnbytes
o PQmakeEmptyPGresult
o PQbinaryTuples
o PQfmod
- fixed conndefaults()
- fixed lo_read
1.7.4 May 28 1998 1.7.4 May 28 1998
- applied patches from - applied patches from

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

@ -1,6 +1,6 @@
#------------------------------------------------------- #-------------------------------------------------------
# #
# $Id: Makefile.PL,v 1.8 1998/06/01 16:41:19 mergl Exp $ # $Id: Makefile.PL,v 1.9 1998/09/27 19:12:21 mergl Exp $
# #
# Copyright (c) 1997, 1998 Edmund Mergl # Copyright (c) 1997, 1998 Edmund Mergl
# #

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

@ -1,6 +1,6 @@
#------------------------------------------------------- #-------------------------------------------------------
# #
# $Id: Pg.pm,v 1.7 1998/06/01 16:41:19 mergl Exp $ # $Id: Pg.pm,v 1.8 1998/09/27 19:12:22 mergl Exp $
# #
# Copyright (c) 1997, 1998 Edmund Mergl # Copyright (c) 1997, 1998 Edmund Mergl
# #
@ -22,32 +22,46 @@ require 5.002;
# Items to export into callers namespace by default. # Items to export into callers namespace by default.
@EXPORT = qw( @EXPORT = qw(
PQconnectdb PQconnectdb
PQconndefaults PQsetdbLogin
PQsetdb PQsetdb
PQconndefaults
PQfinish PQfinish
PQreset PQreset
PQrequestCancel
PQdb PQdb
PQuser PQuser
PQpass
PQhost PQhost
PQoptions
PQport PQport
PQtty PQtty
PQoptions
PQstatus PQstatus
PQerrorMessage PQerrorMessage
PQsocket
PQbackendPID
PQtrace PQtrace
PQuntrace PQuntrace
PQexec PQexec
PQgetline
PQendcopy
PQputline
PQnotifies PQnotifies
PQsendQuery
PQgetResult
PQisBusy
PQconsumeInput
PQgetline
PQputline
PQgetlineAsync
PQputnbytes
PQendcopy
PQmakeEmptyPGresult
PQresultStatus PQresultStatus
PQntuples PQntuples
PQnfields PQnfields
PQbinaryTuples
PQfname PQfname
PQfnumber PQfnumber
PQftype PQftype
PQfsize PQfsize
PQfmod
PQcmdStatus PQcmdStatus
PQoidStatus PQoidStatus
PQcmdTuples PQcmdTuples
@ -55,8 +69,9 @@ require 5.002;
PQgetlength PQgetlength
PQgetisnull PQgetisnull
PQclear PQclear
PQprintTuples
PQprint PQprint
PQdisplayTuples
PQprintTuples
PQlo_open PQlo_open
PQlo_close PQlo_close
PQlo_read PQlo_read
@ -84,7 +99,7 @@ require 5.002;
PGRES_InvalidOid PGRES_InvalidOid
); );
$Pg::VERSION = '1.7.4'; $Pg::VERSION = '1.8.0';
sub AUTOLOAD { sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant() # This AUTOLOAD is used to 'autoload' constants from the constant()
@ -145,15 +160,15 @@ Pg - Perl5 extension for PostgreSQL
new style: new style:
use Pg; use Pg;
$conn = Pg::connectdb("dbname = template1"); $conn = Pg::connectdb("dbname=template1");
$result = $conn->exec("create database test"); $result = $conn->exec("create database pgtest");
you may also use the old style: old style (depreciated):
use Pg; use Pg;
$conn = PQsetdb('', '', '', '', template1); $conn = PQsetdb('', '', '', '', template1);
$result = PQexec($conn, "create database test"); $result = PQexec($conn, "create database pgtest");
PQclear($result); PQclear($result);
PQfinish($conn); PQfinish($conn);
@ -232,41 +247,58 @@ implemented in perl using lists or hash.
=head1 FUNCTIONS =head1 FUNCTIONS
The functions have been divided into three sections: The functions have been divided into three sections:
Connection, Result, Large Objects. Connection, Result, Large Objects. For details please
read L<libpq>.
=head2 1. Connection =head2 1. Connection
With these functions you can establish and close a connection to a With these functions you can establish and close a connection to a
database. In Libpq a connection is represented by a structure called database. In Libpq a connection is represented by a structure called
PGconn. Using the appropriate methods you can access almost all PGconn.
fields of this structure.
When opening a connection a given database name is always converted to
lower-case, unless it is surrounded by double quotes. All unspecified
parameters are replaced by environment variables or by hard coded defaults:
parameter environment variable hard coded default
--------------------------------------------------
host PGHOST localhost
port PGPORT 5432
options PGOPTIONS ""
tty PGTTY ""
dbname PGDATABASE current userid
user PGUSER current userid
password PGPASSWORD ""
Using appropriate methods you can access almost all fields of the
returned PGconn structure.
$conn = Pg::setdbLogin($pghost, $pgport, $pgoptions, $pgtty, $dbname, $login, $pwd)
Opens a new connection to the backend. 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.
$conn = Pg::setdb($pghost, $pgport, $pgoptions, $pgtty, $dbname) $conn = Pg::setdb($pghost, $pgport, $pgoptions, $pgtty, $dbname)
Opens a new connection to the backend. You may use an empty string for The method setdb should be used when username/password authentication is
any argument, in which case first the environment is checked and then not needed.
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
the contents of the PGconn structure.
$conn = Pg::connectdb("option1=value option2=value ...") $conn = Pg::connectdb("option1=value option2=value ...")
Opens a new connection to the backend using connection information in a string. Opens a new connection to the backend using connection information in a
Possible options are: dbname, host, user, password, authtype, port, tty, options. string. Possible options are: host, port, options, tty, dbname, user, password.
The database-name will be converted to lower-case, unless it is surrounded by The connection identifier $conn (a pointer to the PGconn structure)
double quotes. The connection identifier $conn (a pointer to the PGconn structure) must be used in subsequent commands for unique identification. Before using
must be used in subsequent commands for unique identification. Before using $conn $conn you should call $conn->status to ensure, that the connection was
you should call $conn->status to ensure, that the connection was properly made. properly made.
Use the methods below to access the contents of the PGconn structure.
$Option_ref = Pg::conndefaults() $Option_ref = Pg::conndefaults()
while(($key, $val) = each %$Option_ref) { while(($key, $val) = each %$Option_ref) {
print "$key, $val\n"; print "$key, $val\n";
}
Returns a reference to a hash containing as keys all possible options for Returns a reference to a hash containing as keys all possible options for
connectdb(). The values are the current defaults. This function differs from connectdb(). The values are the current defaults. This function differs from
@ -275,13 +307,20 @@ his C-counterpart, which returns the complete conninfoOption structure.
PQfinish($conn) PQfinish($conn)
Old style only ! Old style only !
Closes the connection to the backend and frees all memory. Closes the connection to the backend and frees the connection data structure.
$conn->reset $conn->reset
Resets the communication port with the backend and tries Resets the communication port with the backend and tries
to establish a new connection. to establish a new connection.
$ret = $conn->requestCancel
Abandon processing of the current query. Regardless of the return value of
requestCancel, the application must continue with the normal result-reading
sequence using getResult. If the current query is part of a transaction,
cancellation will abort the whole transaction.
$dbname = $conn->db $dbname = $conn->db
Returns the database name of the connection. Returns the database name of the connection.
@ -290,14 +329,14 @@ Returns the database name of the connection.
Returns the Postgres user name of the connection. Returns the Postgres user name of the connection.
$pguser = $conn->pass
Returns the Postgres password of the connection.
$pghost = $conn->host $pghost = $conn->host
Returns the host name of the connection. Returns the host name of the connection.
$pgoptions = $conn->options
Returns the options used in the connection.
$pgport = $conn->port $pgport = $conn->port
Returns the port of the connection. Returns the port of the connection.
@ -306,6 +345,10 @@ Returns the port of the connection.
Returns the tty of the connection. Returns the tty of the connection.
$pgoptions = $conn->options
Returns the options used in the connection.
$status = $conn->status $status = $conn->status
Returns the status of the connection. For comparing the status Returns the status of the connection. For comparing the status
@ -318,6 +361,15 @@ you may use the following constants:
Returns the last error message associated with this connection. Returns the last error message associated with this connection.
$fd = $conn->socket
Obtain the file descriptor number for the backend connection socket.
A result of -1 indicates that no backend connection is currently open.
$pid = $conn->backendPID
Returns the process-id of the corresponding backend proceess.
$conn->trace(debug_port) $conn->trace(debug_port)
Messages passed between frontend and backend are echoed to the Messages passed between frontend and backend are echoed to the
@ -338,28 +390,6 @@ structure has to be freed using PQfree. Before using $result you
should call resultStatus to ensure, that the query was should call resultStatus to ensure, that the query was
properly executed. properly executed.
$ret = $conn->getline($string, $length)
Reads a string up to $length - 1 characters from the backend.
getline returns EOF at EOF, 0 if the entire line has been read,
and 1 if the buffer is full. If a line consists of the two
characters "\." the backend has finished sending the results of
the copy command.
$conn->putline($string)
Sends a string to the backend. The application must explicitly
send the two characters "\." to indicate to the backend that
it has finished sending its data.
$ret = $conn->endcopy
This function waits until the backend has finished the copy.
It should either be issued when the last string has been sent
to the backend using putline or when the last string has
been received from the backend using getline. endcopy returns
0 on success, nonzero otherwise.
($table, $pid) = $conn->notifies ($table, $pid) = $conn->notifies
Checks for asynchronous notifications. This functions differs from Checks for asynchronous notifications. This functions differs from
@ -368,6 +398,69 @@ whereas the perl implementation returns a list. $table is the table
which has been listened to and $pid is the process id of the backend. which has been listened to and $pid is the process id of the backend.
$ret = $conn->sendQuery($string, $query)
Submit a query to Postgres without waiting for the result(s). After
successfully calling PQsendQuery, call PQgetResult one or more times
to obtain the query results. PQsendQuery may not be called again until
getResult has returned NULL, indicating that the query is done.
$result = $conn->getResult
Wait for the next result from a prior PQsendQuery, and return it. NULL
is returned when the query is complete and there will be no more results.
getResult will block only if a query is active and the necessary response
data has not yet been read by PQconsumeInput.
$ret = $conn->isBusy
Returns TRUE if a query is busy, that is, PQgetResult would block waiting
for input. A FALSE return indicates that PQgetResult can be called with
assurance of not blocking.
$result = $conn->consumeInput
If input is available from the backend, consume it. After calling consumeInput,
the application may check isBusy and/or notifies to see if their state has changed.
$ret = $conn->getline($string, $length)
Reads a string up to $length - 1 characters from the backend.
getline returns EOF at EOF, 0 if the entire line has been read,
and 1 if the buffer is full. If a line consists of the two
characters "\." the backend has finished sending the results of
the copy command.
$ret = $conn->putline($string)
Sends a string to the backend. The application must explicitly
send the two characters "\." to indicate to the backend that
it has finished sending its data.
$ret = $conn->getlineAsync($buffer, $bufsize)
Non-blocking version of getline. It reads up to $bufsize
characters from the backend. getlineAsync returns -1 if
the end-of-copy-marker has been recognized, 0 if no data
is avilable, and >0 the number of bytes returned.
$ret = $conn->putnbytes($buffer, $nbytes)
Sends n bytes to the backend. Returns 0 if OK, EOF if not.
$ret = $conn->endcopy
This function waits until the backend has finished the copy.
It should either be issued when the last string has been sent
to the backend using putline or when the last string has
been received from the backend using getline. endcopy returns
0 on success, 1 on failure.
$result = $conn->makeEmptyPGresult($status);
Returns a newly allocated, initialized result with given status.
=head2 2. Result =head2 2. Result
With these functions you can send commands to a database and With these functions you can send commands to a database and
@ -375,6 +468,21 @@ investigate the results. In Libpq the result of a command is
represented by a structure called PGresult. Using the appropriate represented by a structure called PGresult. Using the appropriate
methods you can access almost all fields of this structure. methods you can access almost all fields of this structure.
$result_status = $result->resultStatus
Returns the status of the result. For comparing the status you
may use one of the following constants depending upon the
command executed:
- PGRES_EMPTY_QUERY
- PGRES_COMMAND_OK
- PGRES_TUPLES_OK
- PGRES_COPY_OUT
- PGRES_COPY_IN
- PGRES_BAD_RESPONSE
- PGRES_NONFATAL_ERROR
- PGRES_FATAL_ERROR
Use the functions below to access the contents of the PGresult structure. Use the functions below to access the contents of the PGresult structure.
$ntuples = $result->ntuples $ntuples = $result->ntuples
@ -385,6 +493,10 @@ Returns the number of tuples in the query result.
Returns the number of fields in the query result. Returns the number of fields in the query result.
$ret = $result->binaryTuples
Returns 1 if the tuples in the query result are bianry.
$fname = $result->fname($field_num) $fname = $result->fname($field_num)
Returns the field name associated with the given field number. Returns the field name associated with the given field number.
@ -402,34 +514,10 @@ Returns the oid of the type of the given field number.
Returns the size in bytes of the type of the given field number. Returns the size in bytes of the type of the given field number.
It returns -1 if the field has a variable length. It returns -1 if the field has a variable length.
$value = $result->getvalue($tup_num, $field_num) $fmod = $result->fmod($field_num)
Returns the value of the given tuple and field. This is Returns the type-specific modification data of the field associated
a null-terminated ASCII string. Binary cursors will not with the given field index. Field indices start at 0.
work.
$length = $result->getlength($tup_num, $field_num)
Returns the length of the value for a given tuple and field.
$null_status = $result->getisnull($tup_num, $field_num)
Returns the NULL status for a given tuple and field.
$result_status = $result->resultStatus
Returns the status of the result. For comparing the status you
may use one of the following constants depending upon the
command executed:
- PGRES_EMPTY_QUERY
- PGRES_COMMAND_OK
- PGRES_TUPLES_OK
- PGRES_COPY_OUT
- PGRES_COPY_IN
- PGRES_BAD_RESPONSE
- PGRES_NONFATAL_ERROR
- PGRES_FATAL_ERROR
$cmdStatus = $result->cmdStatus $cmdStatus = $result->cmdStatus
@ -449,9 +537,30 @@ inserted tuple.
In case the last query was an INSERT or DELETE command it returns the In case the last query was an INSERT or DELETE command it returns the
number of affected tuples. number of affected tuples.
$result->printTuples($fout, $printAttName, $terseOutput, $width) $value = $result->getvalue($tup_num, $field_num)
Kept for backward compatibility. Use print. Returns the value of the given tuple and field. This is
a null-terminated ASCII string. Binary cursors will not
work.
$length = $result->getlength($tup_num, $field_num)
Returns the length of the value for a given tuple and field.
$null_status = $result->getisnull($tup_num, $field_num)
Returns the NULL status for a given tuple and field.
PQclear($result)
Old style only !
Frees all memory of the given result.
$res->fetchrow
New style only !
Fetches the next row from the server and returns NULL if all rows
have been processed. Columns which have NULL as value will be set to C<undef>.
$result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...) $result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...)
@ -464,10 +573,13 @@ are boolean flags. The arguments $fieldSep, $tableOpt, $caption
are strings. You may append additional strings, which will be are strings. You may append additional strings, which will be
taken as replacement for the field names. taken as replacement for the field names.
PQclear($result) $result->displayTuples($fp, $fillAlign, $fieldSep, $printHeader, qiet)
Old style only ! Kept for backward compatibility. Use print.
Frees all memory of the given result.
$result->printTuples($fout, $printAttName, $terseOutput, $width)
Kept for backward compatibility. Use print.
=head2 3. Large Objects =head2 3. Large Objects
@ -478,22 +590,6 @@ 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)
Creates a new large object. $mode is a bit-mask describing
different attributes of the new object. Use the following constants:
- PGRES_INV_SMGRMASK
- PGRES_INV_ARCHIVE
- PGRES_INV_WRITE
- PGRES_INV_READ
Upon failure it returns PGRES_InvalidOid.
$ret = $conn->lo_unlink($lobjId)
Deletes a large object. Returns -1 upon failure.
$lobj_fd = $conn->lo_open($lobjId, $mode) $lobj_fd = $conn->lo_open($lobjId, $mode)
Opens an existing large object and returns an object id. Opens an existing large object and returns an object id.
@ -519,11 +615,27 @@ Returns the number of bytes written and -1 upon failure.
Change the current read or write location on the large object Change the current read or write location on the large object
$obj_id. Currently $whence can only be 0 (L_SET). $obj_id. Currently $whence can only be 0 (L_SET).
$lobjId = $conn->lo_creat($mode)
Creates a new large object. $mode is a bit-mask describing
different attributes of the new object. Use the following constants:
- PGRES_INV_SMGRMASK
- PGRES_INV_ARCHIVE
- PGRES_INV_WRITE
- PGRES_INV_READ
Upon failure it returns PGRES_InvalidOid.
$location = $conn->lo_tell($lobj_fd) $location = $conn->lo_tell($lobj_fd)
Returns the current read or write location on the large object Returns the current read or write location on the large object
$lobj_fd. $lobj_fd.
$ret = $conn->lo_unlink($lobjId)
Deletes a large object. Returns -1 upon failure.
$lobjId = $conn->lo_import($filename) $lobjId = $conn->lo_import($filename)
Imports a Unix file as large object and returns Imports a Unix file as large object and returns

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

@ -1,6 +1,6 @@
/*------------------------------------------------------- /*-------------------------------------------------------
* *
* $Id: Pg.xs,v 1.8 1998/09/03 02:10:56 momjian Exp $ * $Id: Pg.xs,v 1.9 1998/09/27 19:12:23 mergl Exp $
* *
* Copyright (c) 1997, 1998 Edmund Mergl * Copyright (c) 1997, 1998 Edmund Mergl
* *
@ -10,8 +10,11 @@
#include "perl.h" #include "perl.h"
#include "XSUB.h" #include "XSUB.h"
#include <string.h> #include <string.h>
#include <stdio.h>
#include <fcntl.h>
#include "libpq-fe.h" #include "libpq-fe.h"
#include "libpq-int.h" /* need this for sizeof(PGresult) */
typedef struct pg_conn *PG_conn; typedef struct pg_conn *PG_conn;
typedef struct pg_result *PG_result; typedef struct pg_result *PG_result;
@ -28,8 +31,7 @@ typedef struct pg_results *PG_results;
static double static double
constant(name, arg) constant(name, arg)
char *name; char *name;
int arg; int arg; {
{
errno = 0; errno = 0;
switch (*name) { switch (*name) {
case 'A': case 'A':
@ -178,10 +180,6 @@ not_there:
MODULE = Pg PACKAGE = Pg MODULE = Pg PACKAGE = Pg
PROTOTYPES: DISABLE PROTOTYPES: DISABLE
@ -200,11 +198,11 @@ PQconnectdb(conninfo)
/* convert dbname to lower case if not surrounded by double quotes */ /* convert dbname to lower case if not surrounded by double quotes */
char *ptr = strstr(conninfo, "dbname"); char *ptr = strstr(conninfo, "dbname");
if (ptr) { if (ptr) {
ptr += 6; while (*ptr && *ptr != '=') {
while (*ptr && *ptr++ != '=') { ptr++;
;
} }
while (*ptr && (*ptr == ' ' || *ptr == '\t')) { ptr++;
while (*ptr == ' ' || *ptr == '\t') {
ptr++; ptr++;
} }
if (*ptr == '"') { if (*ptr == '"') {
@ -226,19 +224,15 @@ PQconnectdb(conninfo)
RETVAL RETVAL
HV * PGconn *
PQconndefaults() PQsetdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd)
CODE: char * pghost
PQconninfoOption *infoOption; char * pgport
RETVAL = newHV(); char * pgoptions
if (infoOption = PQconndefaults()) { char * pgtty
while (infoOption->keyword != NULL) { char * dbname
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0); char * login
infoOption++; char * pwd
}
}
OUTPUT:
RETVAL
PGconn * PGconn *
@ -250,6 +244,25 @@ PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
char * dbname char * dbname
HV *
PQconndefaults()
CODE:
PQconninfoOption *infoOption;
RETVAL = newHV();
if (infoOption = PQconndefaults()) {
while (infoOption->keyword != NULL) {
if (infoOption->val != NULL) {
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
} else {
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv("", 0), 0);
}
infoOption++;
}
}
OUTPUT:
RETVAL
void void
PQfinish(conn) PQfinish(conn)
PGconn * conn PGconn * conn
@ -260,6 +273,10 @@ PQreset(conn)
PGconn * conn PGconn * conn
int
PQrequestCancel(conn)
PGconn * conn
char * char *
PQdb(conn) PQdb(conn)
PGconn * conn PGconn * conn
@ -271,12 +288,12 @@ PQuser(conn)
char * char *
PQhost(conn) PQpass(conn)
PGconn * conn PGconn * conn
char * char *
PQoptions(conn) PQhost(conn)
PGconn * conn PGconn * conn
@ -290,6 +307,11 @@ PQtty(conn)
PGconn * conn PGconn * conn
char *
PQoptions(conn)
PGconn * conn
ConnStatusType ConnStatusType
PQstatus(conn) PQstatus(conn)
PGconn * conn PGconn * conn
@ -300,6 +322,16 @@ PQerrorMessage(conn)
PGconn * conn PGconn * conn
int
PQsocket(conn)
PGconn * conn
int
PQbackendPID(conn)
PGconn * conn
void void
PQtrace(conn, debug_port) PQtrace(conn, debug_port)
PGconn * conn PGconn * conn
@ -318,37 +350,13 @@ PQexec(conn, query)
char * query char * query
CODE: CODE:
RETVAL = PQexec(conn, query); RETVAL = PQexec(conn, query);
if (! RETVAL) { RETVAL = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR); } if (! RETVAL) {
RETVAL = (PGresult *)calloc(1, sizeof(PGresult));
}
OUTPUT: OUTPUT:
RETVAL RETVAL
int
PQgetline(conn, string, length)
PREINIT:
SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PGconn * conn
int length
char * string = sv_grow(sv_buffer, length);
CODE:
RETVAL = PQgetline(conn, string, length);
OUTPUT:
RETVAL
string
int
PQendcopy(conn)
PGconn * conn
void
PQputline(conn, string)
PGconn * conn
char * string
void void
PQnotifies(conn) PQnotifies(conn)
PGconn * conn PGconn * conn
@ -363,6 +371,88 @@ PQnotifies(conn)
} }
int
PQsendQuery(conn, query)
PGconn * conn
char * query
PGresult *
PQgetResult(conn)
PGconn * conn
CODE:
RETVAL = PQgetResult(conn);
if (! RETVAL) {
RETVAL = (PGresult *)calloc(1, sizeof(PGresult));
}
OUTPUT:
RETVAL
int
PQisBusy(conn)
PGconn * conn
int
PQconsumeInput(conn)
PGconn * conn
int
PQgetline(conn, string, length)
PREINIT:
SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PGconn * conn
int length
char * string = sv_grow(bufsv, length);
CODE:
RETVAL = PQgetline(conn, string, length);
OUTPUT:
RETVAL
string
int
PQputline(conn, string)
PGconn * conn
char * string
int
PQgetlineAsync(conn, buffer, bufsize)
PREINIT:
SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PGconn * conn
int bufsize
char * buffer = sv_grow(bufsv, bufsize);
CODE:
RETVAL = PQgetlineAsync(conn, buffer, bufsize);
OUTPUT:
RETVAL
buffer
int
PQputnbytes(conn, buffer, nbytes)
PGconn * conn
char * buffer
int nbytes
int
PQendcopy(conn)
PGconn * conn
PGresult *
PQmakeEmptyPGresult(conn, status)
PGconn * conn
ExecStatusType status
ExecStatusType ExecStatusType
PQresultStatus(res) PQresultStatus(res)
PGresult * res PGresult * res
@ -378,6 +468,11 @@ PQnfields(res)
PGresult * res PGresult * res
int
PQbinaryTuples(res)
PGresult * res
char * char *
PQfname(res, field_num) PQfname(res, field_num)
PGresult * res PGresult * res
@ -402,6 +497,12 @@ PQfsize(res, field_num)
int field_num int field_num
int
PQfmod(res, field_num)
PGresult * res
int field_num
char * char *
PQcmdStatus(res) PQcmdStatus(res)
PGresult * res PGresult * res
@ -451,37 +552,16 @@ PQclear(res)
PGresult * res PGresult * res
void
PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
PGresult * res
FILE * fp
int fillAlign
char * fieldSep
int printHeader
int quiet
CODE:
PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
void
PQprintTuples(res, fout, printAttName, terseOutput, width)
PGresult * res
FILE * fout
int printAttName
int terseOutput
int width
void void
PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...) PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
FILE * fout FILE * fout
PGresult * res PGresult * res
bool header pqbool header
bool align pqbool align
bool standard pqbool standard
bool html3 pqbool html3
bool expanded pqbool expanded
bool pager pqbool pager
char * fieldSep char * fieldSep
char * tableOpt char * tableOpt
char * caption char * caption
@ -506,6 +586,27 @@ PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, ta
Safefree(ps.fieldName); Safefree(ps.fieldName);
void
PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
PGresult * res
FILE * fp
int fillAlign
char * fieldSep
int printHeader
int quiet
CODE:
PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
void
PQprintTuples(res, fout, printAttName, terseOutput, width)
PGresult * res
FILE * fout
int printAttName
int terseOutput
int width
int int
lo_open(conn, lobjId, mode) lo_open(conn, lobjId, mode)
PGconn * conn PGconn * conn
@ -528,22 +629,21 @@ lo_read(conn, fd, buf, len)
ALIAS: ALIAS:
PQlo_read = 1 PQlo_read = 1
PREINIT: PREINIT:
SV *sv_buffer = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
INPUT: INPUT:
PGconn * conn PGconn * conn
int fd int fd
int len int len
char * buf = sv_grow(sv_buffer, len + 1); char * buf = sv_grow(bufsv, len + 1);
CLEANUP: CODE:
if (RETVAL >= 0) { RETVAL = lo_read(conn, fd, buf, len);
SvCUR(sv_buffer) = RETVAL; if (RETVAL > 0) {
SvPOK_only(sv_buffer); SvCUR_set(bufsv, RETVAL);
*SvEND(sv_buffer) = '\0'; *SvEND(bufsv) = '\0';
if (tainting) {
sv_magic(sv_buffer, 0, 't', 0, 0);
} }
} OUTPUT:
RETVAL
buf
int int
lo_write(conn, fd, buf, len) lo_write(conn, fd, buf, len)
@ -641,17 +741,17 @@ connectdb(conninfo)
RETVAL RETVAL
HV * PG_conn
conndefaults() setdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd)
char * pghost
char * pgport
char * pgoptions
char * pgtty
char * dbname
char * login
char * pwd
CODE: CODE:
PQconninfoOption *infoOption; RETVAL = PQsetdb(pghost, pgport, pgoptions, pgtty, dbname);
RETVAL = newHV();
if (infoOption = PQconndefaults()) {
while (infoOption->keyword != NULL) {
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
infoOption++;
}
}
OUTPUT: OUTPUT:
RETVAL RETVAL
@ -669,6 +769,25 @@ setdb(pghost, pgport, pgoptions, pgtty, dbname)
RETVAL RETVAL
HV *
conndefaults()
CODE:
PQconninfoOption *infoOption;
RETVAL = newHV();
if (infoOption = PQconndefaults()) {
while (infoOption->keyword != NULL) {
if (infoOption->val != NULL) {
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv(infoOption->val, 0), 0);
} else {
hv_store(RETVAL, infoOption->keyword, strlen(infoOption->keyword), newSVpv("", 0), 0);
}
infoOption++;
}
}
OUTPUT:
RETVAL
@ -692,6 +811,11 @@ PQreset(conn)
PG_conn conn PG_conn conn
int
PQrequestCancel(conn)
PG_conn conn
char * char *
PQdb(conn) PQdb(conn)
PG_conn conn PG_conn conn
@ -703,12 +827,12 @@ PQuser(conn)
char * char *
PQhost(conn) PQpass(conn)
PG_conn conn PG_conn conn
char * char *
PQoptions(conn) PQhost(conn)
PG_conn conn PG_conn conn
@ -722,6 +846,11 @@ PQtty(conn)
PG_conn conn PG_conn conn
char *
PQoptions(conn)
PG_conn conn
ConnStatusType ConnStatusType
PQstatus(conn) PQstatus(conn)
PG_conn conn PG_conn conn
@ -732,6 +861,16 @@ PQerrorMessage(conn)
PG_conn conn PG_conn conn
int
PQsocket(conn)
PG_conn conn
int
PQbackendPID(conn)
PG_conn conn
void void
PQtrace(conn, debug_port) PQtrace(conn, debug_port)
PG_conn conn PG_conn conn
@ -752,39 +891,13 @@ PQexec(conn, query)
if (RETVAL) { if (RETVAL) {
RETVAL->result = PQexec((PGconn *)conn, query); RETVAL->result = PQexec((PGconn *)conn, query);
if (!RETVAL->result) { if (!RETVAL->result) {
RETVAL->result = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR); RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
} }
} }
OUTPUT: OUTPUT:
RETVAL RETVAL
int
PQgetline(conn, string, length)
PREINIT:
SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PG_conn conn
int length
char * string = sv_grow(sv_buffer, length);
CODE:
RETVAL = PQgetline(conn, string, length);
OUTPUT:
RETVAL
string
int
PQendcopy(conn)
PG_conn conn
void
PQputline(conn, string)
PG_conn conn
char * string
void void
PQnotifies(conn) PQnotifies(conn)
PG_conn conn PG_conn conn
@ -799,6 +912,94 @@ PQnotifies(conn)
} }
int
PQsendQuery(conn, query)
PG_conn conn
char * query
PG_results
PQgetResult(conn)
PG_conn conn
CODE:
RETVAL = (PG_results)calloc(1, sizeof(PGresults));
if (RETVAL) {
RETVAL->result = PQgetResult((PGconn *)conn);
if (!RETVAL->result) {
RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
}
}
OUTPUT:
RETVAL
int
PQisBusy(conn)
PG_conn conn
int
PQconsumeInput(conn)
PG_conn conn
int
PQgetline(conn, string, length)
PREINIT:
SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PG_conn conn
int length
char * string = sv_grow(bufsv, length);
CODE:
RETVAL = PQgetline(conn, string, length);
OUTPUT:
RETVAL
string
int
PQputline(conn, string)
PG_conn conn
char * string
int
PQgetlineAsync(conn, buffer, bufsize)
PREINIT:
SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
INPUT:
PG_conn conn
int bufsize
char * buffer = sv_grow(bufsv, bufsize);
CODE:
RETVAL = PQgetline(conn, buffer, bufsize);
OUTPUT:
RETVAL
buffer
int
PQendcopy(conn)
PG_conn conn
PG_results
PQmakeEmptyPGresult(conn, status)
PG_conn conn
ExecStatusType status
CODE:
RETVAL = (PG_results)calloc(1, sizeof(PGresults));
if (RETVAL) {
RETVAL->result = PQmakeEmptyPGresult((PGconn *)conn, status);
if (!RETVAL->result) {
RETVAL->result = (PG_result)calloc(1, sizeof(PGresult));
}
}
OUTPUT:
RETVAL
int int
lo_open(conn, lobjId, mode) lo_open(conn, lobjId, mode)
PG_conn conn PG_conn conn
@ -815,21 +1016,21 @@ lo_close(conn, fd)
int int
lo_read(conn, fd, buf, len) lo_read(conn, fd, buf, len)
PREINIT: PREINIT:
SV *sv_buffer = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
INPUT: INPUT:
PG_conn conn PG_conn conn
int fd int fd
int len int len
char * buf = sv_grow(sv_buffer, len + 1); char * buf = sv_grow(bufsv, len + 1);
CLEANUP: CODE:
if (RETVAL >= 0) { RETVAL = lo_read(conn, fd, buf, len);
SvCUR(sv_buffer) = RETVAL; if (RETVAL > 0) {
SvPOK_only(sv_buffer); SvCUR_set(bufsv, RETVAL);
*SvEND(sv_buffer) = '\0'; *SvEND(bufsv) = '\0';
if (tainting) {
sv_magic(sv_buffer, 0, 't', 0, 0);
}
} }
OUTPUT:
RETVAL
buf
int int
@ -920,6 +1121,15 @@ PQnfields(res)
RETVAL RETVAL
int
PQbinaryTuples(res)
PG_results res
CODE:
RETVAL = PQbinaryTuples(res->result);
OUTPUT:
RETVAL
char * char *
PQfname(res, field_num) PQfname(res, field_num)
PG_results res PG_results res
@ -960,6 +1170,16 @@ PQfsize(res, field_num)
RETVAL RETVAL
int
PQfmod(res, field_num)
PG_results res
int field_num
CODE:
RETVAL = PQfmod(res->result, field_num);
OUTPUT:
RETVAL
char * char *
PQcmdStatus(res) PQcmdStatus(res)
PG_results res PG_results res
@ -1021,38 +1241,38 @@ PQgetisnull(res, tup_num, field_num)
void void
PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet) PQfetchrow(res)
PG_results res PG_results res
FILE * fp PPCODE:
int fillAlign if (res && res->result) {
char * fieldSep int cols = PQnfields(res->result);
int printHeader if (PQntuples(res->result) > res->row) {
int quiet int col = 0;
CODE: EXTEND(sp, cols);
PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet); while (col < cols) {
if (PQgetisnull(res->result, res->row, col)) {
PUSHs(&sv_undef);
void } else {
PQprintTuples(res, fout, printAttName, terseOutput, width) char *val = PQgetvalue(res->result, res->row, col);
PG_results res PUSHs(sv_2mortal((SV*)newSVpv(val, 0)));
FILE * fout }
int printAttName ++col;
int terseOutput }
int width ++res->row;
CODE: }
PQprintTuples(res->result, fout, printAttName, terseOutput, width); }
void void
PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...) PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
FILE * fout FILE * fout
PG_results res PG_results res
bool header pqbool header
bool align pqbool align
bool standard pqbool standard
bool html3 pqbool html3
bool expanded pqbool expanded
bool pager pqbool pager
char * fieldSep char * fieldSep
char * tableOpt char * tableOpt
char * caption char * caption
@ -1078,23 +1298,23 @@ PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, ta
void void
PQfetchrow(res) PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
PG_results res PG_results res
PPCODE: FILE * fp
if (res && res->result) { int fillAlign
int cols = PQnfields(res->result); char * fieldSep
if (PQntuples(res->result) > res->row) { int printHeader
int col = 0; int quiet
EXTEND(sp, cols); CODE:
while (col < cols) { PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
if (PQgetisnull(res->result, res->row, col)) {
PUSHs(&sv_undef);
} else { void
char *val = PQgetvalue(res->result, res->row, col); PQprintTuples(res, fout, printAttName, terseOutput, width)
PUSHs(sv_2mortal((SV*)newSVpv(val, 0))); PG_results res
} FILE * fout
++col; int printAttName
} int terseOutput
++res->row; int width
} CODE:
} PQprintTuples(res->result, fout, printAttName, terseOutput, width);

15
src/interfaces/perl5/README
View File

@ -1,6 +1,6 @@
#------------------------------------------------------- #-------------------------------------------------------
# #
# $Id: README,v 1.7 1998/06/01 16:41:19 mergl Exp $ # $Id: README,v 1.8 1998/09/27 19:12:24 mergl Exp $
# #
# Copyright (c) 1997, 1998 Edmund Mergl # Copyright (c) 1997, 1998 Edmund Mergl
# #
@ -9,7 +9,7 @@
DESCRIPTION: DESCRIPTION:
------------ ------------
This is version 1.7.4 of pgsql_perl5 (previously called pg95perl5). This is version 1.8.0 of pgsql_perl5 (previously called pg95perl5).
Pgsql_perl5 is an interface between Larry Wall's language perl version 5 and 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 database PostgreSQL (previously Postgres95). This has been done by using
@ -23,6 +23,9 @@ 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.
NOTE: it is planned to drop the old C-style interface in the next major release
of PostgreSQL.
COPYRIGHT: COPYRIGHT:
@ -36,7 +39,7 @@ License or the Artistic License, as specified in the Perl README file.
IF YOU HAVE PROBLEMS: IF YOU HAVE PROBLEMS:
--------------------- ---------------------
Please send comments and bug-reports to <E.Mergl@bawue.de> Please send comments and bug-reports to <pgsql-interfaces@postgresql.org>
Please include the output of perl -v, Please include the output of perl -v,
and perl -V, and perl -V,
@ -48,8 +51,8 @@ in your bug-report.
REQUIREMENTS: REQUIREMENTS:
------------- -------------
- build, test and install Perl 5 (at least 5.002) - build, test and install Perl5 (at least 5.002)
- build, test and install PostgreSQL (at least 6.3) - build, test and install PostgreSQL (at least 6.4)
PLATFORMS: PLATFORMS:
@ -129,6 +132,6 @@ installation to read the documentation.
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
Edmund Mergl <E.Mergl@bawue.de> May 28, 1998 Edmund Mergl <E.Mergl@bawue.de> September 27, 1998
--------------------------------------------------------------------------- ---------------------------------------------------------------------------

26
src/interfaces/perl5/eg/ApachePg.pl
View File

@ -1,18 +1,12 @@
#!/usr/local/bin/perl #!/usr/local/bin/perl
#------------------------------------------------------- # $Id: ApachePg.pl,v 1.5 1998/09/27 19:12:33 mergl Exp $
#
# $Id: ApachePg.pl,v 1.4 1998/06/01 16:41:26 mergl Exp $
#
# Copyright (c) 1997, 1998 Edmund Mergl
#
#-------------------------------------------------------
# demo script, tested with: # demo script, tested with:
# - PostgreSQL-6.3 # - PostgreSQL-6.4
# - apache_1.3 # - apache_1.3.1
# - mod_perl-1.08 # - mod_perl-1.15
# - perl5.004_04 # - perl5.005_02
use CGI; use CGI;
use Pg; use Pg;
@ -26,7 +20,7 @@ print $query->header,
"<CENTER><H3>Testing Module Pg</H3></CENTER>", "<CENTER><H3>Testing Module Pg</H3></CENTER>",
"<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>", "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
"<TR><TD>Enter conninfo string: </TD>", "<TR><TD>Enter conninfo string: </TD>",
"<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1 host=localhost'), "</TD>", "<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "</TD>",
"</TR>", "</TR>",
"<TR><TD>Enter select command: </TD>", "<TR><TD>Enter select command: </TD>",
"<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>", "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
@ -39,9 +33,10 @@ if ($query->param) {
my $conninfo = $query->param('conninfo'); my $conninfo = $query->param('conninfo');
my $conn = Pg::connectdb($conninfo); my $conn = Pg::connectdb($conninfo);
if ($conn->status == PGRES_CONNECTION_OK) { if (PGRES_CONNECTION_OK == $conn->status) {
my $cmd = $query->param('cmd'); my $cmd = $query->param('cmd');
my $result = $conn->exec($cmd); my $result = $conn->exec($cmd);
if (PGRES_TUPLES_OK == $result->resultStatus) {
print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n"; print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
my @row; my @row;
while (@row = $result->fetchrow) { while (@row = $result->fetchrow) {
@ -49,7 +44,10 @@ if ($query->param) {
} }
print "</TABLE></CENTER><P>\n"; print "</TABLE></CENTER><P>\n";
} else { } else {
print "<CENTER><H2>Connect to database failed</H2></CENTER>\n"; print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
}
} else {
print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
} }
} }

253
src/interfaces/perl5/eg/example.newstyle
View File

@ -1,49 +1,33 @@
#!/usr/local/bin/perl -w #!/usr/local/bin/perl
#------------------------------------------------------- # $Id: example.newstyle,v 1.6 1998/09/27 19:12:34 mergl Exp $
#
# $Id: example.newstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
#
# Copyright (c) 1997, 1998 Edmund Mergl
#
#-------------------------------------------------------
# Before `make install' is performed this script should be runnable with ######################### globals
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure. $| = 1;
BEGIN { $| = 1; print "1..56\n"; }
END {print "not ok 1\n" unless $loaded;}
use Pg; use Pg;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
$dbmain = 'template1'; $dbmain = 'template1';
$dbname = 'pgperltest'; $dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out'; $trace = '/tmp/pgtrace.out';
$cnt = 2;
$DEBUG = 0; # set this to 1 for traces $DEBUG = 0; # set this to 1 for traces
$| = 1; ######################### the following methods will be used
######################### the following methods will be tested
# connectdb # connectdb
# conndefaults
# db # db
# user # user
# port # port
# finish
# status # status
# errorMessage # errorMessage
# trace # trace
# untrace # untrace
# exec # exec
# consumeInput
# getline # getline
# endcopy
# putline # putline
# endcopy
# resultStatus # resultStatus
# ntuples # ntuples
# nfields # nfields
@ -61,14 +45,25 @@ $| = 1;
# lo_export # lo_export
# lo_unlink # lo_unlink
######################### the following methods will not be tested ######################### the following methods will not be used
# setdb # setdb
# conndefaults # setdbLogin
# reset # reset
# options # requestCancel
# pass
# host # host
# tty # tty
# options
# socket
# backendPID
# sendQuery
# getResult
# isBusy
# getlineAsync
# putnbytes
# makeEmptyPGresult
# fmod
# getlength # getlength
# getisnull # getisnull
# displayTuples # displayTuples
@ -86,82 +81,89 @@ $| = 1;
$SIG{PIPE} = sub { print "broken pipe\n" }; $SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database ######################### create and connect to test database
# 2-4
$Option_ref = Pg::conndefaults();
($key, $val);
print "connection defaults:\n";
while (($key, $val) = each %$Option_ref) {
printf " keyword = %-12.12s val = >%s<\n", $key, $val;
}
$conn = Pg::connectdb("dbname=$dbmain"); $conn = Pg::connectdb("dbname=$dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
print "connected to $dbmain\n";
# might fail if $dbname doesn't exist => don't check resultStatus # do not complain when dropping $dbname
$result = $conn->exec("DROP DATABASE $dbname"); $conn->exec("DROP DATABASE $dbname");
$result = $conn->exec("CREATE DATABASE $dbname"); $result = $conn->exec("CREATE DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
print "created database $dbname\n";
$conn = Pg::connectdb("dbname=$dbname"); $conn = Pg::connectdb("dbname=$dbname");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
print "connected to $dbname\n";
######################### debug, PQtrace ######################### debug, trace
if ($DEBUG) { if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!"; open(TRACE, ">$trace") || die "can not open $trace: $!";
$conn->trace(TRACE); $conn->trace(TRACE);
print "enabled tracing into $trace\n";
} }
######################### check PGconn ######################### check PGconn
# 5-7
$db = $conn->db; $db = $conn->db;
cmp_eq($dbname, $db); print " database: $db\n";
$user = $conn->user; $user = $conn->user;
cmp_ne("", $user); print " user: $user\n";
$port = $conn->port; $port = $conn->port;
cmp_ne("", $port); print " port: $port\n";
######################### create and insert into table ######################### create and insert into table
# 8-19
$result = $conn->exec("CREATE TABLE person (id int4, name char(16))"); $result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_eq("CREATE", $result->cmdStatus); print "created table, status = ", $result->cmdStatus, "\n";
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
$result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')"); $result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_ne(0, $result->oidStatus);
} }
print "insert into table, last oid = ", $result->oidStatus, "\n";
######################### copy to stdout, PQgetline ######################### copy to stdout, getline
# 20-26
$result = $conn->exec("COPY person TO STDOUT"); $result = $conn->exec("COPY person TO STDOUT");
cmp_eq(PGRES_COPY_OUT, $result->resultStatus); die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
print "copy table to STDOUT:\n";
$i = 1;
$ret = 0; $ret = 0;
$i = 1;
while (-1 != $ret) { while (-1 != $ret) {
$ret = $conn->getline($string, 256); $ret = $conn->getline($string, 256);
last if $string eq "\\."; last if $string eq "\\.";
cmp_eq("$i Edmund Mergl ", $string); print " ", $string, "\n";
$i ++; $i ++;
} }
cmp_eq(0, $conn->endcopy); die $conn->errorMessage unless 0 == $conn->endcopy;
######################### delete and copy from stdin, PQputline ######################### delete and copy from stdin, putline
# 27-33
$result = $conn->exec("BEGIN"); $result = $conn->exec("BEGIN");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
$result = $conn->exec("DELETE FROM person"); $result = $conn->exec("DELETE FROM person");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_eq("DELETE 5", $result->cmdStatus); print "delete from table, command status = ", $result->cmdStatus, ", no. of tuples = ", $result->cmdTuples, "\n";
cmp_eq("5", $result->cmdTuples);
$result = $conn->exec("COPY person FROM STDIN"); $result = $conn->exec("COPY person FROM STDIN");
cmp_eq(PGRES_COPY_IN, $result->resultStatus); die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus;
print "copy table from STDIN: ";
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
# watch the tabs and do not forget the newlines # watch the tabs and do not forget the newlines
@ -169,47 +171,32 @@ for ($i = 1; $i <= 5; $i++) {
} }
$conn->putline("\\.\n"); $conn->putline("\\.\n");
cmp_eq(0, $conn->endcopy); die $conn->errorMessage unless 0 == $conn->endcopy;
$result = $conn->exec("END"); $result = $conn->exec("END");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
print "ok\n";
######################### select from person, PQgetvalue ######################### select from person, getvalue
# 34-47
$result = $conn->exec("SELECT * FROM person"); $result = $conn->exec("SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
print "select from table:\n";
for ($k = 0; $k < $result->nfields; $k++) { for ($k = 0; $k < $result->nfields; $k++) {
$fname = $result->fname($k); print " field = ", $k, "\tfname = ", $result->fname($k), "\tftype = ", $result->ftype($k), "\tfsize = ", $result->fsize($k), "\tfnumber = ", $result->fnumber($result->fname($k)), "\n";
$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(1042, $ftype);
cmp_eq(-1, $fsize);
}
$fnumber = $result->fnumber($fname);
cmp_eq($k, $fnumber);
} }
$string = "";
while (@row = $result->fetchrow) { while (@row = $result->fetchrow) {
$string = join(" ", @row); print " ", join(" ", @row), "\n";
} }
cmp_eq("5 Edmund Mergl ", $string);
######################### PQnotifies ######################### notifies
# 43-46
if (! defined($pid = fork)) { if (! defined($pid = fork)) {
die "can not fork: $!"; die "can not fork: $!";
} elsif (! $pid) { } elsif (! $pid) {
# i'm the child # I'm the child
sleep 2; sleep 2;
bless $conn; bless $conn;
$conn = Pg::connectdb("dbname=$dbname"); $conn = Pg::connectdb("dbname=$dbname");
@ -218,102 +205,70 @@ if (! defined($pid = fork)) {
} }
$result = $conn->exec("LISTEN person"); $result = $conn->exec("LISTEN person");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_eq("LISTEN", $result->cmdStatus); print "listen table: status = ", $result->cmdStatus, "\n";
while (1) { while (1) {
$result = $conn->exec(" "); $conn->consumeInput;
($table, $pid) = $conn->notifies; ($table, $pid) = $conn->notifies;
last if $pid; last if $pid;
} }
print "got notification: table = ", $table, " pid = ", $pid, "\n";
cmp_eq("person", $table); ######################### print
######################### PQprint $result = $conn->exec("SELECT * FROM person");
# 47-48 die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
print "select from table and print:\n";
$result->print(STDOUT, 0, 0, 0, 0, 0, 0, " ", "", "", "");
$result = $conn->exec("SELECT name FROM person WHERE id = 2"); ######################### lo_import, lo_export, lo_unlink
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 $lobject_in = '/tmp/gaga.in';
# 49-54 $lobject_out = '/tmp/gaga.out';
$filename = 'ApachePg.pl'; $data = "testing large objects using lo_import and lo_export";
$cwd = `pwd`; open(FD, ">$lobject_in") or die "can not open $lobject_in";
chop $cwd; print(FD $data);
close(FD);
$result = $conn->exec("BEGIN"); $result = $conn->exec("BEGIN");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
$lobjOid = $conn->lo_import("$cwd/$filename"); $lobjOid = $conn->lo_import("$lobject_in") or die $conn->errorMessage;
cmp_ne(0, $lobjOid); print "importing file as large object, Oid = ", $lobjOid, "\n";
cmp_ne(-1, $conn->lo_export($lobjOid, "/tmp/$filename")); die $conn->errorMessage unless 1 == $conn->lo_export($lobjOid, "$lobject_out");
print "exporting large object as temporary file\n";
cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
$result = $conn->exec("END"); $result = $conn->exec("END");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_ne(-1, $conn->lo_unlink($lobjOid)); print "comparing imported file with exported file: ";
unlink "/tmp/$filename"; print "not " unless (-s "$lobject_in" == -s "$lobject_out");
print "ok\n";
######################### debug, PQuntrace die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid);
unlink $lobject_in;
unlink $lobject_out;
print "unlink large object\n";
######################### debug, untrace
if ($DEBUG) { if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!"; close(TRACE) || die "bad TRACE: $!";
$conn->untrace; $conn->untrace;
print "tracing disabled\n";
} }
######################### disconnect and drop test database ######################### disconnect and drop test database
# 55-56
$conn = Pg::connectdb("dbname=$dbmain"); $conn = Pg::connectdb("dbname=$dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
print "connected to $dbmain\n";
$result = $conn->exec("DROP DATABASE $dbname"); $result = $conn->exec("DROP DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
print "drop database\n";
######################### hopefully
print "test sequence finished.\n" if 62 == $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 ######################### EOF

228
src/interfaces/perl5/eg/example.oldstyle
View File

@ -1,48 +1,33 @@
#!/usr/local/bin/perl -w #!/usr/local/bin/perl
#------------------------------------------------------- # $Id: example.oldstyle,v 1.6 1998/09/27 19:12:35 mergl Exp $
#
# $Id: example.oldstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
#
# Copyright (c) 1997, 1998 Edmund Mergl
#
#-------------------------------------------------------
# Before `make install' is performed this script should be runnable with ######################### globals
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure. $| = 1;
BEGIN { $| = 1; print "1..60\n"; }
END {print "not ok 1\n" unless $loaded;}
use Pg; use Pg;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
$dbmain = 'template1'; $dbmain = 'template1';
$dbname = 'pgperltest'; $dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out'; $trace = '/tmp/pgtrace.out';
$cnt = 2;
$DEBUG = 0; # set this to 1 for traces $DEBUG = 0; # set this to 1 for traces
$| = 1;
######################### the following functions will be tested ######################### the following functions will be tested
# PQsetdb() # PQsetdb()
# PQdb() # PQdb()
# PQuser()
# PQport() # PQport()
# PQfinish()
# PQstatus() # PQstatus()
# PQfinish()
# PQerrorMessage() # PQerrorMessage()
# PQtrace() # PQtrace()
# PQuntrace() # PQuntrace()
# PQexec() # PQexec()
# PQconsumeInput
# PQgetline() # PQgetline()
# PQendcopy()
# PQputline() # PQputline()
# PQendcopy()
# PQresultStatus() # PQresultStatus()
# PQntuples() # PQntuples()
# PQnfields() # PQnfields()
@ -65,10 +50,22 @@ $| = 1;
# PQconnectdb() # PQconnectdb()
# PQconndefaults() # PQconndefaults()
# PQsetdbLogin()
# PQreset() # PQreset()
# PQoptions() # PQrequestCancel()
# PQpass()
# PQhost() # PQhost()
# PQtty() # PQtty()
# PQoptions()
# PQsocket()
# PQbackendPID()
# PQsendQuery()
# PQgetResult()
# PQisBusy()
# PQgetlineAsync()
# PQputnbytes()
# PQmakeEmptyPGresult()
# PQfmod()
# PQgetlength() # PQgetlength()
# PQgetisnull() # PQgetisnull()
# PQdisplayTuples() # PQdisplayTuples()
@ -86,91 +83,91 @@ $| = 1;
$SIG{PIPE} = sub { print "broken pipe\n" }; $SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database ######################### create and connect to test database
# 2-4
$conn = PQsetdb('', '', '', '', $dbmain); $conn = PQsetdb('', '', '', '', $dbmain);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn)); die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbmain\n";
# might fail if $dbname doesn't exist => don't check resultStatus # do not complain when dropping $dbname
$result = PQexec($conn, "DROP DATABASE $dbname"); $result = PQexec($conn, "DROP DATABASE $dbname");
PQclear($result); PQclear($result);
$result = PQexec($conn, "CREATE DATABASE $dbname"); $result = PQexec($conn, "CREATE DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
print "created database $dbname\n";
PQclear($result); PQclear($result);
PQfinish($conn); PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbname); $conn = PQsetdb('', '', '', '', $dbname);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn)); die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbname\n";
######################### debug, PQtrace ######################### debug, PQtrace
if ($DEBUG) { if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!"; open(TRACE, ">$trace") || die "can not open $trace: $!";
PQtrace($conn, TRACE); PQtrace($conn, TRACE);
print "enabled tracing into $trace\n";
} }
######################### check PGconn ######################### check PGconn
# 5-7
$db = PQdb($conn); $db = PQdb($conn);
cmp_eq($dbname, $db); print " database: $db\n";
$user = PQuser($conn); $user = PQuser($conn);
cmp_ne("", $user); print " user: $user\n";
$port = PQport($conn); $port = PQport($conn);
cmp_ne("", $port); print " port: $port\n";
######################### create and insert into table ######################### create and insert into table
# 8-19
$result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))"); $result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
cmp_eq("CREATE", PQcmdStatus($result)); print "created table, status = ", PQcmdStatus($result), "\n";
PQclear($result); PQclear($result);
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
$result = PQexec($conn, "INSERT INTO person VALUES ($i, 'Edmund Mergl')"); $result = PQexec($conn, "INSERT INTO person VALUES ($i, 'Edmund Mergl')");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
cmp_ne(0, PQoidStatus($result));
PQclear($result); PQclear($result);
} }
print "insert into table, last oid = ", PQoidStatus($result), "\n";
######################### copy to stdout, PQgetline ######################### copy to stdout, PQgetline
# 20-26
$result = PQexec($conn, "COPY person TO STDOUT"); $result = PQexec($conn, "COPY person TO STDOUT");
cmp_eq(PGRES_COPY_OUT, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COPY_OUT eq PQresultStatus($result);
print "copy table to STDOUT:\n";
PQclear($result); PQclear($result);
$i = 1;
$ret = 0; $ret = 0;
$i = 1;
while (-1 != $ret) { while (-1 != $ret) {
$ret = PQgetline($conn, $string, 256); $ret = PQgetline($conn, $string, 256);
last if $string eq "\\."; last if $string eq "\\.";
cmp_eq("$i Edmund Mergl ", $string); print " ", $string, "\n";
$i++; $i++;
} }
cmp_eq(0, PQendcopy($conn)); die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
######################### delete and copy from stdin, PQputline ######################### delete and copy from stdin, PQputline
# 27-33
$result = PQexec($conn, "BEGIN"); $result = PQexec($conn, "BEGIN");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result); PQclear($result);
$result = PQexec($conn, "DELETE FROM person"); $result = PQexec($conn, "DELETE FROM person");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
cmp_eq("DELETE 5", PQcmdStatus($result)); print "delete from table, command status = ", PQcmdStatus($result), ", no. of tuples = ", PQcmdTuples($result), "\n";
cmp_eq("5", PQcmdTuples($result));
PQclear($result); PQclear($result);
$result = PQexec($conn, "COPY person FROM STDIN"); $result = PQexec($conn, "COPY person FROM STDIN");
cmp_eq(PGRES_COPY_IN, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COPY_IN eq PQresultStatus($result);
print "copy table from STDIN:\n";
PQclear($result); PQclear($result);
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
@ -179,53 +176,37 @@ for ($i = 1; $i <= 5; $i++) {
} }
PQputline($conn, "\\.\n"); PQputline($conn, "\\.\n");
cmp_eq(0, PQendcopy($conn)); die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
$result = PQexec($conn, "END"); $result = PQexec($conn, "END");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result); PQclear($result);
######################### select from person, PQgetvalue ######################### select from person, PQgetvalue
# 34-47
$result = PQexec($conn, "SELECT * FROM person"); $result = PQexec($conn, "SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result);
print "select from table:\n";
for ($k = 0; $k < PQnfields($result); $k++) { for ($k = 0; $k < PQnfields($result); $k++) {
$fname = PQfname($result, $k); print " field = ", $k, "\tfname = ", PQfname($result, $k), "\tftype = ", PQftype($result, $k), "\tfsize = ", PQfsize($result, $k), "\tfnumber = ", PQfnumber($result, PQfname($result, $k)), "\n";
$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(1042, $ftype);
cmp_eq(-1, $fsize);
}
$fnumber = PQfnumber($result, $fname);
cmp_eq($k, $fnumber);
} }
for ($k = 0; $k < PQntuples($result); $k++) { for ($k = 0; $k < PQntuples($result); $k++) {
$string = "";
for ($l = 0; $l < PQnfields($result); $l++) { for ($l = 0; $l < PQnfields($result); $l++) {
$string .= PQgetvalue($result, $k, $l) . " "; print " ", PQgetvalue($result, $k, $l);
} }
$i = $k + 1; print "\n";
cmp_eq("$i Edmund Mergl ", $string);
} }
PQclear($result); PQclear($result);
######################### PQnotifies ######################### PQnotifies
# 48-50
if (! defined($pid = fork)) { if (! defined($pid = fork)) {
die "can not fork: $!"; die "can not fork: $!";
} elsif (! $pid) { } elsif (! $pid) {
# i'm the child # I'm the child
sleep 2; sleep 2;
$conn = PQsetdb('', '', '', '', $dbname); $conn = PQsetdb('', '', '', '', $dbname);
$result = PQexec($conn, "NOTIFY person"); $result = PQexec($conn, "NOTIFY person");
@ -235,112 +216,79 @@ if (! defined($pid = fork)) {
} }
$result = PQexec($conn, "LISTEN person"); $result = PQexec($conn, "LISTEN person");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
cmp_eq("LISTEN", PQcmdStatus($result)); print "listen table: status = ", PQcmdStatus($result), "\n";
PQclear($result); PQclear($result);
while (1) { while (1) {
$result = PQexec($conn, " "); PQconsumeInput($conn);
($table, $pid) = PQnotifies($conn); ($table, $pid) = PQnotifies($conn);
PQclear($result);
last if $pid; last if $pid;
} }
print "got notification: table = ", $table, " pid = ", $pid, "\n";
cmp_eq("person", $table);
######################### PQprint ######################### PQprint
# 51-52
$result = PQexec($conn, "SELECT name FROM person WHERE id = 2"); $result = PQexec($conn, "SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq 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: $|"; print "select from table and print:\n";
$cnt ++; PQprint(STDOUT, $result, 0, 0, 0, 0, 0, 0, " ", "", "", "");
PQprint(PRINT, $result, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
PQclear($result); PQclear($result);
close(PRINT) || die "bad PRINT: $!";
######################### PQlo_import, PQlo_export, PQlo_unlink ######################### PQlo_import, PQlo_export, PQlo_unlink
# 53-59
$filename = 'ApachePg.pl'; $lobject_in = '/tmp/gaga.in';
$cwd = `pwd`; $lobject_out = '/tmp/gaga.out';
chop $cwd;
$data = "testing large objects using lo_import and lo_export";
open(FD, ">$lobject_in") or die "can not open $lobject_in";
print(FD $data);
close(FD);
$result = PQexec($conn, "BEGIN"); $result = PQexec($conn, "BEGIN");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result); PQclear($result);
$lobjOid = PQlo_import($conn, "$cwd/$filename"); $lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn);
cmp_ne( 0, $lobjOid); print "importing file as large object, Oid = ", $lobjOid, "\n";
cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename")); die PQerrorMessage($conn) unless 1 == PQlo_export($conn, $lobjOid, "$lobject_out");
print "exporting large object as temporary file\n";
cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
$result = PQexec($conn, "END"); $result = PQexec($conn, "END");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result); PQclear($result);
cmp_ne(-1, PQlo_unlink($conn, $lobjOid)); print "comparing imported file with exported file: ";
unlink "/tmp/$filename"; print "not " unless (-s "$lobject_in" == -s "$lobject_out");
print "ok\n";
die PQerrorMessage($conn) if -1 == PQlo_unlink($conn, $lobjOid);
unlink $lobject_in;
unlink $lobject_out;
print "unlink large object\n";
######################### debug, PQuntrace ######################### debug, PQuntrace
if ($DEBUG) { if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!"; close(TRACE) || die "bad TRACE: $!";
PQuntrace($conn); PQuntrace($conn);
print "tracing disabled\n";
} }
######################### disconnect and drop test database ######################### disconnect and drop test database
# 59-60
PQfinish($conn); PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbmain); $conn = PQsetdb('', '', '', '', $dbmain);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn)); die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbmain\n";
$result = PQexec($conn, "DROP DATABASE $dbname"); $result = PQexec($conn, "DROP DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result)); die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
print "drop database\n";
PQclear($result); PQclear($result);
PQfinish($conn); PQfinish($conn);
######################### hopefully
print "test sequence finished.\n" if 62 == $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 ######################### EOF

245
src/interfaces/perl5/test.pl
View File

@ -1,52 +1,43 @@
#!/usr/local/bin/perl -w #!/usr/local/bin/perl -w
#------------------------------------------------------- # $Id: test.pl,v 1.9 1998/09/27 19:12:26 mergl Exp $
#
# $Id: test.pl,v 1.8 1998/06/01 16:41:20 mergl Exp $
#
# Copyright (c) 1997, 1998 Edmund Mergl
#
#-------------------------------------------------------
# Before `make install' is performed this script should be runnable with # Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl' # `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure. ######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..45\n"; } BEGIN { $| = 1; }
END {print "not ok 1\n" unless $loaded;} END {print "test failed\n" unless $loaded;}
use Pg; use Pg;
$loaded = 1; $loaded = 1;
print "ok 1\n"; use strict;
######################### End of black magic. ######################### End of black magic.
$dbmain = 'template1'; my $dbmain = 'template1';
$dbname = 'pgperltest'; my $dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out'; my $trace = '/tmp/pgtrace.out';
$cnt = 2; my ($conn, $result, $i);
$DEBUG = 0; # set this to 1 for traces
$| = 1; my $DEBUG = 0; # set this to 1 for traces
######################### the following methods will be tested ######################### the following methods will be tested
# connectdb # connectdb
# conndefaults
# db # db
# user # user
# port # port
# finish
# status # status
# errorMessage # errorMessage
# trace # trace
# untrace # untrace
# exec # exec
# getline # getline
# endcopy
# putline # putline
# endcopy
# resultStatus # resultStatus
# ntuples
# nfields
# fname # fname
# fnumber # fnumber
# ftype # ftype
@ -54,20 +45,36 @@ $| = 1;
# cmdStatus # cmdStatus
# oidStatus # oidStatus
# cmdTuples # cmdTuples
# getvalue # fetchrow
######################### the following methods will not be tested ######################### the following methods will not be tested
# setdb # setdb
# conndefaults # setdbLogin
# reset # reset
# options # requestCancel
# pass
# host # host
# tty # tty
# options
# socket
# backendPID
# notifies
# sendQuery
# getResult
# isBusy
# consumeInput
# getlineAsync
# putnbytes
# makeEmptyPGresult
# ntuples
# nfields
# binaryTuples
# fmod
# getvalue
# getlength # getlength
# getisnull # getisnull
# print # print
# notifies
# displayTuples # displayTuples
# printTuples # printTuples
# lo_import # lo_import
@ -86,82 +93,114 @@ $| = 1;
$SIG{PIPE} = sub { print "broken pipe\n" }; $SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database ######################### create and connect to test database
# 2-4
my $Option_ref = Pg::conndefaults();
my ($key, $val);
( $$Option_ref{port} ne "" && $$Option_ref{dbname} ne "" && $$Option_ref{user} ne "" )
and print "Pg::conndefaults ........ ok\n"
or die "Pg::conndefaults ........ not ok: ", $conn->errorMessage;
$conn = Pg::connectdb("dbname=$dbmain"); $conn = Pg::connectdb("dbname=$dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); ( PGRES_CONNECTION_OK eq $conn->status )
and print "Pg::connectdb ........... ok\n"
or die "Pg::connectdb ........... not ok: ", $conn->errorMessage;
# might fail if $dbname doesn't exist => don't check resultStatus # do not complain when dropping $dbname
$result = $conn->exec("DROP DATABASE $dbname"); $conn->exec("DROP DATABASE $dbname");
$result = $conn->exec("CREATE DATABASE $dbname"); $result = $conn->exec("CREATE DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); ( PGRES_COMMAND_OK eq $result->resultStatus )
and print "\$conn->exec ............. ok\n"
or die "\$conn->exec ............. not ok: ", $conn->errorMessage;
$conn = Pg::connectdb("dbname=rumpumpel");
( $conn->errorMessage =~ 'Database rumpumpel does not exist' )
and print "\$conn->errorMessage ..... ok\n"
or die "\$conn->errorMessage ..... not ok: ", $conn->errorMessage;
$conn = Pg::connectdb("dbname=$dbname"); $conn = Pg::connectdb("dbname=$dbname");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
######################### debug, PQtrace ######################### debug, PQtrace
if ($DEBUG) { if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!"; open(FD, ">$trace") || die "can not open $trace: $!";
$conn->trace(TRACE); $conn->trace("FD");
} }
######################### check PGconn ######################### check PGconn
# 5-7
$db = $conn->db; my $db = $conn->db;
cmp_eq($dbname, $db); ( $dbname eq $db )
and print "\$conn->db ............... ok\n"
or print "\$conn->db ............... not ok: $db\n";
$user = $conn->user; my $user = $conn->user;
cmp_ne("", $user); ( "" ne $user )
and print "\$conn->user ............. ok\n"
or print "\$conn->user ............. not ok: $user\n";
$port = $conn->port; my $port = $conn->port;
cmp_ne("", $port); ( "" ne $port )
and print "\$conn->port ............. ok\n"
or print "\$conn->port ............. not ok: $port\n";
######################### create and insert into table ######################### create and insert into table
# 8-19
$result = $conn->exec("CREATE TABLE person (id int4, name char(16))"); $result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_eq("CREATE", $result->cmdStatus); my $cmd = $result->cmdStatus;
( "CREATE" eq $cmd )
and print "\$conn->cmdStatus ........ ok\n"
or print "\$conn->cmdStatus ........ not ok: $cmd\n";
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
$result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')"); $result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_ne(0, $result->oidStatus);
} }
my $oid = $result->oidStatus;
( 0 != $oid )
and print "\$conn->oidStatus ........ ok\n"
or print "\$conn->oidStatus ........ not ok: $oid\n";
######################### copy to stdout, PQgetline ######################### copy to stdout, PQgetline
# 20-26
$result = $conn->exec("COPY person TO STDOUT"); $result = $conn->exec("COPY person TO STDOUT");
cmp_eq(PGRES_COPY_OUT, $result->resultStatus); die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
my $ret = 0;
my $buf;
my $string;
$i = 1; $i = 1;
$ret = 0;
while (-1 != $ret) { while (-1 != $ret) {
$ret = $conn->getline($string, 256); $ret = $conn->getline($buf, 256);
last if $string eq "\\."; last if $buf eq "\\.";
cmp_eq("$i Edmund Mergl ", $string); $string = $buf if 1 == $i;
$i++; $i++;
} }
( "1 Edmund Mergl " eq $string )
and print "\$conn->getline .......... ok\n"
or print "\$conn->getline .......... not ok: $string\n";
cmp_eq(0, $conn->endcopy); $ret = $conn->endcopy;
( 0 == $ret )
and print "\$conn->endcopy .......... ok\n"
or print "\$conn->endcopy .......... not ok: $ret\n";
######################### delete and copy from stdin, PQputline ######################### delete and copy from stdin, PQputline
# 27-33
$result = $conn->exec("BEGIN"); $result = $conn->exec("BEGIN");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
$result = $conn->exec("DELETE FROM person"); $result = $conn->exec("DELETE FROM person");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
cmp_eq("DELETE 5", $result->cmdStatus); $ret = $result->cmdTuples;
cmp_eq("5", $result->cmdTuples); ( 5 == $ret )
and print "\$result->cmdTuples ...... ok\n"
or print "\$result->cmdTuples ...... not ok: $ret\n";
$result = $conn->exec("COPY person FROM STDIN"); $result = $conn->exec("COPY person FROM STDIN");
cmp_eq(PGRES_COPY_IN, $result->resultStatus); die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus;
for ($i = 1; $i <= 5; $i++) { for ($i = 1; $i <= 5; $i++) {
# watch the tabs and do not forget the newlines # watch the tabs and do not forget the newlines
@ -169,92 +208,60 @@ for ($i = 1; $i <= 5; $i++) {
} }
$conn->putline("\\.\n"); $conn->putline("\\.\n");
cmp_eq(0, $conn->endcopy); die $conn->errorMessage if $conn->endcopy;
$result = $conn->exec("END"); $result = $conn->exec("END");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
######################### select from person, PQgetvalue ######################### select from person, PQgetvalue
# 34-43
$result = $conn->exec("SELECT * FROM person"); $result = $conn->exec("SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
for ($k = 0; $k < $result->nfields; $k++) { my $fname = $result->fname(0);
$fname = $result->fname($k); ( "id" eq $fname )
$ftype = $result->ftype($k); and print "\$result->fname .......... ok\n"
$fsize = $result->fsize($k); or print "\$result->fname .......... not ok: $fname\n";
if (0 == $k) {
cmp_eq("id", $fname); my $ftype = $result->ftype(0);
cmp_eq(23, $ftype); ( 23 == $ftype )
cmp_eq(4, $fsize); and print "\$result->ftype .......... ok\n"
} else { or print "\$result->ftype .......... not ok: $ftype\n";
cmp_eq("name", $fname);
cmp_eq(1042, $ftype); my $fsize = $result->fsize(0);
cmp_eq(-1, $fsize); ( 4 == $fsize )
} and print "\$result->fsize .......... ok\n"
$fnumber = $result->fnumber($fname); or print "\$result->fsize .......... not ok: $fsize\n";
cmp_eq($k, $fnumber);
} my $fnumber = $result->fnumber($fname);
( 0 == $fnumber )
and print "\$result->fnumber ........ ok\n"
or print "\$result->fnumber ........ not ok: $fnumber\n";
$string = ""; $string = "";
my @row;
while (@row = $result->fetchrow) { while (@row = $result->fetchrow) {
$string = join(" ", @row); $string = join(" ", @row);
} }
cmp_eq("5 Edmund Mergl ", $string); ( "5 Edmund Mergl " eq $string )
and print "\$result->fetchrow ....... ok\n"
or print "\$result->fetchrow ....... not ok: $string\n";
######################### debug, PQuntrace ######################### debug, PQuntrace
if ($DEBUG) { if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!"; close(FD) || die "bad TRACE: $!";
$conn->untrace; $conn->untrace;
} }
######################### disconnect and drop test database ######################### disconnect and drop test database
# 44-45
$conn = Pg::connectdb("dbname=$dbmain"); $conn = Pg::connectdb("dbname=$dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
$result = $conn->exec("DROP DATABASE $dbname"); $result = $conn->exec("DROP DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
######################### hopefully print "test sequence finished.\n";
print "test sequence finished.\n" if 51 == $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 ######################### EOF

5
src/interfaces/perl5/typemap
View File

@ -1,6 +1,6 @@
#------------------------------------------------------- #-------------------------------------------------------
# #
# $Id: typemap,v 1.7 1998/06/01 16:41:20 mergl Exp $ # $Id: typemap,v 1.8 1998/09/27 19:12:27 mergl Exp $
# #
# Copyright (c) 1997, 1998 Edmund Mergl # Copyright (c) 1997, 1998 Edmund Mergl
# #
@ -15,5 +15,4 @@ PG_results T_PTROBJ
ConnStatusType T_IV ConnStatusType T_IV
ExecStatusType T_IV ExecStatusType T_IV
Oid T_IV Oid T_IV
int2 T_IV pqbool T_IV
bool T_IV