276 lines
7.2 KiB
Perl
276 lines
7.2 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
# $Id: test.pl,v 1.14 2001/09/04 11:41:04 petere Exp $
|
|
|
|
# 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; }
|
|
END {print "test failed\n" unless $loaded;}
|
|
use Pg;
|
|
$loaded = 1;
|
|
use strict;
|
|
|
|
######################### End of black magic.
|
|
|
|
my $dbmain = 'template1';
|
|
my $dbname = 'pgperltest';
|
|
my $trace = '/tmp/pgtrace.out';
|
|
my ($conn, $result, $i);
|
|
|
|
my $DEBUG = 0; # set this to 1 for traces
|
|
|
|
######################### the following methods will be tested
|
|
|
|
# connectdb
|
|
# conndefaults
|
|
# db
|
|
# user
|
|
# port
|
|
# status
|
|
# errorMessage
|
|
# trace
|
|
# untrace
|
|
# exec
|
|
# getline
|
|
# putline
|
|
# endcopy
|
|
# resultStatus
|
|
# fname
|
|
# fnumber
|
|
# ftype
|
|
# fsize
|
|
# cmdStatus
|
|
# oidStatus
|
|
# cmdTuples
|
|
# fetchrow
|
|
|
|
######################### the following methods will not be tested
|
|
|
|
# setdb
|
|
# setdbLogin
|
|
# reset
|
|
# requestCancel
|
|
# pass
|
|
# host
|
|
# tty
|
|
# options
|
|
# socket
|
|
# backendPID
|
|
# notifies
|
|
# sendQuery
|
|
# getResult
|
|
# isBusy
|
|
# consumeInput
|
|
# getlineAsync
|
|
# putnbytes
|
|
# makeEmptyPGresult
|
|
# ntuples
|
|
# nfields
|
|
# binaryTuples
|
|
# fmod
|
|
# getvalue
|
|
# getlength
|
|
# getisnull
|
|
# print
|
|
# displayTuples
|
|
# printTuples
|
|
# lo_import
|
|
# lo_export
|
|
# lo_unlink
|
|
# lo_open
|
|
# lo_close
|
|
# lo_read
|
|
# lo_write
|
|
# lo_creat
|
|
# lo_seek
|
|
# lo_tell
|
|
|
|
######################### handles error condition
|
|
|
|
$SIG{PIPE} = sub { print "broken pipe\n" };
|
|
|
|
######################### create and connect to test database
|
|
|
|
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");
|
|
( PGRES_CONNECTION_OK eq $conn->status )
|
|
and print "Pg::connectdb ........... ok\n"
|
|
or die "Pg::connectdb ........... not ok: ", $conn->errorMessage;
|
|
|
|
# do not complain when dropping $dbname
|
|
$conn->exec("DROP DATABASE $dbname");
|
|
|
|
$result = $conn->exec("CREATE DATABASE $dbname");
|
|
( 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");
|
|
die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
|
|
|
|
######################### debug, PQtrace
|
|
|
|
if ($DEBUG) {
|
|
open(FD, ">$trace") || die "can not open $trace: $!";
|
|
$conn->trace("FD");
|
|
}
|
|
|
|
######################### check PGconn
|
|
|
|
my $db = $conn->db;
|
|
( $dbname eq $db )
|
|
and print "\$conn->db ............... ok\n"
|
|
or print "\$conn->db ............... not ok: $db\n";
|
|
|
|
my $user = $conn->user;
|
|
( "" ne $user )
|
|
and print "\$conn->user ............. ok\n"
|
|
or print "\$conn->user ............. not ok: $user\n";
|
|
|
|
my $port = $conn->port;
|
|
( "" ne $port )
|
|
and print "\$conn->port ............. ok\n"
|
|
or print "\$conn->port ............. not ok: $port\n";
|
|
|
|
######################### create and insert into table
|
|
|
|
# we test comments inside string and with no trailing newline here
|
|
$result = $conn->exec("CREATE TABLE person (id int4, -- test\n name char(16)) -- test");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
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++) {
|
|
$result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
}
|
|
my $oid = $result->oidStatus;
|
|
( 0 != $oid )
|
|
and print "\$conn->oidStatus ........ ok\n"
|
|
or print "\$conn->oidStatus ........ not ok: $oid\n";
|
|
|
|
######################### copy to stdout, PQgetline
|
|
|
|
$result = $conn->exec("COPY person TO STDOUT");
|
|
die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
|
|
|
|
my $ret = 0;
|
|
my $buf;
|
|
my $string;
|
|
$i = 1;
|
|
while (-1 != $ret) {
|
|
$ret = $conn->getline($buf, 256);
|
|
last if $buf eq "\\.";
|
|
$string = $buf if 1 == $i;
|
|
$i++;
|
|
}
|
|
( "1 Edmund Mergl " eq $string )
|
|
and print "\$conn->getline .......... ok\n"
|
|
or print "\$conn->getline .......... not ok: $string\n";
|
|
|
|
$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
|
|
|
|
$result = $conn->exec("BEGIN");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
|
|
$result = $conn->exec("DELETE FROM person");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
$ret = $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");
|
|
die $conn->errorMessage unless PGRES_COPY_IN eq $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");
|
|
|
|
die $conn->errorMessage if $conn->endcopy;
|
|
|
|
$result = $conn->exec("END");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
|
|
######################### select from person, PQgetvalue
|
|
|
|
$result = $conn->exec("SELECT * FROM person");
|
|
die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus;
|
|
|
|
my $fname = $result->fname(0);
|
|
( "id" eq $fname )
|
|
and print "\$result->fname .......... ok\n"
|
|
or print "\$result->fname .......... not ok: $fname\n";
|
|
|
|
my $ftype = $result->ftype(0);
|
|
( 23 == $ftype )
|
|
and print "\$result->ftype .......... ok\n"
|
|
or print "\$result->ftype .......... not ok: $ftype\n";
|
|
|
|
my $fsize = $result->fsize(0);
|
|
( 4 == $fsize )
|
|
and print "\$result->fsize .......... ok\n"
|
|
or print "\$result->fsize .......... not ok: $fsize\n";
|
|
|
|
my $fnumber = $result->fnumber($fname);
|
|
( 0 == $fnumber )
|
|
and print "\$result->fnumber ........ ok\n"
|
|
or print "\$result->fnumber ........ not ok: $fnumber\n";
|
|
|
|
$string = "";
|
|
my @row;
|
|
while (@row = $result->fetchrow) {
|
|
$string = join(" ", @row);
|
|
}
|
|
( "5 Edmund Mergl " eq $string )
|
|
and print "\$result->fetchrow ....... ok\n"
|
|
or print "\$result->fetchrow ....... not ok: $string\n";
|
|
|
|
######################### debug, PQuntrace
|
|
|
|
if ($DEBUG) {
|
|
close(FD) || die "bad TRACE: $!";
|
|
$conn->untrace;
|
|
}
|
|
|
|
######################### disconnect and drop test database
|
|
|
|
$conn = Pg::connectdb("dbname=$dbmain");
|
|
die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
|
|
|
|
# Race condition: it's quite possible that the DROP command will arrive
|
|
# at the new backend before the old backend has finished shutting down,
|
|
# resulting in an error message.
|
|
# There doesn't seem to be any more graceful way around this than to
|
|
# insert a small delay ...
|
|
sleep(1);
|
|
|
|
$result = $conn->exec("DROP DATABASE $dbname");
|
|
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
|
|
|
|
print "test sequence finished.\n";
|
|
|
|
######################### EOF
|