From 0cfe2374a76d9408b0271063a7fbbc1572cd3f6c Mon Sep 17 00:00:00 2001 From: Bruce Momjian Date: Thu, 1 Jun 2000 03:05:24 +0000 Subject: Rename perl example eg directory to examples. --- src/interfaces/perl5/eg/ApachePg.pl | 55 ----- src/interfaces/perl5/eg/example.newstyle | 274 ----------------------- src/interfaces/perl5/eg/example.oldstyle | 294 ------------------------- src/interfaces/perl5/examples/ApachePg.pl | 55 +++++ src/interfaces/perl5/examples/example.newstyle | 274 +++++++++++++++++++++++ src/interfaces/perl5/examples/example.oldstyle | 294 +++++++++++++++++++++++++ 6 files changed, 623 insertions(+), 623 deletions(-) delete mode 100644 src/interfaces/perl5/eg/ApachePg.pl delete mode 100644 src/interfaces/perl5/eg/example.newstyle delete mode 100644 src/interfaces/perl5/eg/example.oldstyle create mode 100644 src/interfaces/perl5/examples/ApachePg.pl create mode 100644 src/interfaces/perl5/examples/example.newstyle create mode 100644 src/interfaces/perl5/examples/example.oldstyle (limited to 'src/interfaces/perl5') diff --git a/src/interfaces/perl5/eg/ApachePg.pl b/src/interfaces/perl5/eg/ApachePg.pl deleted file mode 100644 index 136d6122d89..00000000000 --- a/src/interfaces/perl5/eg/ApachePg.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/local/bin/perl - -# $Id: ApachePg.pl,v 1.5 1998/09/27 19:12:33 mergl Exp $ - -# demo script, tested with: -# - PostgreSQL-6.4 -# - apache_1.3.1 -# - mod_perl-1.15 -# - perl5.005_02 - -use CGI; -use Pg; -use strict; - -my $query = new CGI; - -print $query->header, - $query->start_html(-title=>'A Simple Example'), - $query->startform, - "

Testing Module Pg

", - "

", - "", - "", - "", - "", - "", - "", - "
Enter conninfo string: ", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "
Enter select command: ", $query->textfield(-name=>'cmd', -size=>40), "

", - "

", $query->submit(-value=>'Submit'), "
", - $query->endform; - -if ($query->param) { - - my $conninfo = $query->param('conninfo'); - my $conn = Pg::connectdb($conninfo); - if (PGRES_CONNECTION_OK == $conn->status) { - my $cmd = $query->param('cmd'); - my $result = $conn->exec($cmd); - if (PGRES_TUPLES_OK == $result->resultStatus) { - print "

\n"; - my @row; - while (@row = $result->fetchrow) { - print ""; - } - print "
", join("", @row), "

\n"; - } else { - print "

", $conn->errorMessage, "

\n"; - } - } else { - print "

", $conn->errorMessage, "

\n"; - } -} - -print $query->end_html; - diff --git a/src/interfaces/perl5/eg/example.newstyle b/src/interfaces/perl5/eg/example.newstyle deleted file mode 100644 index 9cccaa983f1..00000000000 --- a/src/interfaces/perl5/eg/example.newstyle +++ /dev/null @@ -1,274 +0,0 @@ -#!/usr/local/bin/perl - -# $Id: example.newstyle,v 1.6 1998/09/27 19:12:34 mergl Exp $ - -######################### globals - -$| = 1; -use Pg; - -$dbmain = 'template1'; -$dbname = 'pgperltest'; -$trace = '/tmp/pgtrace.out'; -$DEBUG = 0; # set this to 1 for traces - -######################### the following methods will be used - -# connectdb -# conndefaults -# db -# user -# port -# status -# errorMessage -# trace -# untrace -# exec -# consumeInput -# getline -# putline -# endcopy -# 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 used - -# setdb -# setdbLogin -# reset -# requestCancel -# pass -# host -# tty -# options -# socket -# backendPID -# sendQuery -# getResult -# isBusy -# getlineAsync -# putnbytes -# makeEmptyPGresult -# fmod -# 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 - -$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"); -die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; -print "connected to $dbmain\n"; - -# do not complain when dropping $dbname -$conn->exec("DROP DATABASE $dbname"); - -$result = $conn->exec("CREATE DATABASE $dbname"); -die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; -print "created database $dbname\n"; - -$conn = Pg::connectdb("dbname=$dbname"); -die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; -print "connected to $dbname\n"; - -######################### debug, trace - -if ($DEBUG) { - open(TRACE, ">$trace") || die "can not open $trace: $!"; - $conn->trace(TRACE); - print "enabled tracing into $trace\n"; -} - -######################### check PGconn - -$db = $conn->db; -print " database: $db\n"; - -$user = $conn->user; -print " user: $user\n"; - -$port = $conn->port; -print " port: $port\n"; - -######################### create and insert into table - -$result = $conn->exec("CREATE TABLE person (id int4, name char(16))"); -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')"); - die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; -} -print "insert into table, last oid = ", $result->oidStatus, "\n"; - -######################### copy to stdout, getline - -$result = $conn->exec("COPY person TO STDOUT"); -die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus; -print "copy table to STDOUT:\n"; - -$ret = 0; -$i = 1; -while (-1 != $ret) { - $ret = $conn->getline($string, 256); - last if $string eq "\\."; - print " ", $string, "\n"; - $i ++; -} - -die $conn->errorMessage unless 0 == $conn->endcopy; - -######################### delete and copy from stdin, putline - -$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; -print "delete from table, command status = ", $result->cmdStatus, ", no. of tuples = ", $result->cmdTuples, "\n"; - -$result = $conn->exec("COPY person FROM STDIN"); -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("$i Edmund Mergl\n"); -} -$conn->putline("\\.\n"); - -die $conn->errorMessage unless 0 == $conn->endcopy; - -$result = $conn->exec("END"); -die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; -print "ok\n"; - -######################### select from person, getvalue - -$result = $conn->exec("SELECT * FROM person"); -die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus; -print "select from table:\n"; - -for ($k = 0; $k < $result->nfields; $k++) { - print " field = ", $k, "\tfname = ", $result->fname($k), "\tftype = ", $result->ftype($k), "\tfsize = ", $result->fsize($k), "\tfnumber = ", $result->fnumber($result->fname($k)), "\n"; -} - -while (@row = $result->fetchrow) { - print " ", join(" ", @row), "\n"; -} - -######################### notifies - -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"); -die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; -print "listen table: status = ", $result->cmdStatus, "\n"; - -while (1) { - $conn->consumeInput; - ($table, $pid) = $conn->notifies; - last if $pid; -} -print "got notification: table = ", $table, " pid = ", $pid, "\n"; - -######################### print - -$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, " ", "", "", ""); - -######################### lo_import, lo_export, lo_unlink - -$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 = $conn->exec("BEGIN"); -die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; - -$lobjOid = $conn->lo_import("$lobject_in") or die $conn->errorMessage; -print "importing file as large object, Oid = ", $lobjOid, "\n"; - -die $conn->errorMessage unless 1 == $conn->lo_export($lobjOid, "$lobject_out"); -print "exporting large object as temporary file\n"; - -$result = $conn->exec("END"); -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"; - -die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid); -unlink $lobject_in; -unlink $lobject_out; -print "unlink large object\n"; - -######################### debug, untrace - -if ($DEBUG) { - close(TRACE) || die "bad TRACE: $!"; - $conn->untrace; - print "tracing disabled\n"; -} - -######################### disconnect and drop test database - -$conn = Pg::connectdb("dbname=$dbmain"); -die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; -print "connected to $dbmain\n"; - -$result = $conn->exec("DROP DATABASE $dbname"); -die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; -print "drop database\n"; - -######################### EOF diff --git a/src/interfaces/perl5/eg/example.oldstyle b/src/interfaces/perl5/eg/example.oldstyle deleted file mode 100644 index 95ed3afd970..00000000000 --- a/src/interfaces/perl5/eg/example.oldstyle +++ /dev/null @@ -1,294 +0,0 @@ -#!/usr/local/bin/perl - -# $Id: example.oldstyle,v 1.6 1998/09/27 19:12:35 mergl Exp $ - -######################### globals - -$| = 1; -use Pg; - -$dbmain = 'template1'; -$dbname = 'pgperltest'; -$trace = '/tmp/pgtrace.out'; -$DEBUG = 0; # set this to 1 for traces - -######################### the following functions will be tested - -# PQsetdb() -# PQdb() -# PQuser() -# PQport() -# PQstatus() -# PQfinish() -# PQerrorMessage() -# PQtrace() -# PQuntrace() -# PQexec() -# PQconsumeInput -# PQgetline() -# PQputline() -# PQendcopy() -# 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() -# PQsetdbLogin() -# PQreset() -# PQrequestCancel() -# PQpass() -# PQhost() -# PQtty() -# PQoptions() -# PQsocket() -# PQbackendPID() -# PQsendQuery() -# PQgetResult() -# PQisBusy() -# PQgetlineAsync() -# PQputnbytes() -# PQmakeEmptyPGresult() -# PQfmod() -# 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 - -$conn = PQsetdb('', '', '', '', $dbmain); -die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn); -print "connected to $dbmain\n"; - -# do not complain when dropping $dbname -$result = PQexec($conn, "DROP DATABASE $dbname"); -PQclear($result); - -$result = PQexec($conn, "CREATE DATABASE $dbname"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -print "created database $dbname\n"; -PQclear($result); - -PQfinish($conn); - -$conn = PQsetdb('', '', '', '', $dbname); -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 - -$db = PQdb($conn); -print " database: $db\n"; - -$user = PQuser($conn); -print " user: $user\n"; - -$port = PQport($conn); -print " port: $port\n"; - -######################### create and insert into table - -$result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))"); -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')"); - 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 - -$result = PQexec($conn, "COPY person TO STDOUT"); -die PQerrorMessage($conn) unless PGRES_COPY_OUT eq PQresultStatus($result); -print "copy table to STDOUT:\n"; -PQclear($result); - -$ret = 0; -$i = 1; -while (-1 != $ret) { - $ret = PQgetline($conn, $string, 256); - last if $string eq "\\."; - print " ", $string, "\n"; - $i++; -} - -die PQerrorMessage($conn) unless 0 == PQendcopy($conn); - -######################### delete and copy from stdin, PQputline - -$result = PQexec($conn, "BEGIN"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -PQclear($result); - -$result = PQexec($conn, "DELETE FROM person"); -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"); -die PQerrorMessage($conn) unless PGRES_COPY_IN eq PQresultStatus($result); -print "copy table from STDIN:\n"; -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"); - -die PQerrorMessage($conn) unless 0 == PQendcopy($conn); - -$result = PQexec($conn, "END"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -PQclear($result); - -######################### select from person, PQgetvalue - -$result = PQexec($conn, "SELECT * FROM person"); -die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result); -print "select from table:\n"; - -for ($k = 0; $k < PQnfields($result); $k++) { - 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++) { - for ($l = 0; $l < PQnfields($result); $l++) { - print " ", PQgetvalue($result, $k, $l); - } - print "\n"; -} - -PQclear($result); - -######################### PQnotifies - -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"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -print "listen table: status = ", PQcmdStatus($result), "\n"; -PQclear($result); - -while (1) { - PQconsumeInput($conn); - ($table, $pid) = PQnotifies($conn); - last if $pid; -} -print "got notification: table = ", $table, " pid = ", $pid, "\n"; - -######################### PQprint - -$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); - -######################### PQlo_import, PQlo_export, PQlo_unlink - -$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"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -PQclear($result); - -$lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn); -print "importing file as large object, Oid = ", $lobjOid, "\n"; - -die PQerrorMessage($conn) unless 1 == PQlo_export($conn, $lobjOid, "$lobject_out"); -print "exporting large object as temporary file\n"; - -$result = PQexec($conn, "END"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -PQclear($result); - -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 - -PQfinish($conn); - -$conn = PQsetdb('', '', '', '', $dbmain); -die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn); -print "connected to $dbmain\n"; - -$result = PQexec($conn, "DROP DATABASE $dbname"); -die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); -print "drop database\n"; -PQclear($result); - -PQfinish($conn); - -######################### EOF diff --git a/src/interfaces/perl5/examples/ApachePg.pl b/src/interfaces/perl5/examples/ApachePg.pl new file mode 100644 index 00000000000..9bbfad7ad0d --- /dev/null +++ b/src/interfaces/perl5/examples/ApachePg.pl @@ -0,0 +1,55 @@ +#!/usr/local/bin/perl + +# $Id: ApachePg.pl,v 1.1 2000/06/01 03:05:24 momjian Exp $ + +# demo script, tested with: +# - PostgreSQL-6.4 +# - apache_1.3.1 +# - mod_perl-1.15 +# - perl5.005_02 + +use CGI; +use Pg; +use strict; + +my $query = new CGI; + +print $query->header, + $query->start_html(-title=>'A Simple Example'), + $query->startform, + "

Testing Module Pg

", + "

", + "", + "", + "", + "", + "", + "", + "
Enter conninfo string: ", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "
Enter select command: ", $query->textfield(-name=>'cmd', -size=>40), "

", + "

", $query->submit(-value=>'Submit'), "
", + $query->endform; + +if ($query->param) { + + my $conninfo = $query->param('conninfo'); + my $conn = Pg::connectdb($conninfo); + if (PGRES_CONNECTION_OK == $conn->status) { + my $cmd = $query->param('cmd'); + my $result = $conn->exec($cmd); + if (PGRES_TUPLES_OK == $result->resultStatus) { + print "

\n"; + my @row; + while (@row = $result->fetchrow) { + print ""; + } + print "
", join("", @row), "

\n"; + } else { + print "

", $conn->errorMessage, "

\n"; + } + } else { + print "

", $conn->errorMessage, "

\n"; + } +} + +print $query->end_html; + diff --git a/src/interfaces/perl5/examples/example.newstyle b/src/interfaces/perl5/examples/example.newstyle new file mode 100644 index 00000000000..30538400333 --- /dev/null +++ b/src/interfaces/perl5/examples/example.newstyle @@ -0,0 +1,274 @@ +#!/usr/local/bin/perl + +# $Id: example.newstyle,v 1.1 2000/06/01 03:05:24 momjian Exp $ + +######################### globals + +$| = 1; +use Pg; + +$dbmain = 'template1'; +$dbname = 'pgperltest'; +$trace = '/tmp/pgtrace.out'; +$DEBUG = 0; # set this to 1 for traces + +######################### the following methods will be used + +# connectdb +# conndefaults +# db +# user +# port +# status +# errorMessage +# trace +# untrace +# exec +# consumeInput +# getline +# putline +# endcopy +# 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 used + +# setdb +# setdbLogin +# reset +# requestCancel +# pass +# host +# tty +# options +# socket +# backendPID +# sendQuery +# getResult +# isBusy +# getlineAsync +# putnbytes +# makeEmptyPGresult +# fmod +# 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 + +$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"); +die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; +print "connected to $dbmain\n"; + +# do not complain when dropping $dbname +$conn->exec("DROP DATABASE $dbname"); + +$result = $conn->exec("CREATE DATABASE $dbname"); +die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; +print "created database $dbname\n"; + +$conn = Pg::connectdb("dbname=$dbname"); +die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; +print "connected to $dbname\n"; + +######################### debug, trace + +if ($DEBUG) { + open(TRACE, ">$trace") || die "can not open $trace: $!"; + $conn->trace(TRACE); + print "enabled tracing into $trace\n"; +} + +######################### check PGconn + +$db = $conn->db; +print " database: $db\n"; + +$user = $conn->user; +print " user: $user\n"; + +$port = $conn->port; +print " port: $port\n"; + +######################### create and insert into table + +$result = $conn->exec("CREATE TABLE person (id int4, name char(16))"); +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')"); + die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; +} +print "insert into table, last oid = ", $result->oidStatus, "\n"; + +######################### copy to stdout, getline + +$result = $conn->exec("COPY person TO STDOUT"); +die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus; +print "copy table to STDOUT:\n"; + +$ret = 0; +$i = 1; +while (-1 != $ret) { + $ret = $conn->getline($string, 256); + last if $string eq "\\."; + print " ", $string, "\n"; + $i ++; +} + +die $conn->errorMessage unless 0 == $conn->endcopy; + +######################### delete and copy from stdin, putline + +$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; +print "delete from table, command status = ", $result->cmdStatus, ", no. of tuples = ", $result->cmdTuples, "\n"; + +$result = $conn->exec("COPY person FROM STDIN"); +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("$i Edmund Mergl\n"); +} +$conn->putline("\\.\n"); + +die $conn->errorMessage unless 0 == $conn->endcopy; + +$result = $conn->exec("END"); +die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; +print "ok\n"; + +######################### select from person, getvalue + +$result = $conn->exec("SELECT * FROM person"); +die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus; +print "select from table:\n"; + +for ($k = 0; $k < $result->nfields; $k++) { + print " field = ", $k, "\tfname = ", $result->fname($k), "\tftype = ", $result->ftype($k), "\tfsize = ", $result->fsize($k), "\tfnumber = ", $result->fnumber($result->fname($k)), "\n"; +} + +while (@row = $result->fetchrow) { + print " ", join(" ", @row), "\n"; +} + +######################### notifies + +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"); +die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; +print "listen table: status = ", $result->cmdStatus, "\n"; + +while (1) { + $conn->consumeInput; + ($table, $pid) = $conn->notifies; + last if $pid; +} +print "got notification: table = ", $table, " pid = ", $pid, "\n"; + +######################### print + +$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, " ", "", "", ""); + +######################### lo_import, lo_export, lo_unlink + +$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 = $conn->exec("BEGIN"); +die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; + +$lobjOid = $conn->lo_import("$lobject_in") or die $conn->errorMessage; +print "importing file as large object, Oid = ", $lobjOid, "\n"; + +die $conn->errorMessage unless 1 == $conn->lo_export($lobjOid, "$lobject_out"); +print "exporting large object as temporary file\n"; + +$result = $conn->exec("END"); +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"; + +die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid); +unlink $lobject_in; +unlink $lobject_out; +print "unlink large object\n"; + +######################### debug, untrace + +if ($DEBUG) { + close(TRACE) || die "bad TRACE: $!"; + $conn->untrace; + print "tracing disabled\n"; +} + +######################### disconnect and drop test database + +$conn = Pg::connectdb("dbname=$dbmain"); +die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; +print "connected to $dbmain\n"; + +$result = $conn->exec("DROP DATABASE $dbname"); +die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; +print "drop database\n"; + +######################### EOF diff --git a/src/interfaces/perl5/examples/example.oldstyle b/src/interfaces/perl5/examples/example.oldstyle new file mode 100644 index 00000000000..5c63ef8d657 --- /dev/null +++ b/src/interfaces/perl5/examples/example.oldstyle @@ -0,0 +1,294 @@ +#!/usr/local/bin/perl + +# $Id: example.oldstyle,v 1.1 2000/06/01 03:05:24 momjian Exp $ + +######################### globals + +$| = 1; +use Pg; + +$dbmain = 'template1'; +$dbname = 'pgperltest'; +$trace = '/tmp/pgtrace.out'; +$DEBUG = 0; # set this to 1 for traces + +######################### the following functions will be tested + +# PQsetdb() +# PQdb() +# PQuser() +# PQport() +# PQstatus() +# PQfinish() +# PQerrorMessage() +# PQtrace() +# PQuntrace() +# PQexec() +# PQconsumeInput +# PQgetline() +# PQputline() +# PQendcopy() +# 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() +# PQsetdbLogin() +# PQreset() +# PQrequestCancel() +# PQpass() +# PQhost() +# PQtty() +# PQoptions() +# PQsocket() +# PQbackendPID() +# PQsendQuery() +# PQgetResult() +# PQisBusy() +# PQgetlineAsync() +# PQputnbytes() +# PQmakeEmptyPGresult() +# PQfmod() +# 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 + +$conn = PQsetdb('', '', '', '', $dbmain); +die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn); +print "connected to $dbmain\n"; + +# do not complain when dropping $dbname +$result = PQexec($conn, "DROP DATABASE $dbname"); +PQclear($result); + +$result = PQexec($conn, "CREATE DATABASE $dbname"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +print "created database $dbname\n"; +PQclear($result); + +PQfinish($conn); + +$conn = PQsetdb('', '', '', '', $dbname); +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 + +$db = PQdb($conn); +print " database: $db\n"; + +$user = PQuser($conn); +print " user: $user\n"; + +$port = PQport($conn); +print " port: $port\n"; + +######################### create and insert into table + +$result = PQexec($conn, "CREATE TABLE person (id int4, name char(16))"); +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')"); + 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 + +$result = PQexec($conn, "COPY person TO STDOUT"); +die PQerrorMessage($conn) unless PGRES_COPY_OUT eq PQresultStatus($result); +print "copy table to STDOUT:\n"; +PQclear($result); + +$ret = 0; +$i = 1; +while (-1 != $ret) { + $ret = PQgetline($conn, $string, 256); + last if $string eq "\\."; + print " ", $string, "\n"; + $i++; +} + +die PQerrorMessage($conn) unless 0 == PQendcopy($conn); + +######################### delete and copy from stdin, PQputline + +$result = PQexec($conn, "BEGIN"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +PQclear($result); + +$result = PQexec($conn, "DELETE FROM person"); +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"); +die PQerrorMessage($conn) unless PGRES_COPY_IN eq PQresultStatus($result); +print "copy table from STDIN:\n"; +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"); + +die PQerrorMessage($conn) unless 0 == PQendcopy($conn); + +$result = PQexec($conn, "END"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +PQclear($result); + +######################### select from person, PQgetvalue + +$result = PQexec($conn, "SELECT * FROM person"); +die PQerrorMessage($conn) unless PGRES_TUPLES_OK eq PQresultStatus($result); +print "select from table:\n"; + +for ($k = 0; $k < PQnfields($result); $k++) { + 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++) { + for ($l = 0; $l < PQnfields($result); $l++) { + print " ", PQgetvalue($result, $k, $l); + } + print "\n"; +} + +PQclear($result); + +######################### PQnotifies + +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"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +print "listen table: status = ", PQcmdStatus($result), "\n"; +PQclear($result); + +while (1) { + PQconsumeInput($conn); + ($table, $pid) = PQnotifies($conn); + last if $pid; +} +print "got notification: table = ", $table, " pid = ", $pid, "\n"; + +######################### PQprint + +$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); + +######################### PQlo_import, PQlo_export, PQlo_unlink + +$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"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +PQclear($result); + +$lobjOid = PQlo_import($conn, "$lobject_in") or die PQerrorMessage($conn); +print "importing file as large object, Oid = ", $lobjOid, "\n"; + +die PQerrorMessage($conn) unless 1 == PQlo_export($conn, $lobjOid, "$lobject_out"); +print "exporting large object as temporary file\n"; + +$result = PQexec($conn, "END"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +PQclear($result); + +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 + +PQfinish($conn); + +$conn = PQsetdb('', '', '', '', $dbmain); +die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn); +print "connected to $dbmain\n"; + +$result = PQexec($conn, "DROP DATABASE $dbname"); +die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result); +print "drop database\n"; +PQclear($result); + +PQfinish($conn); + +######################### EOF -- cgit v1.2.3