From 364efd10292f3d6a007744012fb583d1b310538e Mon Sep 17 00:00:00 2001
From: Edmund Mergl <E.Mergl@bawue.de>
Date: Wed, 17 Sep 1997 20:48:15 +0000
Subject: [PATCH] adapted to pgsql-v6.2
---
src/interfaces/perl5/eg/ApachePg.pl | 37 +++
src/interfaces/perl5/eg/example.newstyle | 324 +++++++++++++++++++++
src/interfaces/perl5/eg/example.oldstyle | 348 +++++++++++++++++++++++
3 files changed, 709 insertions(+)
create mode 100644 src/interfaces/perl5/eg/ApachePg.pl
create mode 100644 src/interfaces/perl5/eg/example.newstyle
create mode 100644 src/interfaces/perl5/eg/example.oldstyle
diff --git a/src/interfaces/perl5/eg/ApachePg.pl b/src/interfaces/perl5/eg/ApachePg.pl
new file mode 100644
index 00000000000..39e609cf7c8
--- /dev/null
+++ b/src/interfaces/perl5/eg/ApachePg.pl
@@ -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;
+
diff --git a/src/interfaces/perl5/eg/example.newstyle b/src/interfaces/perl5/eg/example.newstyle
new file mode 100644
index 00000000000..a64f144739e
--- /dev/null
+++ b/src/interfaces/perl5/eg/example.newstyle
@@ -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
diff --git a/src/interfaces/perl5/eg/example.oldstyle b/src/interfaces/perl5/eg/example.oldstyle
new file mode 100644
index 00000000000..d6c84e04343
--- /dev/null
+++ b/src/interfaces/perl5/eg/example.oldstyle
@@ -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
--
GitLab