#!/usr/local/bin/perl -w # $Id: test.pl,v 1.13 2000/11/17 00:24:03 tgl 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