open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

adapted to pgsql-v6.2

Browse Source
pull/50/head
Edmund Mergl 28 years ago
parent 9e74edda05
commit 364efd1029
3 changed files with 709 additions and 0 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 37
      src/interfaces/perl5/eg/ApachePg.pl
  2. 324
      src/interfaces/perl5/eg/example.newstyle
  3. 348
      src/interfaces/perl5/eg/example.oldstyle

37
src/interfaces/perl5/eg/ApachePg.pl
Unescape 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
Unescape 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
Unescape 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
Write Preview
Loading…
Cancel
Save