数据库系统

开发平台：
Unix_Linux

example.oldstyle：源码内容
							#!/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 pipen" };
######################### create and connect to test database
$conn = PQsetdb('', '', '', '', $dbmain);
die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbmainn";
# 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 $dbnamen";
PQclear($result);
PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbname);
die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbnamen";
######################### debug, PQtrace
if ($DEBUG) {
    open(TRACE, ">$trace") || die "can not open $trace: $!";
    PQtrace($conn, TRACE);
    print "enabled tracing into $tracen";
}
######################### check PGconn
$db = PQdb($conn);
print "  database: $dbn";
$user = PQuser($conn);
print "  user:     $usern";
$port = PQport($conn);
print "  port:     $portn";
######################### 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 Mergln");
}
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 filen";
$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 "okn";
die PQerrorMessage($conn) if -1 == PQlo_unlink($conn, $lobjOid);
unlink $lobject_in;
unlink $lobject_out;
print "unlink large objectn";
######################### debug, PQuntrace
if ($DEBUG) {
    close(TRACE) || die "bad TRACE: $!";
    PQuntrace($conn);
    print "tracing disabledn";
}
######################### disconnect and drop test database
PQfinish($conn);
$conn = PQsetdb('', '', '', '', $dbmain);
die PQerrorMessage($conn) unless PGRES_CONNECTION_OK eq PQstatus($conn);
print "connected to $dbmainn";
$result = PQexec($conn, "DROP DATABASE $dbname");
die PQerrorMessage($conn) unless PGRES_COMMAND_OK eq PQresultStatus($result);
print "drop databasen";
PQclear($result);
PQfinish($conn);
######################### EOF

						