数据库系统

开发平台：
Unix_Linux

example.newstyle：源码内容
							#!/usr/local/bin/perl
# $Id: example.newstyle,v 1.6 1998/09/27 19:12:34 mergl 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 pipen" };
######################### 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 $dbmainn";
# 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 $dbnamen";
$conn = Pg::connectdb("dbname=$dbname");
die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
print "connected to $dbnamen";
######################### debug, trace
if ($DEBUG) {
    open(TRACE, ">$trace") || die "can not open $trace: $!";
    $conn->trace(TRACE);
    print "enabled tracing into $tracen";
}
######################### check PGconn
$db = $conn->db;
print "  database: $dbn";
$user = $conn->user;
print "  user:     $usern";
$port = $conn->port;
print "  port:     $portn";
######################### 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 Mergln");
}
$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 "okn";
######################### 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 filen";
$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 "okn";
die $conn->errorMessage if -1 == $conn->lo_unlink($lobjOid);
unlink $lobject_in;
unlink $lobject_out;
print "unlink large objectn";
######################### debug, untrace
if ($DEBUG) {
    close(TRACE) || die "bad TRACE: $!";
    $conn->untrace;
    print "tracing disabledn";
}
######################### disconnect and drop test database
$conn = Pg::connectdb("dbname=$dbmain");
die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status;
print "connected to $dbmainn";
$result = $conn->exec("DROP DATABASE $dbname");
die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus;
print "drop databasen";
######################### EOF

						