Enter select command: | ",
"
", $query->textfield(-name=>'cmd', -size=>40), " | ",
my $conninfo = $query->param('conninfo');
my $conn = Pg::connectdb($conninfo);
- if ($conn->status == PGRES_CONNECTION_OK) {
+ if (PGRES_CONNECTION_OK == $conn->status) {
my $cmd = $query->param('cmd');
my $result = $conn->exec($cmd);
- print "
\n";
- my @row;
- while (@row = $result->fetchrow) {
- print "
", join(" | ", @row), " |
";
+ if (PGRES_TUPLES_OK == $result->resultStatus) {
+ print "
\n";
+ my @row;
+ while (@row = $result->fetchrow) {
+ print "
", join(" | ", @row), " |
";
+ }
+ print "
\n";
+ } else {
+ print "
", $conn->errorMessage, "
\n";
}
- print "
\n";
} else {
- print "
Connect to database failed
\n";
+ print "
", $conn->errorMessage, "
\n";
}
}
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl
-#-------------------------------------------------------
-#
-# $Id: example.newstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: example.newstyle,v 1.6 1998/09/27 19:12:34 mergl Exp $
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+######################### globals
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; print "1..56\n"; }
-END {print "not ok 1\n" unless $loaded;}
+$| = 1;
use Pg;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
$dbmain = 'template1';
$dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out';
-$cnt = 2;
$DEBUG = 0; # set this to 1 for traces
-$| = 1;
-
-######################### the following methods will be tested
+######################### the following methods will be used
# connectdb
+# conndefaults
# db
# user
# port
-# finish
# status
# errorMessage
# trace
# untrace
# exec
+# consumeInput
# getline
-# endcopy
# putline
+# endcopy
# resultStatus
# ntuples
# nfields
# lo_export
# lo_unlink
-######################### the following methods will not be tested
+######################### the following methods will not be used
# setdb
-# conndefaults
+# setdbLogin
# reset
-# options
+# requestCancel
+# pass
# host
# tty
+# options
+# socket
+# backendPID
+# sendQuery
+# getResult
+# isBusy
+# getlineAsync
+# putnbytes
+# makeEmptyPGresult
+# fmod
# getlength
# getisnull
# displayTuples
$SIG{PIPE} = sub { print "broken pipe\n" };
######################### 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");
-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
-$result = $conn->exec("DROP DATABASE $dbname");
+# do not complain when dropping $dbname
+$conn->exec("DROP 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");
-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) {
open(TRACE, ">$trace") || die "can not open $trace: $!";
$conn->trace(TRACE);
+ print "enabled tracing into $trace\n";
}
######################### check PGconn
-# 5-7
$db = $conn->db;
-cmp_eq($dbname, $db);
+print " database: $db\n";
$user = $conn->user;
-cmp_ne("", $user);
+print " user: $user\n";
$port = $conn->port;
-cmp_ne("", $port);
+print " port: $port\n";
######################### create and insert into table
-# 8-19
$result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("CREATE", $result->cmdStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "created table, status = ", $result->cmdStatus, "\n";
for ($i = 1; $i <= 5; $i++) {
$result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
- cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
- cmp_ne(0, $result->oidStatus);
+ die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
}
+print "insert into table, last oid = ", $result->oidStatus, "\n";
-######################### copy to stdout, PQgetline
-# 20-26
+######################### copy to stdout, getline
$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;
+$i = 1;
while (-1 != $ret) {
$ret = $conn->getline($string, 256);
last if $string eq "\\.";
- cmp_eq("$i Edmund Mergl ", $string);
+ print " ", $string, "\n";
$i ++;
}
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage unless 0 == $conn->endcopy;
-######################### delete and copy from stdin, PQputline
-# 27-33
+######################### delete and copy from stdin, putline
$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");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("DELETE 5", $result->cmdStatus);
-cmp_eq("5", $result->cmdTuples);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "delete from table, command status = ", $result->cmdStatus, ", no. of tuples = ", $result->cmdTuples, "\n";
$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++) {
# watch the tabs and do not forget the newlines
}
$conn->putline("\\.\n");
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage unless 0 == $conn->endcopy;
$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
-# 34-47
+######################### select from person, getvalue
$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++) {
- $fname = $result->fname($k);
- $ftype = $result->ftype($k);
- $fsize = $result->fsize($k);
- if (0 == $k) {
- cmp_eq("id", $fname);
- cmp_eq(23, $ftype);
- cmp_eq(4, $fsize);
- } else {
- cmp_eq("name", $fname);
- cmp_eq(1042, $ftype);
- cmp_eq(-1, $fsize);
- }
- $fnumber = $result->fnumber($fname);
- cmp_eq($k, $fnumber);
+ print " field = ", $k, "\tfname = ", $result->fname($k), "\tftype = ", $result->ftype($k), "\tfsize = ", $result->fsize($k), "\tfnumber = ", $result->fnumber($result->fname($k)), "\n";
}
-$string = "";
while (@row = $result->fetchrow) {
- $string = join(" ", @row);
+ print " ", join(" ", @row), "\n";
}
-cmp_eq("5 Edmund Mergl ", $string);
-######################### PQnotifies
-# 43-46
+######################### notifies
if (! defined($pid = fork)) {
die "can not fork: $!";
} elsif (! $pid) {
- # i'm the child
+ # I'm the child
sleep 2;
bless $conn;
$conn = Pg::connectdb("dbname=$dbname");
}
$result = $conn->exec("LISTEN person");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("LISTEN", $result->cmdStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "listen table: status = ", $result->cmdStatus, "\n";
while (1) {
- $result = $conn->exec(" ");
+ $conn->consumeInput;
($table, $pid) = $conn->notifies;
last if $pid;
}
+print "got notification: table = ", $table, " pid = ", $pid, "\n";
-cmp_eq("person", $table);
+######################### print
-######################### PQprint
-# 47-48
+$result = $conn->exec("SELECT * FROM person");
+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");
-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: $!";
+######################### lo_import, lo_export, lo_unlink
-######################### PQlo_import, PQlo_export, PQlo_unlink
-# 49-54
+$lobject_in = '/tmp/gaga.in';
+$lobject_out = '/tmp/gaga.out';
-$filename = 'ApachePg.pl';
-$cwd = `pwd`;
-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 = $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");
-cmp_ne(0, $lobjOid);
+$lobjOid = $conn->lo_import("$lobject_in") or die $conn->errorMessage;
+print "importing file as large object, Oid = ", $lobjOid, "\n";
-cmp_ne(-1, $conn->lo_export($lobjOid, "/tmp/$filename"));
-
-cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+die $conn->errorMessage unless 1 == $conn->lo_export($lobjOid, "$lobject_out");
+print "exporting large object as temporary file\n";
$result = $conn->exec("END");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+
+print "comparing imported file with exported file: ";
+print "not " unless (-s "$lobject_in" == -s "$lobject_out");
+print "ok\n";
-cmp_ne(-1, $conn->lo_unlink($lobjOid));
-unlink "/tmp/$filename";
+die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid);
+unlink $lobject_in;
+unlink $lobject_out;
+print "unlink large object\n";
-######################### debug, PQuntrace
+######################### debug, untrace
if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!";
$conn->untrace;
+ print "tracing disabled\n";
}
######################### disconnect and drop test database
-# 55-56
$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");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-
-######################### 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++;
-}
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
+print "drop database\n";
######################### EOF
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl
-#-------------------------------------------------------
-#
-# $Id: example.oldstyle,v 1.5 1998/06/01 16:41:27 mergl Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: example.oldstyle,v 1.6 1998/09/27 19:12:35 mergl Exp $
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+######################### globals
-######################### We start with some black magic to print on failure.
-
-BEGIN { $| = 1; print "1..60\n"; }
-END {print "not ok 1\n" unless $loaded;}
+$| = 1;
use Pg;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
$dbmain = 'template1';
$dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out';
-$cnt = 2;
$DEBUG = 0; # set this to 1 for traces
-$| = 1;
-
######################### the following functions will be tested
# PQsetdb()
# PQdb()
+# PQuser()
# PQport()
-# PQfinish()
# PQstatus()
+# PQfinish()
# PQerrorMessage()
# PQtrace()
# PQuntrace()
# PQexec()
+# PQconsumeInput
# PQgetline()
-# PQendcopy()
# PQputline()
+# PQendcopy()
# PQresultStatus()
# PQntuples()
# PQnfields()
# PQconnectdb()
# PQconndefaults()
+# PQsetdbLogin()
# PQreset()
-# PQoptions()
+# PQrequestCancel()
+# PQpass()
# PQhost()
# PQtty()
+# PQoptions()
+# PQsocket()
+# PQbackendPID()
+# PQsendQuery()
+# PQgetResult()
+# PQisBusy()
+# PQgetlineAsync()
+# PQputnbytes()
+# PQmakeEmptyPGresult()
+# PQfmod()
# PQgetlength()
# PQgetisnull()
# PQdisplayTuples()
$SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database
-# 2-4
$conn = PQsetdb('', '', '', '', $dbmain);
-cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
+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");
PQclear($result);
$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);
PQfinish($conn);
$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
if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!";
PQtrace($conn, TRACE);
+ print "enabled tracing into $trace\n";
}
######################### check PGconn
-# 5-7
$db = PQdb($conn);
-cmp_eq($dbname, $db);
+print " database: $db\n";
$user = PQuser($conn);
-cmp_ne("", $user);
+print " user: $user\n";
$port = PQport($conn);
-cmp_ne("", $port);
+print " port: $port\n";
######################### create and insert into table
-# 8-19
$result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("CREATE", PQcmdStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "created table, status = ", PQcmdStatus($result), "\n";
PQclear($result);
for ($i = 1; $i <= 5; $i++) {
$result = PQexec($conn, "INSERT INTO person VALUES ($i, 'Edmund Mergl')");
- cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
- cmp_ne(0, PQoidStatus($result));
+ die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result);
}
+print "insert into table, last oid = ", PQoidStatus($result), "\n";
######################### copy to stdout, PQgetline
-# 20-26
$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);
-$i = 1;
$ret = 0;
+$i = 1;
while (-1 != $ret) {
$ret = PQgetline($conn, $string, 256);
last if $string eq "\\.";
- cmp_eq("$i Edmund Mergl ", $string);
+ print " ", $string, "\n";
$i++;
}
-cmp_eq(0, PQendcopy($conn));
+die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
######################### delete and copy from stdin, PQputline
-# 27-33
$result = PQexec($conn, "BEGIN");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result);
$result = PQexec($conn, "DELETE FROM person");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("DELETE 5", PQcmdStatus($result));
-cmp_eq("5", PQcmdTuples($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "delete from table, command status = ", PQcmdStatus($result), ", no. of tuples = ", PQcmdTuples($result), "\n";
PQclear($result);
$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);
for ($i = 1; $i <= 5; $i++) {
}
PQputline($conn, "\\.\n");
-cmp_eq(0, PQendcopy($conn));
+die PQerrorMessage($conn) unless 0 == PQendcopy($conn);
$result = PQexec($conn, "END");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result);
######################### select from person, PQgetvalue
-# 34-47
$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++) {
- $fname = PQfname($result, $k);
- $ftype = PQftype($result, $k);
- $fsize = PQfsize($result, $k);
- if (0 == $k) {
- cmp_eq("id", $fname);
- cmp_eq(23, $ftype);
- cmp_eq(4, $fsize);
- } else {
- cmp_eq("name", $fname);
- cmp_eq(1042, $ftype);
- cmp_eq(-1, $fsize);
- }
- $fnumber = PQfnumber($result, $fname);
- cmp_eq($k, $fnumber);
+ print " field = ", $k, "\tfname = ", PQfname($result, $k), "\tftype = ", PQftype($result, $k), "\tfsize = ", PQfsize($result, $k), "\tfnumber = ", PQfnumber($result, PQfname($result, $k)), "\n";
}
for ($k = 0; $k < PQntuples($result); $k++) {
- $string = "";
for ($l = 0; $l < PQnfields($result); $l++) {
- $string .= PQgetvalue($result, $k, $l) . " ";
+ print " ", PQgetvalue($result, $k, $l);
}
- $i = $k + 1;
- cmp_eq("$i Edmund Mergl ", $string);
+ print "\n";
}
PQclear($result);
######################### PQnotifies
-# 48-50
if (! defined($pid = fork)) {
die "can not fork: $!";
} elsif (! $pid) {
- # i'm the child
+ # I'm the child
sleep 2;
$conn = PQsetdb('', '', '', '', $dbname);
$result = PQexec($conn, "NOTIFY person");
}
$result = PQexec($conn, "LISTEN person");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
-cmp_eq("LISTEN", PQcmdStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "listen table: status = ", PQcmdStatus($result), "\n";
PQclear($result);
while (1) {
- $result = PQexec($conn, " ");
+ PQconsumeInput($conn);
($table, $pid) = PQnotifies($conn);
- PQclear($result);
last if $pid;
}
-
-cmp_eq("person", $table);
+print "got notification: table = ", $table, " pid = ", $pid, "\n";
######################### PQprint
-# 51-52
-$result = PQexec($conn, "SELECT name FROM person WHERE id = 2");
-cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
-open(PRINT, "| read IN; read IN; if [ \"\$IN\" = \"myName Edmund Mergl\" ]; then echo \"ok $cnt\"; else echo \"not ok $cnt\"; fi ") || die "can not fork: $|";
-$cnt ++;
-PQprint(PRINT, $result, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
+$result = PQexec($conn, "SELECT * FROM person");
+die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result);
+print "select from table and print:\n";
+PQprint(STDOUT, $result, 0, 0, 0, 0, 0, 0, " ", "", "", "");
PQclear($result);
-close(PRINT) || die "bad PRINT: $!";
######################### PQlo_import, PQlo_export, PQlo_unlink
-# 53-59
-$filename = 'ApachePg.pl';
-$cwd = `pwd`;
-chop $cwd;
+$lobject_in = '/tmp/gaga.in';
+$lobject_out = '/tmp/gaga.out';
+
+$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");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result);
-$lobjOid = PQlo_import($conn, "$cwd/$filename");
-cmp_ne( 0, $lobjOid);
-
-cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename"));
+$lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn);
+print "importing file as large object, Oid = ", $lobjOid, "\n";
-cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
+die PQerrorMessage($conn) unless 1 == PQlo_export($conn, $lobjOid, "$lobject_out");
+print "exporting large object as temporary file\n";
$result = PQexec($conn, "END");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
PQclear($result);
-cmp_ne(-1, PQlo_unlink($conn, $lobjOid));
-unlink "/tmp/$filename";
+print "comparing imported file with exported file: ";
+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
if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!";
PQuntrace($conn);
+ print "tracing disabled\n";
}
######################### disconnect and drop test database
-# 59-60
PQfinish($conn);
$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");
-cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
+die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
+print "drop database\n";
PQclear($result);
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
#!/usr/local/bin/perl -w
-#-------------------------------------------------------
-#
-# $Id: test.pl,v 1.8 1998/06/01 16:41:20 mergl Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
+# $Id: test.pl,v 1.9 1998/09/27 19:12:26 mergl 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; print "1..45\n"; }
-END {print "not ok 1\n" unless $loaded;}
+BEGIN { $| = 1; }
+END {print "test failed\n" unless $loaded;}
use Pg;
$loaded = 1;
-print "ok 1\n";
+use strict;
######################### End of black magic.
-$dbmain = 'template1';
-$dbname = 'pgperltest';
-$trace = '/tmp/pgtrace.out';
-$cnt = 2;
-$DEBUG = 0; # set this to 1 for traces
+my $dbmain = 'template1';
+my $dbname = 'pgperltest';
+my $trace = '/tmp/pgtrace.out';
+my ($conn, $result, $i);
-$| = 1;
+my $DEBUG = 0; # set this to 1 for traces
######################### the following methods will be tested
# connectdb
+# conndefaults
# db
# user
# port
-# finish
# status
# errorMessage
# trace
# untrace
# exec
# getline
-# endcopy
# putline
+# endcopy
# resultStatus
-# ntuples
-# nfields
# fname
# fnumber
# ftype
# cmdStatus
# oidStatus
# cmdTuples
-# getvalue
+# fetchrow
######################### the following methods will not be tested
# setdb
-# conndefaults
+# setdbLogin
# reset
-# options
+# requestCancel
+# pass
# host
# tty
+# options
+# socket
+# backendPID
+# notifies
+# sendQuery
+# getResult
+# isBusy
+# consumeInput
+# getlineAsync
+# putnbytes
+# makeEmptyPGresult
+# ntuples
+# nfields
+# binaryTuples
+# fmod
+# getvalue
# getlength
# getisnull
# print
-# notifies
# displayTuples
# printTuples
# lo_import
$SIG{PIPE} = sub { print "broken pipe\n" };
######################### 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");
-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
-$result = $conn->exec("DROP DATABASE $dbname");
+# do not complain when dropping $dbname
+$conn->exec("DROP 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");
-cmp_eq(PGRES_CONNECTION_OK, $conn->status);
+die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
######################### debug, PQtrace
if ($DEBUG) {
- open(TRACE, ">$trace") || die "can not open $trace: $!";
- $conn->trace(TRACE);
+ open(FD, ">$trace") || die "can not open $trace: $!";
+ $conn->trace("FD");
}
######################### check PGconn
-# 5-7
-$db = $conn->db;
-cmp_eq($dbname, $db);
+my $db = $conn->db;
+( $dbname eq $db )
+ and print "\$conn->db ............... ok\n"
+ or print "\$conn->db ............... not ok: $db\n";
-$user = $conn->user;
-cmp_ne("", $user);
+my $user = $conn->user;
+( "" ne $user )
+ and print "\$conn->user ............. ok\n"
+ or print "\$conn->user ............. not ok: $user\n";
-$port = $conn->port;
-cmp_ne("", $port);
+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
-# 8-19
$result = $conn->exec("CREATE TABLE person (id int4, name char(16))");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("CREATE", $result->cmdStatus);
+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')");
- cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
- cmp_ne(0, $result->oidStatus);
+ 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
-# 20-26
$result = $conn->exec("COPY person TO STDOUT");
-cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
+die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus;
-$i = 1;
-$ret = 0;
+my $ret = 0;
+my $buf;
+my $string;
+$i = 1;
while (-1 != $ret) {
- $ret = $conn->getline($string, 256);
- last if $string eq "\\.";
- cmp_eq("$i Edmund Mergl ", $string);
+ $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";
-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
-# 27-33
$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");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-cmp_eq("DELETE 5", $result->cmdStatus);
-cmp_eq("5", $result->cmdTuples);
+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");
-cmp_eq(PGRES_COPY_IN, $result->resultStatus);
+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("\\.\n");
-cmp_eq(0, $conn->endcopy);
+die $conn->errorMessage if $conn->endcopy;
$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
-# 34-43
$result = $conn->exec("SELECT * FROM person");
-cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
-
-for ($k = 0; $k < $result->nfields; $k++) {
- $fname = $result->fname($k);
- $ftype = $result->ftype($k);
- $fsize = $result->fsize($k);
- if (0 == $k) {
- cmp_eq("id", $fname);
- cmp_eq(23, $ftype);
- cmp_eq(4, $fsize);
- } else {
- cmp_eq("name", $fname);
- cmp_eq(1042, $ftype);
- cmp_eq(-1, $fsize);
- }
- $fnumber = $result->fnumber($fname);
- cmp_eq($k, $fnumber);
-}
+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);
}
-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
if ($DEBUG) {
- close(TRACE) || die "bad TRACE: $!";
+ close(FD) || die "bad TRACE: $!";
$conn->untrace;
}
######################### disconnect and drop test database
-# 44-45
$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");
-cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
-
-######################### hopefully
-
-print "test sequence finished.\n" if 51 == $cnt;
+die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
-######################### 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++;
-}
+print "test sequence finished.\n";
######################### EOF
#-------------------------------------------------------
#
-# $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
#
ConnStatusType T_IV
ExecStatusType T_IV
Oid T_IV
-int2 T_IV
-bool T_IV
+pqbool T_IV