mirror of
https://github.com/postgres/postgres.git
synced 2025-08-09 17:03:00 +03:00
275 lines
6.8 KiB
Perl
275 lines
6.8 KiB
Perl
#!/usr/bin/perl
|
|
|
|
# $Id: example.newstyle,v 1.2 2001/09/04 11:41:04 petere 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
|