Pg-2.1.1/040755 000213 000000 00000000000 10041531200 005517 Pg-2.1.1/typemap100644 000213 000000 00000000575 06603507033 007152 #------------------------------------------------------- # # $Id: typemap,v 1.8 1998/09/27 19:12:27 mergl Exp $ # # Copyright (c) 1997, 1998 Edmund Mergl # #------------------------------------------------------- TYPEMAP PGconn * T_PTRREF PGresult * T_PTRREF PG_conn T_PTROBJ PG_result T_PTROBJ PG_results T_PTROBJ ConnStatusType T_IV ExecStatusType T_IV Oid T_IV pqbool T_IV Pg-2.1.1/Pg.xs100644 000213 000000 00000026277 10041114022 006460 /*------------------------------------------------------- * * $Id: Pg.xs,v 1.18 2004/04/20 03:25:06 bmomjian Exp $ with patch for NULs * * Copyright (c) 1997, 1998 Edmund Mergl * *-------------------------------------------------------*/ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include #include #include #include "libpq-fe.h" typedef struct pg_conn *PG_conn; typedef struct pg_results { PGresult *result; int row; } PGresults; typedef struct pg_results *PG_results; static double constant(name, arg) char *name; int arg; { errno = 0; switch (*name) { case 'P': if (strEQ(name, "PGRES_CONNECTION_OK")) return 0; if (strEQ(name, "PGRES_CONNECTION_BAD")) return 1; if (strEQ(name, "PGRES_INV_SMGRMASK")) return 0x0000ffff; if (strEQ(name, "PGRES_INV_WRITE")) return 0x00020000; if (strEQ(name, "PGRES_INV_READ")) return 0x00040000; if (strEQ(name, "PGRES_InvalidOid")) return 0; if (strEQ(name, "PGRES_EMPTY_QUERY")) return 0; if (strEQ(name, "PGRES_COMMAND_OK")) return 1; if (strEQ(name, "PGRES_TUPLES_OK")) return 2; if (strEQ(name, "PGRES_COPY_OUT")) return 3; if (strEQ(name, "PGRES_COPY_IN")) return 4; if (strEQ(name, "PGRES_BAD_RESPONSE")) return 5; if (strEQ(name, "PGRES_NONFATAL_ERROR")) return 6; if (strEQ(name, "PGRES_FATAL_ERROR")) return 7; break; default: break; } errno = EINVAL; return 0; not_there: errno = ENOENT; return 0; } MODULE = Pg PACKAGE = Pg PROTOTYPES: DISABLE double constant(name,arg) char * name int arg PG_conn connectdb(conninfo) char * conninfo CODE: /* convert dbname to lower case if not surrounded by double quotes */ char *ptr = strstr(conninfo, "dbname"); if (ptr) { ptr += 6; while (*ptr && *ptr != '=') { ptr++; } while (*ptr && (*ptr == ' ' || *ptr == '\t')) { ptr++; } if (*ptr == '"') { *ptr++ = ' '; while (*ptr && *ptr != '"') { ptr++; } if (*ptr == '"') { *ptr++ = ' '; } } else { while (*ptr && *ptr != ' ' && *ptr != '\t') { *ptr = tolower(*ptr); ptr++; } } } RETVAL = PQconnectdb((const char *)conninfo); OUTPUT: RETVAL PG_conn setdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd) char * pghost char * pgport char * pgoptions char * pgtty char * dbname char * login char * pwd CODE: RETVAL = PQsetdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd); OUTPUT: RETVAL PG_conn setdb(pghost, pgport, pgoptions, pgtty, dbname) char * pghost char * pgport char * pgoptions char * pgtty char * dbname CODE: RETVAL = PQsetdb(pghost, pgport, pgoptions, pgtty, dbname); OUTPUT: RETVAL HV * conndefaults() CODE: PQconninfoOption *infoOptions; RETVAL = newHV(); if (infoOptions = PQconndefaults()) { PQconninfoOption *option; for (option = infoOptions; option->keyword != NULL; option++) { if (option->val != NULL) { hv_store(RETVAL, option->keyword, strlen(option->keyword), newSVpv(option->val, 0), 0); } else { hv_store(RETVAL, option->keyword, strlen(option->keyword), newSVpv("", 0), 0); } } PQconninfoFree(infoOptions); } OUTPUT: RETVAL char * resStatus(status) ExecStatusType status CODE: RETVAL = (char *)PQresStatus(status); OUTPUT: RETVAL MODULE = Pg PACKAGE = PG_conn PREFIX = PQ PROTOTYPES: DISABLE void DESTROY(conn) PG_conn conn CODE: PQfinish(conn); void PQreset(conn) PG_conn conn int PQrequestCancel(conn) PG_conn conn char * PQdb(conn) PG_conn conn char * PQuser(conn) PG_conn conn char * PQpass(conn) PG_conn conn char * PQhost(conn) PG_conn conn char * PQport(conn) PG_conn conn char * PQtty(conn) PG_conn conn char * PQoptions(conn) PG_conn conn ConnStatusType PQstatus(conn) PG_conn conn char * PQerrorMessage(conn) PG_conn conn int PQsocket(conn) PG_conn conn int PQbackendPID(conn) PG_conn conn void PQtrace(conn, debug_port) PG_conn conn FILE * debug_port void PQuntrace(conn) PG_conn conn void PQsetNoticeProcessor(conn, proc, arg) PG_conn conn void * proc void * arg PG_results PQexec(conn, query) PG_conn conn char * query CODE: RETVAL = (PG_results)safecalloc(1, sizeof(PGresults)); if (RETVAL) { RETVAL->result = PQexec((PGconn *)conn, query); if (!RETVAL->result) { RETVAL->result = PQmakeEmptyPGresult((PGconn *)conn, PGRES_FATAL_ERROR); } } OUTPUT: RETVAL void PQnotifies(conn) PG_conn conn PREINIT: PGnotify *notify; PPCODE: notify = PQnotifies(conn); if (notify) { XPUSHs(sv_2mortal(newSVpv((char *)notify->relname, 0))); XPUSHs(sv_2mortal(newSViv(notify->be_pid))); PQfreeNotify(notify); } int PQsendQuery(conn, query) PG_conn conn char * query PG_results PQgetResult(conn) PG_conn conn CODE: RETVAL = (PG_results)safecalloc(1, sizeof(PGresults)); if (RETVAL) { RETVAL->result = PQgetResult((PGconn *)conn); if (!RETVAL->result) { RETVAL->result = PQmakeEmptyPGresult((PGconn *)conn, PGRES_FATAL_ERROR); } } OUTPUT: RETVAL int PQisBusy(conn) PG_conn conn int PQconsumeInput(conn) PG_conn conn int PQgetline(conn, string, length) PREINIT: SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); INPUT: PG_conn conn int length char * string = sv_grow(bufsv, length); CODE: RETVAL = PQgetline(conn, string, length); OUTPUT: RETVAL string int PQputline(conn, string) PG_conn conn char * string int PQgetlineAsync(conn, buffer, bufsize) PREINIT: SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); INPUT: PG_conn conn int bufsize char * buffer = sv_grow(bufsv, bufsize); CODE: RETVAL = PQgetline(conn, buffer, bufsize); OUTPUT: RETVAL buffer int PQputnbytes(conn, buffer, nbytes) PG_conn conn char * buffer int nbytes int PQendcopy(conn) PG_conn conn PG_results PQmakeEmptyPGresult(conn, status) PG_conn conn ExecStatusType status CODE: RETVAL = (PG_results)safecalloc(1, sizeof(PGresults)); if (RETVAL) { RETVAL->result = PQmakeEmptyPGresult((PGconn *)conn, status); } OUTPUT: RETVAL int lo_open(conn, lobjId, mode) PG_conn conn Oid lobjId int mode int lo_close(conn, fd) PG_conn conn int fd void lo_read(conn, fd, buf, len) PG_conn conn int fd char * buf int len PREINIT: SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); int ret; CODE: buf = SvGROW(bufsv, len + 1); ret = lo_read(conn, fd, buf, len); if (ret > 0) { SvCUR_set(bufsv, ret); *SvEND(bufsv) = '\0'; sv_setpvn(ST(2), buf, ret); SvSETMAGIC(ST(2)); } ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &PL_sv_undef; int lo_write(conn, fd, buf, len) PG_conn conn int fd char * buf int len int lo_lseek(conn, fd, offset, whence) PG_conn conn int fd int offset int whence Oid lo_creat(conn, mode) PG_conn conn int mode int lo_tell(conn, fd) PG_conn conn int fd int lo_unlink(conn, lobjId) PG_conn conn Oid lobjId Oid lo_import(conn, filename) PG_conn conn char * filename int lo_export(conn, lobjId, filename) PG_conn conn Oid lobjId char * filename MODULE = Pg PACKAGE = PG_results PREFIX = PQ PROTOTYPES: DISABLE void DESTROY(res) PG_results res CODE: /* printf("DESTROY result\n"); fflush(stdout); */ PQclear(res->result); Safefree(res); ExecStatusType PQresultStatus(res) PG_results res CODE: RETVAL = PQresultStatus(res->result); OUTPUT: RETVAL char * PQresultErrorMessage(res) PG_results res CODE: RETVAL = (char *)PQresultErrorMessage(res->result); OUTPUT: RETVAL int PQntuples(res) PG_results res CODE: RETVAL = PQntuples(res->result); OUTPUT: RETVAL int PQnfields(res) PG_results res CODE: RETVAL = PQnfields(res->result); OUTPUT: RETVAL int PQbinaryTuples(res) PG_results res CODE: RETVAL = PQbinaryTuples(res->result); OUTPUT: RETVAL char * PQfname(res, field_num) PG_results res int field_num CODE: RETVAL = PQfname(res->result, field_num); OUTPUT: RETVAL int PQfnumber(res, field_name) PG_results res char * field_name CODE: RETVAL = PQfnumber(res->result, field_name); OUTPUT: RETVAL Oid PQftype(res, field_num) PG_results res int field_num CODE: RETVAL = PQftype(res->result, field_num); OUTPUT: RETVAL short PQfsize(res, field_num) PG_results res int field_num CODE: RETVAL = PQfsize(res->result, field_num); OUTPUT: RETVAL int PQfmod(res, field_num) PG_results res int field_num CODE: RETVAL = PQfmod(res->result, field_num); OUTPUT: RETVAL char * PQcmdStatus(res) PG_results res CODE: RETVAL = PQcmdStatus(res->result); OUTPUT: RETVAL char * PQoidStatus(res) PG_results res CODE: RETVAL = (char *)PQoidStatus(res->result); OUTPUT: RETVAL char * PQcmdTuples(res) PG_results res CODE: RETVAL = (char *)PQcmdTuples(res->result); OUTPUT: RETVAL char * PQgetvalue(res, tup_num, field_num) PG_results res int tup_num int field_num CODE: RETVAL = PQgetvalue(res->result, tup_num, field_num); OUTPUT: RETVAL int PQgetlength(res, tup_num, field_num) PG_results res int tup_num int field_num CODE: RETVAL = PQgetlength(res->result, tup_num, field_num); OUTPUT: RETVAL int PQgetisnull(res, tup_num, field_num) PG_results res int tup_num int field_num CODE: RETVAL = PQgetisnull(res->result, tup_num, field_num); OUTPUT: RETVAL void PQfetchrow(res) PG_results res PPCODE: if (res && res->result) { int cols = PQnfields(res->result); if (PQntuples(res->result) > res->row) { int col = 0; EXTEND(sp, cols); while (col < cols) { if (PQgetisnull(res->result, res->row, col)) { PUSHs(&PL_sv_undef); } else { char *val = PQgetvalue(res->result, res->row, col); PUSHs(sv_2mortal((SV*)newSVpv(val, 0))); } ++col; } ++res->row; } } void PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...) FILE * fout PG_results res pqbool header pqbool align pqbool standard pqbool html3 pqbool expanded pqbool pager char * fieldSep char * tableOpt char * caption PREINIT: PQprintOpt ps; int i; CODE: ps.header = header; ps.align = align; ps.standard = standard; ps.html3 = html3; ps.expanded = expanded; ps.pager = pager; ps.fieldSep = fieldSep; ps.tableOpt = tableOpt; ps.caption = caption; Newz(0, ps.fieldName, items + 1 - 11, char*); for (i = 11; i < items; i++) { ps.fieldName[i - 11] = (char *)SvPV(ST(i), PL_na); } PQprint(fout, res->result, &ps); Safefree(ps.fieldName); void PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet) PG_results res FILE * fp int fillAlign char * fieldSep int printHeader int quiet CODE: PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet); void PQprintTuples(res, fout, printAttName, terseOutput, width) PG_results res FILE * fout int printAttName int terseOutput int width CODE: PQprintTuples(res->result, fout, printAttName, terseOutput, width); Pg-2.1.1/examples/040755 000213 000000 00000000000 10041531200 007335 Pg-2.1.1/examples/ApachePg.pl100644 000213 000000 00000003360 10041114023 011346 #!/usr/bin/perl # $Id: ApachePg.pl,v 1.3 2004/04/20 03:25:07 bmomjian Exp $ # don't forget to create in postgres the user who is running # the httpd, eg 'createuser nobody' ! # # demo script, tested with: # - postgresql-7.0 # - apache_1.3.12 # - mod_perl-1.22 # - perl5.6.0 use CGI; use Pg; use strict; my $query = new CGI; print $query->header, $query->start_html(-title=>'A Simple Example'), $query->startform, "

Testing Module Pg

", "

", "", "", "", "", "", "", "
Enter conninfo string: ", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "
Enter select command: ", $query->textfield(-name=>'cmd', -size=>40), "

", "

", $query->submit(-value=>'Submit'), "
", $query->endform; if ($query->param) { my $conninfo = $query->param('conninfo'); my $conn = Pg::connectdb($conninfo); if (PGRES_CONNECTION_OK == $conn->status) { my $cmd = $query->param('cmd'); my $result = $conn->exec($cmd); if (PGRES_TUPLES_OK == $result->resultStatus) { print "

\n"; my @row; while (@row = $result->fetchrow) { print ""; } print "
", join("", @row), "

\n"; } else { print "

", $conn->errorMessage, "

\n"; } } else { print "

", $conn->errorMessage, "

\n"; } } print $query->end_html; Pg-2.1.1/examples/example.newstyle100644 000213 000000 00000015515 07345136720 012622 #!/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 Pg-2.1.1/examples/example.oldstyle100644 000213 000000 00000017023 07345136720 012603 #!/usr/bin/perl # $Id: example.oldstyle,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 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 Pg-2.1.1/Pg.pm100644 000213 000000 00000037243 10041114022 006435 #------------------------------------------------------- # # $Id: Pg.pm,v 1.15 2004/04/20 03:25:06 bmomjian Exp $ # # Copyright (c) 1997, 1998 Edmund Mergl # #------------------------------------------------------- package Pg; use strict; use Carp; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); require Exporter; require DynaLoader; require AutoLoader; require 5.005; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. @EXPORT = qw( PGRES_CONNECTION_OK PGRES_CONNECTION_BAD PGRES_EMPTY_QUERY PGRES_COMMAND_OK PGRES_TUPLES_OK PGRES_COPY_OUT PGRES_COPY_IN PGRES_BAD_RESPONSE PGRES_NONFATAL_ERROR PGRES_FATAL_ERROR PGRES_INV_SMGRMASK PGRES_INV_WRITE PGRES_INV_READ PGRES_InvalidOid ); $Pg::VERSION = '2.1.1'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. If a constant is not found then control is passed # to the AUTOLOAD in AutoLoader. my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined Pg macro $constname"; } } eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } bootstrap Pg $VERSION; sub doQuery { my $conn = shift; my $query = shift; my $array_ref = shift; my ($result, $status, $i, $j); $$array_ref[0][0] = ''; if ($result = $conn->exec($query)) { if (2 == ($status = $result->resultStatus)) { for $i (0..$result->ntuples - 1) { for $j (0..$result->nfields - 1) { $$array_ref[$i][$j] = $result->getvalue($i, $j); } } } } return $status; } 1; __END__ =head1 NAME Pg - Perl5 extension for PostgreSQL =head1 SYNOPSIS use Pg; $conn = Pg::connectdb("dbname=template1"); $res = $conn->exec("SELECT * from pg_user"); while (@row = $res->fetchrow) { print = join(" ", @row); } =head1 DESCRIPTION The Pg module permits you to access all functions of the Libpq interface of PostgreSQL. Libpq is the programmer's interface to PostgreSQL. For examples of how to use this module, look at the file test.pl. =head1 GUIDELINES This perl interface uses blessed references as objects. After creating a new connection or result object, the relevant Libpq functions serve as virtual methods. You do not have to care about freeing the connection- and result-structures. Perl calls the destructor whenever the last reference to an object goes away. The method fetchrow can be used to fetch the next row from the server: while (@row = $result->fetchrow). Columns which have NULL as value will be set to C. Pg.pm contains one convenience function: doQuery. It fills a two-dimensional array with the result of your query. Usage: Pg::doQuery($conn, "select attr1, attr2 from tbl", \@ary); for $i ( 0 .. $#ary ) { for $j ( 0 .. $#{$ary[$i]} ) { print "$ary[$i][$j]\t"; } print "\n"; } Notice the inner loop ! =head1 FUNCTIONS The functions have been divided into three sections: Connection, Result, Large Objects. For details please read L. =head2 1. Connection With these functions you can establish and close a connection to a database. In Libpq a connection is represented by a structure called PGconn. When opening a connection a given database name is always converted to lower-case, unless it is surrounded by double quotes. All unspecified parameters are replaced by environment variables or by hard coded defaults: parameter environment variable hard coded default ------------------------------------------------------ host PGHOST localhost port PGPORT 5432 options PGOPTIONS "" tty PGTTY "" dbname PGDATABASE current userid user PGUSER current userid password PGPASSWORD "" passwordfile PGPASSWORDFILE "" Using appropriate methods you can access almost all fields of the returned PGconn structure. $conn = Pg::setdbLogin($pghost, $pgport, $pgoptions, $pgtty, $dbname, $login, $pwd) Opens a new connection to the backend. The connection identifier $conn ( a pointer to the PGconn structure ) must be used in subsequent commands for unique identification. Before using $conn you should call $conn->status to ensure, that the connection was properly made. Closing a connection is done by deleting the connection handle, eg 'undef $conn;'. $conn = Pg::setdb($pghost, $pgport, $pgoptions, $pgtty, $dbname) The method setdb should be used when username/password authentication is not needed. $conn = Pg::connectdb("option1=value option2=value ...") Opens a new connection to the backend using connection information in a string. Possible options are: host, port, options, tty, dbname, user, password. The connection identifier $conn (a pointer to the PGconn structure) must be used in subsequent commands for unique identification. Before using $conn you should call $conn->status to ensure, that the connection was properly made. $Option_ref = Pg::conndefaults() while(($key, $val) = each %$Option_ref) { print "$key, $val\n"; Returns a reference to a hash containing as keys all possible options for connectdb(). The values are the current defaults. This function differs from his C-counterpart, which returns the complete conninfoOption structure. $conn->reset Resets the communication port with the backend and tries to establish a new connection. $ret = $conn->requestCancel Abandon processing of the current query. Regardless of the return value of requestCancel, the application must continue with the normal result-reading sequence using getResult. If the current query is part of a transaction, cancellation will abort the whole transaction. $dbname = $conn->db Returns the database name of the connection. $pguser = $conn->user Returns the Postgres user name of the connection. $pguser = $conn->pass Returns the Postgres password of the connection. $pghost = $conn->host Returns the host name of the connection. $pgport = $conn->port Returns the port of the connection. $pgtty = $conn->tty Returns the tty of the connection. $pgoptions = $conn->options Returns the options used in the connection. $status = $conn->status Returns the status of the connection. For comparing the status you may use the following constants: - PGRES_CONNECTION_OK - PGRES_CONNECTION_BAD $errorMessage = $conn->errorMessage Returns the last error message associated with this connection. $fd = $conn->socket Obtain the file descriptor number for the backend connection socket. A result of -1 indicates that no backend connection is currently open. $pid = $conn->backendPID Returns the process-id of the corresponding backend proceess. $conn->trace(debug_port) Messages passed between frontend and backend are echoed to the debug_port file stream. $conn->untrace Disables tracing. $result = $conn->exec($query) Submits a query to the backend. The return value is a pointer to the PGresult structure, which contains the complete query-result returned by the backend. In case of failure, the pointer points to an empty structure. Before using $result you should call resultStatus to ensure, that the query was properly executed. ($table, $pid) = $conn->notifies Checks for asynchronous notifications. This functions differs from the C-counterpart which returns a pointer to a new allocated structure, whereas the perl implementation returns a list. $table is the table which has been listened to and $pid is the process id of the backend. $ret = $conn->sendQuery($string, $query) Submit a query to Postgres without waiting for the result(s). After successfully calling PQsendQuery, call PQgetResult one or more times to obtain the query results. PQsendQuery may not be called again until getResult has returned NULL, indicating that the query is done. $result = $conn->getResult Wait for the next result from a prior PQsendQuery, and return it. NULL is returned when the query is complete and there will be no more results. getResult will block only if a query is active and the necessary response data has not yet been read by PQconsumeInput. $ret = $conn->isBusy Returns TRUE if a query is busy, that is, PQgetResult would block waiting for input. A FALSE return indicates that PQgetResult can be called with assurance of not blocking. $result = $conn->consumeInput If input is available from the backend, consume it. After calling consumeInput, the application may check isBusy and/or notifies to see if their state has changed. $ret = $conn->getline($string, $length) Reads a string up to $length - 1 characters from the backend. getline returns EOF at EOF, 0 if the entire line has been read, and 1 if the buffer is full. If a line consists of the two characters "\." the backend has finished sending the results of the copy command. $ret = $conn->putline($string) Sends a string to the backend. The application must explicitly send the two characters "\." to indicate to the backend that it has finished sending its data. $ret = $conn->getlineAsync($buffer, $bufsize) Non-blocking version of getline. It reads up to $bufsize characters from the backend. getlineAsync returns -1 if the end-of-copy-marker has been recognized, 0 if no data is avilable, and >0 the number of bytes returned. $ret = $conn->putnbytes($buffer, $nbytes) Sends n bytes to the backend. Returns 0 if OK, EOF if not. $ret = $conn->endcopy This function waits until the backend has finished the copy. It should either be issued when the last string has been sent to the backend using putline or when the last string has been received from the backend using getline. endcopy returns 0 on success, 1 on failure. $result = $conn->makeEmptyPGresult($status); Returns a newly allocated, initialized result with given status. =head2 2. Result With these functions you can send commands to a database and investigate the results. In Libpq the result of a command is represented by a structure called PGresult. Using the appropriate methods you can access almost all fields of this structure. $result_status = $result->resultStatus Returns the status of the result. For comparing the status you may use one of the following constants depending upon the command executed: - PGRES_EMPTY_QUERY - PGRES_COMMAND_OK - PGRES_TUPLES_OK - PGRES_COPY_OUT - PGRES_COPY_IN - PGRES_BAD_RESPONSE - PGRES_NONFATAL_ERROR - PGRES_FATAL_ERROR Use the functions below to access the contents of the PGresult structure. $ntuples = $result->ntuples Returns the number of tuples in the query result. $nfields = $result->nfields Returns the number of fields in the query result. $ret = $result->binaryTuples Returns 1 if the tuples in the query result are bianry. $fname = $result->fname($field_num) Returns the field name associated with the given field number. $fnumber = $result->fnumber($field_name) Returns the field number associated with the given field name. $ftype = $result->ftype($field_num) Returns the oid of the type of the given field number. $fsize = $result->fsize($field_num) Returns the size in bytes of the type of the given field number. It returns -1 if the field has a variable length. $fmod = $result->fmod($field_num) Returns the type-specific modification data of the field associated with the given field index. Field indices start at 0. $cmdStatus = $result->cmdStatus Returns the command status of the last query command. In case of DELETE it returns also the number of deleted tuples. In case of INSERT it returns also the OID of the inserted tuple followed by 1 (the number of affected tuples). $oid = $result->oidStatus In case the last query was an INSERT command it returns the oid of the inserted tuple. $oid = $result->cmdTuples In case the last query was an INSERT or DELETE command it returns the number of affected tuples. $value = $result->getvalue($tup_num, $field_num) Returns the value of the given tuple and field. This is a null-terminated ASCII string. Binary cursors will not work. $length = $result->getlength($tup_num, $field_num) Returns the length of the value for a given tuple and field. $null_status = $result->getisnull($tup_num, $field_num) Returns the NULL status for a given tuple and field. $res->fetchrow Fetches the next row from the server and returns NULL if all rows have been processed. Columns which have NULL as value will be set to C. $result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...) Prints out all the tuples in an intelligent manner. This function differs from the C-counterpart. The struct PQprintOpt has been implemented with a list. This list is of variable length, in order to care for the character array fieldName in PQprintOpt. The arguments $header, $align, $standard, $html3, $expanded, $pager are boolean flags. The arguments $fieldSep, $tableOpt, $caption are strings. You may append additional strings, which will be taken as replacement for the field names. $result->displayTuples($fp, $fillAlign, $fieldSep, $printHeader, qiet) Kept for backward compatibility. Use print. $result->printTuples($fout, $printAttName, $terseOutput, $width) Kept for backward compatibility. Use print. =head2 3. Large Objects These functions provide file-oriented access to user data. The large object interface is modeled after the Unix file system interface with analogies of open, close, read, write, lseek, tell. Starting with postgresql-6.5 it is required to use large objects only inside a transaction ! See eg/lo_demo.pl for an example, how to handle large objects. $lobj_fd = $conn->lo_open($lobjId, $mode) Opens an existing large object and returns an object id. For the mode bits see lo_create. Returns -1 upon failure. $ret = $conn->lo_close($lobj_fd) Closes an existing large object. Returns 0 upon success and -1 upon failure. $nbytes = $conn->lo_read($lobj_fd, $buf, $len) Reads $len bytes into $buf from large object $lobj_fd. Returns the number of bytes read and -1 upon failure. $nbytes = $conn->lo_write($lobj_fd, $buf, $len) Writes $len bytes of $buf into the large object $lobj_fd. Returns the number of bytes written and -1 upon failure. $ret = $conn->lo_lseek($lobj_fd, $offset, $whence) Change the current read or write location on the large object $obj_id. Currently $whence can only be 0 (L_SET). $lobjId = $conn->lo_creat($mode) Creates a new large object. $mode is a bit-mask describing different attributes of the new object. Use the following constants: - PGRES_INV_SMGRMASK - PGRES_INV_WRITE - PGRES_INV_READ Upon failure it returns PGRES_InvalidOid. $location = $conn->lo_tell($lobj_fd) Returns the current read or write location on the large object $lobj_fd. $ret = $conn->lo_unlink($lobjId) Deletes a large object. Returns -1 upon failure. $lobjId = $conn->lo_import($filename) Imports a Unix file as large object and returns the object id of the new object. $ret = $conn->lo_export($lobjId, $filename) Exports a large object into a Unix file. Returns -1 upon failure, 1 otherwise. =head1 AUTHOR Edmund Mergl =head1 SEE ALSO PostgreSQL Programmer's Guide, Large Objects and libpq =cut Pg-2.1.1/MANIFEST100644 000213 000000 00000000227 07577771042 006711 MANIFEST Changes Makefile.PL Pg.3 Pg.pm Pg.xs README ppport.h test.pl typemap examples/ApachePg.pl examples/example.newstyle examples/example.oldstyle Pg-2.1.1/Makefile.PL100644 000213 000000 00000002661 10041114022 007477 # $Id: Makefile.PL,v 1.20 2004/04/20 03:25:06 bmomjian Exp $ use ExtUtils::MakeMaker; use Config; use strict; my $OBJ_EXT=".o"; my $MAN3EXT=".3"; print "Configuring Pg\n"; print "Remember to actually read the README file !\n"; my $POSTGRES_INCLUDE; my $POSTGRES_LIB; if ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and !$ENV{POSTGRES_HOME}) { die "please set environment variables POSTGRES_HOME, or POSTGRES_INCLUDE and POSTGRES_LIB !\n"; } elsif ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and $ENV{POSTGRES_HOME}) { $POSTGRES_INCLUDE = "$ENV{POSTGRES_HOME}/include"; $POSTGRES_LIB = "$ENV{POSTGRES_HOME}/lib"; } else { $POSTGRES_INCLUDE = "$ENV{POSTGRES_INCLUDE}"; $POSTGRES_LIB = "$ENV{POSTGRES_LIB}"; } my %opts = ( NAME => 'Pg', VERSION_FROM => 'Pg.pm', INC => "-I$POSTGRES_INCLUDE", OBJECT => "Pg\$(OBJ_EXT)", LIBS => ["-L$POSTGRES_LIB -lpq"], AUTHOR => 'http://gborg.postgresql.org/project/pgperl/projdisplay.php', ABSTRACT => 'PostgreSQL database native Perl driver', ); my $os = $^O; print "OS: $os\n"; if ($os eq 'hpux') { my $osvers = $Config{osvers}; if ($osvers < 10) { print "Warning: Forced to build static not dynamic on $os $osvers.\a\n"; $opts{LINKTYPE} = 'static'; } } if ($Config{dlsrc} =~ /dl_none/) { $opts{LINKTYPE} = 'static'; } WriteMakefile(%opts); exit(0); # end of Makefile.PL Pg-2.1.1/Pg.3100644 000213 000000 00000052305 07570501652 006205 .rn '' }` ''' $RCSfile$$Revision$$Date$ ''' ''' $Log$ ''' .de Sh .br .if t .Sp .ne 5 .PP \fB\\$1\fR .PP .. .de Sp .if t .sp .5v .if n .sp .. .de Ip .br .ie \\n(.$>=3 .ne \\$3 .el .ne 3 .IP "\\$1" \\$2 .. .de Vb .ft CW .nf .ne \\$1 .. .de Ve .ft R .fi .. ''' ''' ''' Set up \*(-- to give an unbreakable dash; ''' string Tr holds user defined translation string. ''' Bell System Logo is used as a dummy character. ''' .tr \(*W-|\(bv\*(Tr .ie n \{\ .ds -- \(*W- .ds PI pi .if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch .if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch .ds L" "" .ds R" "" ''' \*(M", \*(S", \*(N" and \*(T" are the equivalent of ''' \*(L" and \*(R", except that they are used on ".xx" lines, ''' such as .IP and .SH, which do another additional levels of ''' double-quote interpretation .ds M" """ .ds S" """ .ds N" """"" .ds T" """"" .ds L' ' .ds R' ' .ds M' ' .ds S' ' .ds N' ' .ds T' ' 'br\} .el\{\ .ds -- \(em\| .tr \*(Tr .ds L" `` .ds R" '' .ds M" `` .ds S" '' .ds N" `` .ds T" '' .ds L' ` .ds R' ' .ds M' ` .ds S' ' .ds N' ` .ds T' ' .ds PI \(*p 'br\} .\" If the F register is turned on, we'll generate .\" index entries out stderr for the following things: .\" TH Title .\" SH Header .\" Sh Subsection .\" Ip Item .\" X<> Xref (embedded .\" Of course, you have to process the output yourself .\" in some meaninful fashion. .if \nF \{ .de IX .tm Index:\\$1\t\\n%\t"\\$2" .. .nr % 0 .rr F .\} .TH Pg 3 "perl 5.005, patch 03" "14/Aug/2002" "User Contributed Perl Documentation" .UC .if n .hy 0 .if n .na .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .de CQ \" put $1 in typewriter font .ft CW 'if n "\c 'if t \\&\\$1\c 'if n \\&\\$1\c 'if n \&" \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 '.ft R .. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 . \" AM - accent mark definitions .bd B 3 . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds ? ? . ds ! ! . ds / . ds q .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' . ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E .ds oe o\h'-(\w'o'u*4/10)'e .ds Oe O\h'-(\w'O'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds v \h'-1'\o'\(aa\(ga' . ds _ \h'-1'^ . ds . \h'-1'. . ds 3 3 . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE . ds oe oe . ds Oe OE .\} .rm #[ #] #H #V #F C .SH "NAME" Pg \- Perl5 extension for PostgreSQL .SH "SYNOPSIS" new style: .PP .Vb 3 \& use Pg; \& $conn = Pg::connectdb("dbname=template1"); \& $result = $conn->exec("create database pgtest"); .Ve old style (depreciated): .PP .Vb 5 \& use Pg; \& $conn = PQsetdb('', '', '', '', template1); \& $result = PQexec($conn, "create database pgtest"); \& PQclear($result); \& PQfinish($conn); .Ve .SH "DESCRIPTION" The Pg module permits you to access all functions of the Libpq interface of PostgreSQL. Libpq is the programmer's interface to PostgreSQL. Pg tries to resemble this interface as close as possible. For examples of how to use this module, look at the file test.pl. For further examples look at the Libpq applications in \&../src/test/examples and ../src/test/regress. .PP You have the choice between the old C\-style and a new, more Perl-ish style. The old style has the benefit, that existing Libpq applications can be ported to perl just by prepending every variable with a \*(L'$\*(R'. The new style uses class packages and might be more familiar for \*(C+\-programmers. .SH "GUIDELINES" .Sh "new style" The new style uses blessed references as objects. After creating a new connection or result object, the relevant Libpq functions serve as virtual methods. One benefit of the new style: you do not have to care about freeing the connection- and result-structures. Perl calls the destructor whenever the last reference to an object goes away. .PP The method fetchrow can be used to fetch the next row from the server: while (@row = \f(CW$result\fR\->fetchrow). Columns which have \s-1NULL\s0 as value will be set to \f(CWundef\fR. .Sh "old style" All functions and constants are imported into the calling packages name-space. In order to to get a uniform naming, all functions start with \*(L'\s-1PQ\s0\*(R' (e.g. PQlo_open) and all constants start with \*(L'\s-1PGRES_\s0\*(R' (e.g. \s-1PGRES_CONNECTION_OK\s0). .PP There are two functions, which allocate memory, that has to be freed by the user: .PP .Vb 2 \& PQsetdb, use PQfinish to free memory. \& PQexec, use PQclear to free memory. .Ve Pg.pm contains one convenience function: doQuery. It fills a two-dimensional array with the result of your query. Usage: .PP .Vb 1 \& Pg::doQuery($conn, "select attr1, attr2 from tbl", \e@ary); .Ve .Vb 6 \& for $i ( 0 .. $#ary ) { \& for $j ( 0 .. $#{$ary[$i]} ) { \& print "$ary[$i][$j]\et"; \& } \& print "\en"; \& } .Ve Notice the inner loop ! .SH "CAVEATS" There are few exceptions, where the perl-functions differs from the C\-counterpart: PQprint, PQnotifies and PQconndefaults. These functions deal with structures, which have been implemented in perl using lists or hash. .SH "FUNCTIONS" The functions have been divided into three sections: Connection, Result, Large Objects. For details please read the \fIlibpq\fR manpage. .Sh "1. Connection" With these functions you can establish and close a connection to a database. In Libpq a connection is represented by a structure called PGconn. .PP When opening a connection a given database name is always converted to lower-case, unless it is surrounded by double quotes. All unspecified parameters are replaced by environment variables or by hard coded defaults: .PP .Vb 10 \& parameter environment variable hard coded default \& ------------------------------------------------------ \& host PGHOST localhost \& port PGPORT 5432 \& options PGOPTIONS "" \& tty PGTTY "" \& dbname PGDATABASE current userid \& user PGUSER current userid \& password PGPASSWORD "" \& passwordfile PGPASSWORDFILE "" .Ve Using appropriate methods you can access almost all fields of the returned PGconn structure. .PP .Vb 1 \& $conn = Pg::setdbLogin($pghost, $pgport, $pgoptions, $pgtty, $dbname, $login, $pwd) .Ve Opens a new connection to the backend. The connection identifier \f(CW$conn\fR ( a pointer to the PGconn structure ) must be used in subsequent commands for unique identification. Before using \f(CW$conn\fR you should call \f(CW$conn\fR\->status to ensure, that the connection was properly made. .PP .Vb 1 \& $conn = Pg::setdb($pghost, $pgport, $pgoptions, $pgtty, $dbname) .Ve The method setdb should be used when username/password authentication is not needed. .PP .Vb 1 \& $conn = Pg::connectdb("option1=value option2=value ...") .Ve Opens a new connection to the backend using connection information in a string. Possible options are: host, port, options, tty, dbname, user, password. The connection identifier \f(CW$conn\fR (a pointer to the PGconn structure) must be used in subsequent commands for unique identification. Before using \f(CW$conn\fR you should call \f(CW$conn\fR\->status to ensure, that the connection was properly made. .PP .Vb 1 \& $Option_ref = Pg::conndefaults() .Ve .Vb 2 \& while(($key, $val) = each %$Option_ref) { \& print "$key, $val\en"; .Ve Returns a reference to a hash containing as keys all possible options for \fIconnectdb()\fR. The values are the current defaults. This function differs from his C\-counterpart, which returns the complete conninfoOption structure. .PP .Vb 1 \& PQfinish($conn) .Ve Old style only ! Closes the connection to the backend and frees the connection data structure. .PP .Vb 1 \& $conn->reset .Ve Resets the communication port with the backend and tries to establish a new connection. .PP .Vb 1 \& $ret = $conn->requestCancel .Ve Abandon processing of the current query. Regardless of the return value of requestCancel, the application must continue with the normal result-reading sequence using getResult. If the current query is part of a transaction, cancellation will abort the whole transaction. .PP .Vb 1 \& $dbname = $conn->db .Ve Returns the database name of the connection. .PP .Vb 1 \& $pguser = $conn->user .Ve Returns the Postgres user name of the connection. .PP .Vb 1 \& $pguser = $conn->pass .Ve Returns the Postgres password of the connection. .PP .Vb 1 \& $pghost = $conn->host .Ve Returns the host name of the connection. .PP .Vb 1 \& $pgport = $conn->port .Ve Returns the port of the connection. .PP .Vb 1 \& $pgtty = $conn->tty .Ve Returns the tty of the connection. .PP .Vb 1 \& $pgoptions = $conn->options .Ve Returns the options used in the connection. .PP .Vb 1 \& $status = $conn->status .Ve Returns the status of the connection. For comparing the status you may use the following constants: .PP .Vb 2 \& - PGRES_CONNECTION_OK \& - PGRES_CONNECTION_BAD .Ve .Vb 1 \& $errorMessage = $conn->errorMessage .Ve Returns the last error message associated with this connection. .PP .Vb 1 \& $fd = $conn->socket .Ve Obtain the file descriptor number for the backend connection socket. A result of \-1 indicates that no backend connection is currently open. .PP .Vb 1 \& $pid = $conn->backendPID .Ve Returns the process-id of the corresponding backend proceess. .PP .Vb 1 \& $conn->trace(debug_port) .Ve Messages passed between frontend and backend are echoed to the debug_port file stream. .PP .Vb 1 \& $conn->untrace .Ve Disables tracing. .PP .Vb 1 \& $result = $conn->exec($query) .Ve Submits a query to the backend. The return value is a pointer to the PGresult structure, which contains the complete query-result returned by the backend. In case of failure, the pointer points to an empty structure. In this, the perl implementation differs from the C\-implementation. Using the old style, even the empty structure has to be freed using PQfree. Before using \f(CW$result\fR you should call resultStatus to ensure, that the query was properly executed. .PP .Vb 1 \& ($table, $pid) = $conn->notifies .Ve Checks for asynchronous notifications. This functions differs from the C\-counterpart which returns a pointer to a new allocated structure, whereas the perl implementation returns a list. \f(CW$table\fR is the table which has been listened to and \f(CW$pid\fR is the process id of the backend. .PP .Vb 1 \& $ret = $conn->sendQuery($string, $query) .Ve Submit a query to Postgres without waiting for the \fIresult\fR\|(s). After successfully calling PQsendQuery, call PQgetResult one or more times to obtain the query results. PQsendQuery may not be called again until getResult has returned \s-1NULL\s0, indicating that the query is done. .PP .Vb 1 \& $result = $conn->getResult .Ve Wait for the next result from a prior PQsendQuery, and return it. \s-1NULL\s0 is returned when the query is complete and there will be no more results. getResult will block only if a query is active and the necessary response data has not yet been read by PQconsumeInput. .PP .Vb 1 \& $ret = $conn->isBusy .Ve Returns \s-1TRUE\s0 if a query is busy, that is, PQgetResult would block waiting for input. A \s-1FALSE\s0 return indicates that PQgetResult can be called with assurance of not blocking. .PP .Vb 1 \& $result = $conn->consumeInput .Ve If input is available from the backend, consume it. After calling consumeInput, the application may check isBusy and/or notifies to see if their state has changed. .PP .Vb 1 \& $ret = $conn->getline($string, $length) .Ve Reads a string up to \f(CW$length\fR \- 1 characters from the backend. getline returns \s-1EOF\s0 at \s-1EOF\s0, 0 if the entire line has been read, and 1 if the buffer is full. If a line consists of the two characters \*(L"\e.\*(R" the backend has finished sending the results of the copy command. .PP .Vb 1 \& $ret = $conn->putline($string) .Ve Sends a string to the backend. The application must explicitly send the two characters \*(L"\e.\*(R" to indicate to the backend that it has finished sending its data. .PP .Vb 1 \& $ret = $conn->getlineAsync($buffer, $bufsize) .Ve Non-blocking version of getline. It reads up to \f(CW$bufsize\fR characters from the backend. getlineAsync returns \-1 if the end-of-copy-marker has been recognized, 0 if no data is avilable, and >0 the number of bytes returned. .PP .Vb 1 \& $ret = $conn->putnbytes($buffer, $nbytes) .Ve Sends n bytes to the backend. Returns 0 if \s-1OK\s0, \s-1EOF\s0 if not. .PP .Vb 1 \& $ret = $conn->endcopy .Ve This function waits until the backend has finished the copy. It should either be issued when the last string has been sent to the backend using putline or when the last string has been received from the backend using getline. endcopy returns 0 on success, 1 on failure. .PP .Vb 1 \& $result = $conn->makeEmptyPGresult($status); .Ve Returns a newly allocated, initialized result with given status. .Sh "2. Result" With these functions you can send commands to a database and investigate the results. In Libpq the result of a command is represented by a structure called PGresult. Using the appropriate methods you can access almost all fields of this structure. .PP .Vb 1 \& $result_status = $result->resultStatus .Ve Returns the status of the result. For comparing the status you may use one of the following constants depending upon the command executed: .PP .Vb 8 \& - PGRES_EMPTY_QUERY \& - PGRES_COMMAND_OK \& - PGRES_TUPLES_OK \& - PGRES_COPY_OUT \& - PGRES_COPY_IN \& - PGRES_BAD_RESPONSE \& - PGRES_NONFATAL_ERROR \& - PGRES_FATAL_ERROR .Ve Use the functions below to access the contents of the PGresult structure. .PP .Vb 1 \& $ntuples = $result->ntuples .Ve Returns the number of tuples in the query result. .PP .Vb 1 \& $nfields = $result->nfields .Ve Returns the number of fields in the query result. .PP .Vb 1 \& $ret = $result->binaryTuples .Ve Returns 1 if the tuples in the query result are bianry. .PP .Vb 1 \& $fname = $result->fname($field_num) .Ve Returns the field name associated with the given field number. .PP .Vb 1 \& $fnumber = $result->fnumber($field_name) .Ve Returns the field number associated with the given field name. .PP .Vb 1 \& $ftype = $result->ftype($field_num) .Ve Returns the oid of the type of the given field number. .PP .Vb 1 \& $fsize = $result->fsize($field_num) .Ve Returns the size in bytes of the type of the given field number. It returns \-1 if the field has a variable length. .PP .Vb 1 \& $fmod = $result->fmod($field_num) .Ve Returns the type-specific modification data of the field associated with the given field index. Field indices start at 0. .PP .Vb 1 \& $cmdStatus = $result->cmdStatus .Ve Returns the command status of the last query command. In case of \s-1DELETE\s0 it returns also the number of deleted tuples. In case of \s-1INSERT\s0 it returns also the \s-1OID\s0 of the inserted tuple followed by 1 (the number of affected tuples). .PP .Vb 1 \& $oid = $result->oidStatus .Ve In case the last query was an \s-1INSERT\s0 command it returns the oid of the inserted tuple. .PP .Vb 1 \& $oid = $result->cmdTuples .Ve In case the last query was an \s-1INSERT\s0 or \s-1DELETE\s0 command it returns the number of affected tuples. .PP .Vb 1 \& $value = $result->getvalue($tup_num, $field_num) .Ve Returns the value of the given tuple and field. This is a null-terminated \s-1ASCII\s0 string. Binary cursors will not work. .PP .Vb 1 \& $length = $result->getlength($tup_num, $field_num) .Ve Returns the length of the value for a given tuple and field. .PP .Vb 1 \& $null_status = $result->getisnull($tup_num, $field_num) .Ve Returns the \s-1NULL\s0 status for a given tuple and field. .PP .Vb 1 \& PQclear($result) .Ve Old style only ! Frees all memory of the given result. .PP .Vb 1 \& $res->fetchrow .Ve New style only ! Fetches the next row from the server and returns \s-1NULL\s0 if all rows have been processed. Columns which have \s-1NULL\s0 as value will be set to \f(CWundef\fR. .PP .Vb 1 \& $result->print($fout, $header, $align, $standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...) .Ve Prints out all the tuples in an intelligent manner. This function differs from the C\-counterpart. The struct PQprintOpt has been implemented with a list. This list is of variable length, in order to care for the character array fieldName in PQprintOpt. The arguments \f(CW$header\fR, \f(CW$align\fR, \f(CW$standard\fR, \f(CW$html3\fR, \f(CW$expanded\fR, \f(CW$pager\fR are boolean flags. The arguments \f(CW$fieldSep\fR, \f(CW$tableOpt\fR, \f(CW$caption\fR are strings. You may append additional strings, which will be taken as replacement for the field names. .PP .Vb 1 \& $result->displayTuples($fp, $fillAlign, $fieldSep, $printHeader, qiet) .Ve Kept for backward compatibility. Use print. .PP .Vb 1 \& $result->printTuples($fout, $printAttName, $terseOutput, $width) .Ve Kept for backward compatibility. Use print. .Sh "3. Large Objects" These functions provide file-oriented access to user data. The large object interface is modeled after the Unix file system interface with analogies of open, close, read, write, lseek, tell. In order to get a consistent naming, all function names have been prepended with \*(L'\s-1PQ\s0\*(R' (old style only). .PP .Vb 1 \& $lobj_fd = $conn->lo_open($lobjId, $mode) .Ve Opens an existing large object and returns an object id. For the mode bits see lo_create. Returns \-1 upon failure. .PP .Vb 1 \& $ret = $conn->lo_close($lobj_fd) .Ve Closes an existing large object. Returns 0 upon success and \-1 upon failure. .PP .Vb 1 \& $nbytes = $conn->lo_read($lobj_fd, $buf, $len) .Ve Reads \f(CW$len\fR bytes into \f(CW$buf\fR from large object \f(CW$lobj_fd\fR. Returns the number of bytes read and \-1 upon failure. .PP .Vb 1 \& $nbytes = $conn->lo_write($lobj_fd, $buf, $len) .Ve Writes \f(CW$len\fR bytes of \f(CW$buf\fR into the large object \f(CW$lobj_fd\fR. Returns the number of bytes written and \-1 upon failure. .PP .Vb 1 \& $ret = $conn->lo_lseek($lobj_fd, $offset, $whence) .Ve Change the current read or write location on the large object \f(CW$obj_id\fR. Currently \f(CW$whence\fR can only be 0 (L_SET). .PP .Vb 1 \& $lobjId = $conn->lo_creat($mode) .Ve Creates a new large object. \f(CW$mode\fR is a bit-mask describing different attributes of the new object. Use the following constants: .PP .Vb 3 \& - PGRES_INV_SMGRMASK \& - PGRES_INV_WRITE \& - PGRES_INV_READ .Ve Upon failure it returns PGRES_InvalidOid. .PP .Vb 1 \& $location = $conn->lo_tell($lobj_fd) .Ve Returns the current read or write location on the large object \f(CW$lobj_fd\fR. .PP .Vb 1 \& $ret = $conn->lo_unlink($lobjId) .Ve Deletes a large object. Returns \-1 upon failure. .PP .Vb 1 \& $lobjId = $conn->lo_import($filename) .Ve Imports a Unix file as large object and returns the object id of the new object. .PP .Vb 1 \& $ret = $conn->lo_export($lobjId, $filename) .Ve Exports a large object into a Unix file. Returns \-1 upon failure, 1 otherwise. .SH "AUTHOR" .PP .Vb 1 \& Edmund Mergl .Ve .SH "SEE ALSO" the \fIlibpq\fR manpage, the \fIlarge_objects\fR manpage .rn }` '' .IX Title "Pg 3" .IX Name "Pg - Perl5 extension for PostgreSQL" .IX Header "NAME" .IX Header "SYNOPSIS" .IX Header "DESCRIPTION" .IX Header "GUIDELINES" .IX Subsection "new style" .IX Subsection "old style" .IX Header "CAVEATS" .IX Header "FUNCTIONS" .IX Subsection "1. Connection" .IX Subsection "2. Result" .IX Subsection "3. Large Objects" .IX Header "AUTHOR" .IX Header "SEE ALSO" Pg-2.1.1/Changes100644 000213 000000 00000011626 10041530561 007033 #------------------------------------------------------- # # $Id: Changes,v 1.15 2004/04/21 17:37:53 bmomjian Exp $ # #------------------------------------------------------- Revision history for Perl extension Pg. 2.1.1 2004-02-20 (contributed by Jeremy Yoder ) - Clean up memory issues in Pg.xs o Use safecalloc instead of calloc o Use PQfreeNotify intead of free for notify struct - Changed minimum Perl to 5.005 - Update instructions for running tests 2.1.0 2004-02-12 (contributed by Jeremy Yoder ) - Merge 1.9.0 branch with 2.0.2 branch to create 2.1.0 - Rename to Pg - examples/example.newstyle renamed to examples/example.pl - Removed examples/example.oldstyle 2.0.2 2002-12-17 - Improve installation instructions. 2.0.1 2002-11-27 - Make tarball using 'gmake dist' 2.0 2002-11-25 - Renamed to pgperl - Moved to gborg and created standalone build system. Added POSTGRESQL_HOME environment variable. 1.9.0 Apr 04 2000 - remove compile errors with perl5.6 - remove old-style interface - change return value in case of failure from -1 to undef - for building the module it is required to set the environment variables POSTGRES_INCLUDE and POSTGRES_LIB 1.8.2 Mar 31 1999 - bug-fix in Makefile.PL for $POSTGRES_HOME not defined - bug-fix in doQuery() spotted by Christopher Hutton - minor changes to be compliant with libpq - use PQsetdbLogin (using the provided userid/password) instead of PQsetdb 1.8.1 Jan 14 1999 - applied patch from David Smith : missing first character in dbanme parameter of connect string. - changed link-type to static on hpux < 10.0 1.8.0 Sep 27 1998 - adapted to PostgreSQL-6.4: added support for o PQsetdbLogin o PQpass o PQsocket o PQbackendPID o PQsendQuery o PQgetResult o PQisBusy o PQconsumeInput o PQrequestCancel o PQgetlineAsync o PQputnbytes o PQmakeEmptyPGresult o PQbinaryTuples o PQfmod - fixed conndefaults() - fixed lo_read 1.7.4 May 28 1998 - applied patches from Brook Milligan : o changed Makefile.PL to look for include files and libs in the source tree, except when the environment variable POSTGRES_HOME is set. o bug-fix in test.pl 1.7.3 Mar 28 1998 - linking again with the shared version of libpq due to problems on several operating systems. 1.7.2 Mar 06 1998 - module is now linked with static libpq.a 1.7.1 Mar 03 1998 - expanded the search path for include files - return to UNIX domain sockets in test-scripts 1.7.0 Feb 20 1998 - adapted to PostgreSQL-6.3: add host=localhost to the conninfo-string of test.pl and example-scripts - connectdb() converts dbname to lower case, unless it is surrounded by double quotes - added new method fetchrow, now you can do: while (@row = $result->fetchrow) 1.6.3 Sep 25 1997 - README update 1.6.2 Sep 20 1997 - adapted to PostgreSQL-6.2: o added support for new method cmdTuples o cmdStatus returns now for DELETE the status followed by the number of affected rows, - test.pl.newstyle renamed to examples/example.newstyle - test.pl.oldstyle renamed to examples/example.oldstyle - example script ApachePg.pl now uses $result->print with HTML option - Makefile looks for $ENV{POSTGRES_HOME} instead of $ENV{POSTGRESHOME} 1.6.1 Jun 02 1997 - renamed to pgsql_perl5 - adapted to PostgreSQL-6.1 - test only functions, which are also tested in pgsql regression tests 1.5.4 Feb 12, 1997 - changed test.pl for large objects: test only lo_import and lo_export 1.5.3 Jan 2, 1997 - adapted to PostgreSQL-6.0 - new functions PQconnectdb, PQuser - changed name of method 'new' to 'setdb' 1.4.2 Nov 21, 1996 - added a more Perl-like syntax 1.3.2 Nov 11, 1996 - adapted to Postgres95-1.09 - test.pl adapted to postgres95-1.0.9: PQputline expects now '\.' as last input and PQgetline outputs '\.' as last line. 1.3.1 Oct 22, 1996 - adapted to Postgres95-1.08 - large-object interface added, thanks to Sven Verdoolaege (skimo@breughel.ufsia.ac.be) - PQgetline() changed. This breaks old scripts ! - PQexec now returns in any case a valid pointer. This fixes the annoying message: 'res is not of type PGresultPtr at ...' - testsuite completely rewritten, contains now examples for almost all functions - resturn codes are now available as constants (PGRES_xxx) - PQnotifies() works now - enhanced doQuery() 1.2.0 Oct 15, 1995 - adapted to Postgres95-1.0 - README updated - doQuery() in Pg.pm now returns 0 upon success - testlibpq.pl: added test for PQgetline() 1.1.1 Aug 5, 95 - adapted to postgres95-beta0.03 - Note: the libpq interface has changed completely ! 1.1 Jun 6, 1995 - Bug fix in PQgetline. 1.0 Mar 24, 1995 - creation Pg-2.1.1/test.pl100644 000213 000000 00000016321 10041530511 007044 #!/usr/bin/perl -w # $Id: test.pl,v 1.18 2004/04/21 17:37:13 bmomjian Exp $ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. BEGIN { $| = 1; } END {print "test failed\n" unless $loaded;} use Pg; $loaded = 1; use strict; ######################### End of black magic. my $dbmain = 'template1'; my $dbname = 'pgperltest'; my $trace = '/tmp/pgtrace.out'; my ($conn, $result, $i); my $DEBUG = 0; # set this to 1 for traces ######################### the following methods will be tested # connectdb # conndefaults # db # user # port # status # errorMessage # trace # untrace # exec # getline # putline # endcopy # resultStatus # fname # fnumber # ftype # fsize # cmdStatus # oidStatus # cmdTuples # fetchrow ######################### the following methods will not be tested # setdb # setdbLogin # reset # requestCancel # pass # host # tty # options # socket # backendPID # notifies # sendQuery # getResult # isBusy # consumeInput # getlineAsync # putnbytes # makeEmptyPGresult # ntuples # nfields # binaryTuples # fmod # getvalue # getlength # getisnull # print # displayTuples # printTuples # lo_import # lo_export # lo_unlink # 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 my $Option_ref = Pg::conndefaults(); my ($key, $val); ( $$Option_ref{port} ne "" && $$Option_ref{dbname} ne "" && $$Option_ref{user} ne "" ) and print "Pg::conndefaults ........ ok\n" or die "Pg::conndefaults ........ not ok: "; $conn = Pg::connectdb("dbname=$dbmain"); ( PGRES_CONNECTION_OK eq $conn->status ) and print "Pg::connectdb ........... ok\n" or die "Pg::connectdb ........... not ok: ", $conn->errorMessage; # do not complain when dropping $dbname $conn->exec("DROP DATABASE $dbname"); $result = $conn->exec("CREATE DATABASE $dbname"); ( PGRES_COMMAND_OK eq $result->resultStatus ) and print "\$conn->exec ............. ok\n" or die "\$conn->exec ............. not ok: ", $conn->errorMessage; $conn = Pg::connectdb("dbname=rumpumpel"); ( $conn->errorMessage =~ /[Dd]atabase .?rumpumpel.? does not exist/ ) and print "\$conn->errorMessage ..... ok\n" or die "\$conn->errorMessage ..... not ok: ", $conn->errorMessage; $conn = Pg::connectdb("dbname=$dbname"); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; ######################### debug, PQtrace if ($DEBUG) { open(FD, ">$trace") || die "can not open $trace: $!"; $conn->trace("FD"); } ######################### check PGconn my $db = $conn->db; ( $dbname eq $db ) and print "\$conn->db ............... ok\n" or print "\$conn->db ............... not ok: $db\n"; my $user = $conn->user; ( "" ne $user ) and print "\$conn->user ............. ok\n" or print "\$conn->user ............. not ok: $user\n"; my $port = $conn->port; ( "" ne $port ) and print "\$conn->port ............. ok\n" or print "\$conn->port ............. not ok: $port\n"; ######################### create and insert into table # we test comments inside string and with no trailing newline here $result = $conn->exec("CREATE TABLE person (id int4, -- test\n name char(16)) -- test"); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; my $cmd = $result->cmdStatus; ( $cmd =~ /^CREATE/ ) and print "\$conn->cmdStatus ........ ok\n" or print "\$conn->cmdStatus ........ not ok: $cmd\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; } my $oid = $result->oidStatus; ( 0 != $oid ) and print "\$conn->oidStatus ........ ok\n" or print "\$conn->oidStatus ........ not ok: $oid\n"; ######################### copy to stdout, PQgetline $result = $conn->exec("COPY person TO STDOUT"); die $conn->errorMessage unless PGRES_COPY_OUT eq $result->resultStatus; my $ret = 0; my $buf; my $string; $i = 1; while (-1 != $ret) { $ret = $conn->getline($buf, 256); last if $buf eq "\\."; $string = $buf if 1 == $i; $i++; } ( "1 Edmund Mergl " eq $string ) and print "\$conn->getline .......... ok\n" or print "\$conn->getline .......... not ok: $string\n"; $ret = $conn->endcopy; ( 0 == $ret ) and print "\$conn->endcopy .......... ok\n" or print "\$conn->endcopy .......... not ok: $ret\n"; ######################### delete and copy from stdin, PQputline $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; $ret = $result->cmdTuples; ( 5 == $ret ) and print "\$result->cmdTuples ...... ok\n" or print "\$result->cmdTuples ...... not ok: $ret\n"; $result = $conn->exec("COPY person FROM STDIN"); die $conn->errorMessage unless PGRES_COPY_IN eq $result->resultStatus; 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 if $conn->endcopy; $result = $conn->exec("END"); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; ######################### select from person, PQgetvalue $result = $conn->exec("SELECT * FROM person"); die $conn->errorMessage unless PGRES_TUPLES_OK eq $result->resultStatus; my $fname = $result->fname(0); ( "id" eq $fname ) and print "\$result->fname .......... ok\n" or print "\$result->fname .......... not ok: $fname\n"; my $ftype = $result->ftype(0); ( 23 == $ftype ) and print "\$result->ftype .......... ok\n" or print "\$result->ftype .......... not ok: $ftype\n"; my $fsize = $result->fsize(0); ( 4 == $fsize ) and print "\$result->fsize .......... ok\n" or print "\$result->fsize .......... not ok: $fsize\n"; my $fnumber = $result->fnumber($fname); ( 0 == $fnumber ) and print "\$result->fnumber ........ ok\n" or print "\$result->fnumber ........ not ok: $fnumber\n"; $string = ""; my @row; while (@row = $result->fetchrow) { $string = join(" ", @row); } ( "5 Edmund Mergl " eq $string ) and print "\$result->fetchrow ....... ok\n" or print "\$result->fetchrow ....... not ok: $string\n"; ######################### debug, PQuntrace if ($DEBUG) { close(FD) || die "bad TRACE: $!"; $conn->untrace; } ######################### disconnect and drop test database undef $conn; $conn = Pg::connectdb("dbname=$dbmain"); die $conn->errorMessage unless PGRES_CONNECTION_OK eq $conn->status; # Race condition: it's quite possible that the DROP command will arrive # at the new backend before the old backend has finished shutting down, # resulting in an error message. # There doesn't seem to be any more graceful way around this than to # insert a small delay ... sleep(1); $result = $conn->exec("DROP DATABASE $dbname"); die $conn->errorMessage unless PGRES_COMMAND_OK eq $result->resultStatus; print "test sequence finished.\n"; ######################### EOF Pg-2.1.1/ppport.h100644 000213 000000 00000017163 10041113240 007226 #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ /* Perl/Pollution/Portability Version 1.0007 */ /* Copyright (C) 1999, Kenneth Albanowski. This code may be used and distributed under the same license as any version of Perl. */ /* For the latest version of this code, please retreive the Devel::PPPort module from CPAN, contact the author at , or check with the Perl maintainers. */ /* If you needed to customize this file for your project, please mention your changes, and visible alter the version number. */ /* In order for a Perl extension module to be as portable as possible across differing versions of Perl itself, certain steps need to be taken. Including this header is the first major one, then using dTHR is all the appropriate places and using a PL_ prefix to refer to global Perl variables is the second. */ /* If you use one of a few functions that were not present in earlier versions of Perl, please add a define before the inclusion of ppport.h for a static include, or use the GLOBAL request in a single module to produce a global definition that can be referenced from the other modules. Function: Static define: Extern define: newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL */ /* To verify whether ppport.h is needed for your module, and whether any special defines should be used, ppport.h can be run through Perl to check your source code. Simply say: perl -x ppport.h *.c *.h *.xs foo/*.c [etc] The result will be a list of patches suggesting changes that should at least be acceptable, if not necessarily the most efficient solution, or a fix for all possible problems. It won't catch where dTHR is needed, and doesn't attempt to account for global macro or function definitions, nested includes, typemaps, etc. In order to test for the need of dTHR, please try your module under a recent version of Perl that has threading compiled-in. */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include "patchlevel.h" # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes # define PL_sv_no sv_no # define PL_na na # define PL_stdingv stdingv # define PL_hints hints # define PL_curcop curcop # define PL_curstash curstash # define PL_copline copline # define PL_Sv Sv /* Replace: 0 */ #endif #ifndef dTHR # ifdef WIN32 # define dTHR extern int Perl___notused # else # define dTHR extern int errno # endif #endif #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(CRIPPLED_CC) || defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #endif /* _P_P_PORTABILITY_H_ */ Pg-2.1.1/README100644 000213 000000 00000010076 10041531072 006414 Pg -- a libpq-based PostgreSQL interface for Perl # $Id: README,v 1.17 2004/04/21 17:41:14 bmomjian Exp $ DESCRIPTION: ------------ This is version 2.1.0 of Pg (previously called pgsql_perl5 and pgperl). The web site for this interface is at: http://gborg.postgresql.org/project/pgperl/projdisplay.php For information about PostgreSQL, visit: http://www.postgresql.org/ Pg is an interface between Larry Wall's language perl version 5 and the database PostgreSQL (previously Postgres95). This has been done by using the Perl5 application programming interface for C extensions which calls the Postgres programmer's interface LIBPQ. COPYRIGHT: ---------- Copyright (c) 1997, 1998 Edmund Mergl Copyright (c) 1999-2002 PostgreSQL Global Development Group You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. IF YOU HAVE PROBLEMS: --------------------- Please send comments and bug-reports to . Please include the output of: o perl -v o perl -V o the PostgreSQL version o version of Pg in your bug-report. REQUIREMENTS: ------------- build, test and install Perl5 (at least 5.003) build, test and install PostgreSQL (at least 6.5) PLATFORMS: ---------- This release of Pg has been developed using Linux 2.2 with dynamic loading for the perl extensions. Let me know, if there are any problems with other platforms. INSTALLATION: ------------- The Makefile uses the environment variables POSTGRES_INCLUDE and POSTGRES_LIB, or POSTGRES_HOME to find the library libpq.so and the include file libpq-fe.h. If you are using pre-compiled binaries for postgresql and you can't find libpq.so and libpq-fe.h most probably you forgot to install the additional development-package for postgresql. 1. POSTGRES_HOME=/usr/local/pgsql; export POSTGRES_HOME 2. perl Makefile.PL 3. make 4. PGDATABASE=test; export PGDATABASE PGUSER=postgres; export PGUSER 5. make test 6. make install Do steps 1 - 5 as normal user, not as root! TESTING: -------- Run 'make test'. Note, that the user running this script must have been created with the access rights to create databases *AND* users! Do not run this script as root! If testing fails with the message 'login failed', please check if access to the database template1 as well as pgperltest is not protected via pg_hba.conf. If you are using the shared library libpq.so check if your dynamic loader finds libpq.so. With Linux the command /sbin/ldconfig -v should tell you, where it finds libpq.so. If ldconfig does not find libpq.so, either add an appropriate entry to /etc/ld.so.conf and re-run ldconfig or add the path to the environment variable LD_LIBRARY_PATH. A typical error message resulting from not finding libpq.so is: Can't load './blib/arch/auto/Pg/Pg.so' for module Pg: File not found at Some linux distributions have an incomplete perl installation. If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", run: find /lib/ -name XSUB.h -print If this file is not present, you need to recompile and reinstall perl. Also RedHat 5.0 seems to have an incomplete perl-installation: if you get error message during the installation complaining about a missing perllocal.pod, you need to recompile and reinstall perl. SGI users: if you get segmentation faults make sure, you use the malloc which comes with perl when compiling perl (the default is not to). "David R. Noble" HP users: if you get error messages like: can't open shared library: .../lib/libpq.sl No such file or directory when running the test script, try to replace the 'shared' option in the LDDFLAGS with 'archive'. Dan Lauterbach DOCUMENTATION: -------------- Detailed documentation can be found in Pg.pm. Use 'perldoc Pg' after installation to read the documentation. Original author Edmund Mergl .