example.oldstyle

关系型数据库 Postgresql 6.5.2

#!/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