1berry/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

adapted to pgsql-v6.2

Browse Source
This commit is contained in:
Edmund Mergl 1997-09-17 20:48:15 +00:00
parent 9e74edda05
commit 364efd1029
3 changed files with 709 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/interfaces/perl5/eg/ApachePg.pl Normal file
View File

@ -0,0 +1,37 @@
#!/usr/local/bin/perl
# demo script, tested with:
# - PostgreSQL-6.2
# - apache_1.2.4
# - mod_perl-1.00
# - perl5.004_01
use CGI;
use Pg;
$query = new CGI;
print $query->header,
$query->start_html(-title=>'A Simple Example'),
$query->startform,
"<CENTER><H3>Testing Module Pg</H3></CENTER>",
"Enter database name: ",
$query->textfield(-name=>'dbname'),
"<P>",
"Enter select command: ",
$query->textfield(-name=>'cmd', -size=>40),
"<P>",
$query->submit(-value=>'Submit'),
$query->endform;
if ($query->param) {
$dbname = $query->param('dbname');
$conn = Pg::connectdb("dbname = $dbname");
$cmd = $query->param('cmd');
$result = $conn->exec($cmd);
$result->print(STDOUT, 0, 0, 0, 1, 0, 0, '', '', '');
}
print $query->end_html;

324
src/interfaces/perl5/eg/example.newstyle Normal file
View File

@ -0,0 +1,324 @@
#!/usr/local/bin/perl
#-------------------------------------------------------
#
# $Id: example.newstyle,v 1.1 1997/09/17 20:48:14 mergl Exp $
#
# Copyright (c) 1997 Edmund Mergl
#
#-------------------------------------------------------
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..61\n"; }
END {print "not ok 1\n" unless $loaded;}
use Pg;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
$dbmain = 'template1';
$dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out';
$cnt = 2;
$DEBUG = 0; # set this to 1 for traces
$| = 1;
######################### the following methods will be tested
# connectdb
# db
# user
# host
# port
# finish
# status
# errorMessage
# trace
# untrace
# exec
# getline
# endcopy
# putline
# resultStatus
# ntuples
# nfields
# fname
# fnumber
# ftype
# fsize
# cmdStatus
# oidStatus
# cmdTuples
# getvalue
# print
# notifies
# lo_import
# lo_export
# lo_unlink
######################### the following methods will not be tested
# setdb
# conndefaults
# reset
# options
# tty
# getlength
# getisnull
# displayTuples
# printTuples
# lo_open
# lo_close
# lo_read
# lo_write
# lo_creat
# lo_seek
# lo_tell
######################### handles error condition
$SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database
# 2-4
$conn = Pg::connectdb("dbname = $dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
# might fail if $dbname doesn't exist => don't check resultStatus
$result = $conn->exec("DROP DATABASE $dbname");
$result = $conn->exec("CREATE DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
$conn = Pg::connectdb("dbname = $dbname");
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
######################### debug, PQtrace
if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!";
$conn->trace(TRACE);
}
######################### check PGconn
# 5-8
$db = $conn->db;
cmp_eq($dbname, $db);
$user = $conn->user;
cmp_ne("", $user);
$host = $conn->host;
cmp_ne("", $host);
$port = $conn->port;
cmp_ne("", $port);
######################### create and insert into table
# 9-20
$result = $conn->exec("CREATE TABLE person (id int4, name char16)");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
cmp_eq("CREATE", $result->cmdStatus);
for ($i = 1; $i <= 5; $i++) {
$result = $conn->exec("INSERT INTO person VALUES ($i, 'Edmund Mergl')");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
cmp_ne(0, $result->oidStatus);
}
######################### copy to stdout, PQgetline
# 21-27
$result = $conn->exec("COPY person TO STDOUT");
cmp_eq(PGRES_COPY_OUT, $result->resultStatus);
$i = 1;
while (-1 != $ret) {
$ret = $conn->getline($string, 256);
last if $string eq "\\.";
cmp_eq("$i Edmund Mergl", $string);
$i ++;
}
cmp_eq(0, $conn->endcopy);
######################### delete and copy from stdin, PQputline
# 28-34
$result = $conn->exec("BEGIN");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
$result = $conn->exec("DELETE FROM person");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
cmp_eq("DELETE 5", $result->cmdStatus);
cmp_eq("5", $result->cmdTuples);
$result = $conn->exec("COPY person FROM STDIN");
cmp_eq(PGRES_COPY_IN, $result->resultStatus);
for ($i = 1; $i <= 5; $i++) {
# watch the tabs and do not forget the newlines
$conn->putline("$i Edmund Mergl\n");
}
$conn->putline("\\.\n");
cmp_eq(0, $conn->endcopy);
$result = $conn->exec("END");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
######################### select from person, PQgetvalue
# 35-48
$result = $conn->exec("SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
for ($k = 0; $k < $result->nfields; $k++) {
$fname = $result->fname($k);
$ftype = $result->ftype($k);
$fsize = $result->fsize($k);
if (0 == $k) {
cmp_eq("id", $fname);
cmp_eq(23, $ftype);
cmp_eq(4, $fsize);
} else {
cmp_eq("name", $fname);
cmp_eq(20, $ftype);
cmp_eq(16, $fsize);
}
$fnumber = $result->fnumber($fname);
cmp_eq($k, $fnumber);
}
for ($k = 0; $k < $result->ntuples; $k++) {
$string = "";
for ($l = 0; $l < $result->nfields; $l++) {
$string .= $result->getvalue($k, $l) . " ";
}
$i = $k + 1;
cmp_eq("$i Edmund Mergl ", $string);
}
######################### PQnotifies
# 49-51
if (! defined($pid = fork)) {
die "can not fork: $!";
} elsif (! $pid) {
# i'm the child
sleep 2;
bless $conn;
$conn = Pg::connectdb("dbname = $dbname");
$result = $conn->exec("NOTIFY person");
exit;
}
$result = $conn->exec("LISTEN person");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
cmp_eq("LISTEN", $result->cmdStatus);
while (1) {
$result = $conn->exec(" ");
($table, $pid) = $conn->notifies;
last if $pid;
}
cmp_eq("person", $table);
######################### PQprint
# 52-53
$result = $conn->exec("SELECT name FROM person WHERE id = 2");
cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
open(PRINT, "| read IN; read IN; if [ \"\$IN\" = \"myName Edmund Mergl\" ]; then echo \"ok $cnt\"; else echo \"not ok $cnt\"; fi ") || die "can not fork: $|";
$cnt ++;
$result->print(PRINT, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
close(PRINT) || die "bad PRINT: $!";
######################### PQlo_import, PQlo_export, PQlo_unlink
# 54-59
$filename = 'ApachePg.pl';
$cwd = `pwd`;
chop $cwd;
$result = $conn->exec("BEGIN");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
$lobjOid = $conn->lo_import("$cwd/$filename");
cmp_ne(0, $lobjOid);
cmp_ne(-1, $conn->lo_export($lobjOid, "/tmp/$filename"));
cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
$result = $conn->exec("END");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
cmp_ne(-1, $conn->lo_unlink($lobjOid));
unlink "/tmp/$filename";
######################### debug, PQuntrace
if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!";
$conn->untrace;
}
######################### disconnect and drop test database
# 60-61
$conn = Pg::connectdb("dbname = $dbmain");
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
$result = $conn->exec("DROP DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
######################### hopefully
print "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

348
src/interfaces/perl5/eg/example.oldstyle Normal file
View File

@ -0,0 +1,348 @@
#!/usr/local/bin/perl
#-------------------------------------------------------
#
# $Id: example.oldstyle,v 1.1 1997/09/17 20:48:15 mergl Exp $
#
# Copyright (c) 1997 Edmund Mergl
#
#-------------------------------------------------------
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..61\n"; }
END {print "not ok 1\n" unless $loaded;}
use Pg;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
$dbmain = 'template1';
$dbname = 'pgperltest';
$trace = '/tmp/pgtrace.out';
$cnt = 2;
$DEBUG = 0; # set this to 1 for traces
$| = 1;
######################### the following functions will be tested
# PQsetdb()
# PQdb()
# PQhost()
# PQport()
# PQfinish()
# PQstatus()
# PQerrorMessage()
# PQtrace()
# PQuntrace()
# PQexec()
# PQgetline()
# PQendcopy()
# PQputline()
# PQresultStatus()
# PQntuples()
# PQnfields()
# PQfname()
# PQfnumber()
# PQftype()
# PQfsize()
# PQcmdStatus()
# PQoidStatus()
# PQcmdTuples()
# PQgetvalue()
# PQclear()
# PQprint()
# PQnotifies()
# PQlo_import()
# PQlo_export()
# PQlo_unlink()
######################### the following functions will not be tested
# PQconnectdb()
# PQconndefaults()
# PQreset()
# PQoptions()
# PQtty()
# PQgetlength()
# PQgetisnull()
# PQdisplayTuples()
# PQprintTuples()
# PQlo_open()
# PQlo_close()
# PQlo_read()
# PQlo_write()
# PQlo_creat()
# PQlo_lseek()
# PQlo_tell()
######################### handles error condition
$SIG{PIPE} = sub { print "broken pipe\n" };
######################### create and connect to test database
# 2-4
$conn = PQsetdb('', '', '', '', $dbmain);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
# might fail if $dbname doesn't exist => don't check resultStatus
$result = PQexec($conn, "DROP DATABASE $dbname");
PQclear($result);
$result = PQexec($conn, "CREATE DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbname);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
######################### debug, PQtrace
if ($DEBUG) {
open(TRACE, ">$trace") || die "can not open $trace: $!";
PQtrace($conn, TRACE);
}
######################### check PGconn
# 5-8
$db = PQdb($conn);
cmp_eq($dbname, $db);
$user = PQuser($conn);
cmp_ne("", $user);
$host = PQhost($conn);
cmp_ne("", $host);
$port = PQport($conn);
cmp_ne("", $port);
######################### create and insert into table
# 9-20
$result = PQexec($conn, "CREATE TABLE person (id int4, name char16)");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
cmp_eq("CREATE", PQcmdStatus($result));
PQclear($result);
for ($i = 1; $i <= 5; $i++) {
$result = PQexec($conn, "INSERT INTO person VALUES ($i, 'Edmund Mergl')");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
cmp_ne(0, PQoidStatus($result));
PQclear($result);
}
######################### copy to stdout, PQgetline
# 21-27
$result = PQexec($conn, "COPY person TO STDOUT");
cmp_eq(PGRES_COPY_OUT, PQresultStatus($result));
PQclear($result);
$i = 1;
while (-1 != $ret) {
$ret = PQgetline($conn, $string, 256);
last if $string eq "\\.";
cmp_eq("$i Edmund Mergl", $string);
$i++;
}
cmp_eq(0, PQendcopy($conn));
######################### delete and copy from stdin, PQputline
# 28-34
$result = PQexec($conn, "BEGIN");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
$result = PQexec($conn, "DELETE FROM person");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
cmp_eq("DELETE 5", PQcmdStatus($result));
cmp_eq("5", PQcmdTuples($result));
PQclear($result);
$result = PQexec($conn, "COPY person FROM STDIN");
cmp_eq(PGRES_COPY_IN, PQresultStatus($result));
PQclear($result);
for ($i = 1; $i <= 5; $i++) {
# watch the tabs and do not forget the newlines
PQputline($conn, "$i Edmund Mergl\n");
}
PQputline($conn, "\\.\n");
cmp_eq(0, PQendcopy($conn));
$result = PQexec($conn, "END");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
######################### select from person, PQgetvalue
# 35-48
$result = PQexec($conn, "SELECT * FROM person");
cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
for ($k = 0; $k < PQnfields($result); $k++) {
$fname = PQfname($result, $k);
$ftype = PQftype($result, $k);
$fsize = PQfsize($result, $k);
if (0 == $k) {
cmp_eq("id", $fname);
cmp_eq(23, $ftype);
cmp_eq(4, $fsize);
} else {
cmp_eq("name", $fname);
cmp_eq(20, $ftype);
cmp_eq(16, $fsize);
}
$fnumber = PQfnumber($result, $fname);
cmp_eq($k, $fnumber);
}
for ($k = 0; $k < PQntuples($result); $k++) {
$string = "";
for ($l = 0; $l < PQnfields($result); $l++) {
$string .= PQgetvalue($result, $k, $l) . " ";
}
$i = $k + 1;
cmp_eq("$i Edmund Mergl ", $string);
}
PQclear($result);
######################### PQnotifies
# 49-51
if (! defined($pid = fork)) {
die "can not fork: $!";
} elsif (! $pid) {
# i'm the child
sleep 2;
$conn = PQsetdb('', '', '', '', $dbname);
$result = PQexec($conn, "NOTIFY person");
PQclear($result);
PQfinish($conn);
exit;
}
$result = PQexec($conn, "LISTEN person");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
cmp_eq("LISTEN", PQcmdStatus($result));
PQclear($result);
while (1) {
$result = PQexec($conn, " ");
($table, $pid) = PQnotifies($conn);
PQclear($result);
last if $pid;
}
cmp_eq("person", $table);
######################### PQprint
# 52-53
$result = PQexec($conn, "SELECT name FROM person WHERE id = 2");
cmp_eq(PGRES_TUPLES_OK, PQresultStatus($result));
open(PRINT, "| read IN; read IN; if [ \"\$IN\" = \"myName Edmund Mergl\" ]; then echo \"ok $cnt\"; else echo \"not ok $cnt\"; fi ") || die "can not fork: $|";
$cnt ++;
PQprint(PRINT, $result, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
PQclear($result);
close(PRINT) || die "bad PRINT: $!";
######################### PQlo_import, PQlo_export, PQlo_unlink
# 54-60
$filename = 'ApachePg.pl';
$cwd = `pwd`;
chop $cwd;
$result = PQexec($conn, "BEGIN");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
$lobjOid = PQlo_import($conn, "$cwd/$filename");
cmp_ne( 0, $lobjOid);
cmp_ne(-1, PQlo_export($conn, $lobjOid, "/tmp/$filename"));
cmp_eq(-s "$cwd/$filename", -s "/tmp/$filename");
$result = PQexec($conn, "END");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
cmp_ne(-1, PQlo_unlink($conn, $lobjOid));
unlink "/tmp/$filename";
######################### debug, PQuntrace
if ($DEBUG) {
close(TRACE) || die "bad TRACE: $!";
PQuntrace($conn);
}
######################### disconnect and drop test database
# 60-61
PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbmain);
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
$result = PQexec($conn, "DROP DATABASE $dbname");
cmp_eq(PGRES_COMMAND_OK, PQresultStatus($result));
PQclear($result);
PQfinish($conn);
######################### hopefully
print "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