mirror of
https://github.com/postgres/postgres.git
synced 2025-08-11 04:22:52 +03:00
Rename perl example eg directory to examples.
This commit is contained in:
Bruce Momjian
274
src/interfaces/perl5/examples/example.newstyle
Normal file
274
src/interfaces/perl5/examples/example.newstyle
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user