From 30b9b529f3427efaac488bdb3bca32e91b3f7afd Mon Sep 17 00:00:00 2001 From: Edmund Mergl <E.Mergl@bawue.de> Date: Fri, 20 Feb 1998 21:25:47 +0000 Subject: [PATCH] 1.7.0 --- src/interfaces/perl5/Changes | 9 ++ src/interfaces/perl5/Makefile.PL | 2 +- src/interfaces/perl5/Pg.pm | 46 +++---- src/interfaces/perl5/Pg.xs | 208 ++++++++++++++++++++++++------- src/interfaces/perl5/README | 27 +++- src/interfaces/perl5/test.pl | 26 ++-- src/interfaces/perl5/typemap | 3 +- 7 files changed, 233 insertions(+), 88 deletions(-) diff --git a/src/interfaces/perl5/Changes b/src/interfaces/perl5/Changes index f724f2c559..99be7ab7d2 100644 --- a/src/interfaces/perl5/Changes +++ b/src/interfaces/perl5/Changes @@ -1,5 +1,14 @@ Revision history for Perl extension Pg. +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 diff --git a/src/interfaces/perl5/Makefile.PL b/src/interfaces/perl5/Makefile.PL index a64fc42ec0..47c480beb3 100644 --- a/src/interfaces/perl5/Makefile.PL +++ b/src/interfaces/perl5/Makefile.PL @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: Makefile.PL,v 1.4 1997/09/25 21:14:41 mergl Exp $ +# $Id: Makefile.PL,v 1.5 1998/02/20 21:25:32 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # diff --git a/src/interfaces/perl5/Pg.pm b/src/interfaces/perl5/Pg.pm index a46df8d04c..f234a1d25a 100644 --- a/src/interfaces/perl5/Pg.pm +++ b/src/interfaces/perl5/Pg.pm @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: Pg.pm,v 1.4 1997/09/25 21:14:43 mergl Exp $ +# $Id: Pg.pm,v 1.5 1998/02/20 21:25:35 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -8,7 +8,7 @@ package Pg; -use strict; +#use strict; use Carp; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); @@ -84,7 +84,7 @@ require 5.002; PGRES_InvalidOid ); -$Pg::VERSION = '1.6.3'; +$Pg::VERSION = '1.7.0'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -115,25 +115,21 @@ sub doQuery { my $query = shift; my $array_ref = shift; - my ($result, $status, $nfields, $ntuples, $i, $j); + my ($result, $status, $i, $j); - $result = PQexec($conn, $query); - $status = PQresultStatus($result); - return($status) if (2 != $status); - - $nfields = PQnfields($result); - $ntuples = PQntuples($result); - for ($i=0; $i < $ntuples; $i++) { - for ($j=0; $j < $nfields; $j++) { - $$array_ref[$i][$j] = PQgetvalue($result, $i, $j); + 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); + } + } } } - - PQclear($result); - - return 1; + return $status; } + 1; __END__ @@ -192,6 +188,11 @@ 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<undef>. + + =head2 old style All functions and constants are imported into the calling @@ -205,7 +206,6 @@ to be freed by the user: PQsetdb, use PQfinish to free memory. PQexec, use PQclear to free memory. - Pg.pm contains one convenience function: doQuery. It fills a two-dimensional array with the result of your query. Usage: @@ -252,12 +252,14 @@ identification. Before using $conn you should call $conn->status to ensure, that the connection was properly made. Use the methods below to access the contents of the PGconn structure. - $conn = Pg::connectdb("option = value") + $conn = Pg::connectdb("option1=value option2=value ...") Opens a new connection to the backend using connection information in a string. -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. +Possible options are: dbname, host, user, password, authtype, port, tty, options. +The database-name will be converted to lower-case, unless it is surrounded by +double quotes. 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. Use the methods below to access the contents of the PGconn structure. $Option_ref = Pg::conndefaults() diff --git a/src/interfaces/perl5/Pg.xs b/src/interfaces/perl5/Pg.xs index b1594a73e8..80929de033 100644 --- a/src/interfaces/perl5/Pg.xs +++ b/src/interfaces/perl5/Pg.xs @@ -1,6 +1,6 @@ /*------------------------------------------------------- * - * $Id: Pg.xs,v 1.4 1997/09/25 21:14:44 mergl Exp $ + * $Id: Pg.xs,v 1.5 1998/02/20 21:25:36 mergl Exp $ * * Copyright (c) 1997 Edmund Mergl * @@ -9,12 +9,21 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include <string.h> #include "libpq-fe.h" +typedef struct pg_conn *PG_conn; +typedef struct pg_result *PG_result; + +typedef struct pg_results +{ + PGresult *result; + int row; +} PGresults; + +typedef struct pg_results *PG_results; -typedef struct pg_conn* PG_conn; -typedef struct pg_result* PG_result; static double constant(name, arg) @@ -188,6 +197,30 @@ PGconn * PQconnectdb(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++ != '=') { + ; + } + 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); + } + } + } RETVAL = PQconnectdb((const char *)conninfo); OUTPUT: RETVAL @@ -377,11 +410,8 @@ PQcmdStatus(res) char * PQoidStatus(res) PGresult * res - PREINIT: - const char *GAGA; CODE: - GAGA = PQoidStatus(res); - RETVAL = (char *)GAGA; + RETVAL = (char *)PQoidStatus(res); OUTPUT: RETVAL @@ -389,11 +419,8 @@ PQoidStatus(res) char * PQcmdTuples(res) PGresult * res - PREINIT: - const char *GAGA; CODE: - GAGA = PQcmdTuples(res); - RETVAL = (char *)GAGA; + RETVAL = (char *)PQcmdTuples(res); OUTPUT: RETVAL @@ -585,6 +612,30 @@ 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++ != '=') { + ; + } + 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); + } + } + } RETVAL = PQconnectdb((const char *)conninfo); OUTPUT: RETVAL @@ -692,14 +743,18 @@ PQuntrace(conn) PG_conn conn - -PG_result +PG_results PQexec(conn, query) PG_conn conn char * query CODE: - RETVAL = PQexec(conn, query); - if (! RETVAL) { RETVAL = (PGresult *)calloc(1, sizeof(PGresult)); } + RETVAL = (PG_results)calloc(1, sizeof(PGresults)); + if (RETVAL) { + RETVAL->result = PQexec((PGconn *)conn, query); + if (!RETVAL->result) { + RETVAL->result = (PG_result)calloc(1, sizeof(PGresult)); + } + } OUTPUT: RETVAL @@ -826,133 +881,172 @@ lo_export(conn, lobjId, filename) -MODULE = Pg PACKAGE = PG_result PREFIX = PQ +MODULE = Pg PACKAGE = PG_results PREFIX = PQ PROTOTYPES: DISABLE void DESTROY(res) - PG_result res + PG_results res CODE: /* printf("DESTROY result\n"); */ - PQclear(res); - + PQclear(res->result); + Safefree(res); ExecStatusType PQresultStatus(res) - PG_result res - + PG_results res + CODE: + RETVAL = PQresultStatus(res->result); + OUTPUT: + RETVAL int PQntuples(res) - PG_result res + PG_results res + CODE: + RETVAL = PQntuples(res->result); + OUTPUT: + RETVAL int PQnfields(res) - PG_result res + PG_results res + CODE: + RETVAL = PQnfields(res->result); + OUTPUT: + RETVAL char * PQfname(res, field_num) - PG_result res + PG_results res int field_num + CODE: + RETVAL = PQfname(res->result, field_num); + OUTPUT: + RETVAL int PQfnumber(res, field_name) - PG_result res + PG_results res char * field_name + CODE: + RETVAL = PQfnumber(res->result, field_name); + OUTPUT: + RETVAL Oid PQftype(res, field_num) - PG_result res + PG_results res int field_num + CODE: + RETVAL = PQftype(res->result, field_num); + OUTPUT: + RETVAL short PQfsize(res, field_num) - PG_result res + PG_results res int field_num + CODE: + RETVAL = PQfsize(res->result, field_num); + OUTPUT: + RETVAL char * PQcmdStatus(res) - PG_result res + PG_results res + CODE: + RETVAL = PQcmdStatus(res->result); + OUTPUT: + RETVAL char * PQoidStatus(res) - PG_result res - PREINIT: - const char *GAGA; + PG_results res CODE: - GAGA = PQoidStatus(res); - RETVAL = (char *)GAGA; + RETVAL = (char *)PQoidStatus(res->result); OUTPUT: RETVAL char * PQcmdTuples(res) - PG_result res - PREINIT: - const char *GAGA; + PG_results res CODE: - GAGA = PQcmdTuples(res); - RETVAL = (char *)GAGA; + RETVAL = (char *)PQcmdTuples(res->result); OUTPUT: RETVAL char * PQgetvalue(res, tup_num, field_num) - PG_result res + 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_result res + 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_result res + PG_results res int tup_num int field_num + CODE: + RETVAL = PQgetisnull(res->result, tup_num, field_num); + OUTPUT: + RETVAL void PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet) - PGresult * res + PG_results res FILE * fp int fillAlign char * fieldSep int printHeader int quiet CODE: - PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet); + PQdisplayTuples(res->result, fp, fillAlign, (const char *)fieldSep, printHeader, quiet); void PQprintTuples(res, fout, printAttName, terseOutput, width) - PG_result res + PG_results res FILE * fout int printAttName int terseOutput int width + CODE: + PQprintTuples(res->result, fout, printAttName, terseOutput, width); void PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...) FILE * fout - PG_result res + PG_results res bool header bool align bool standard @@ -979,6 +1073,28 @@ PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, ta for (i = 11; i < items; i++) { ps.fieldName[i - 11] = (char *)SvPV(ST(i), na); } - PQprint(fout, res, &ps); + PQprint(fout, res->result, &ps); Safefree(ps.fieldName); + +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(&sv_undef); + } else { + char *val = PQgetvalue(res->result, res->row, col); + PUSHs(sv_2mortal((SV*)newSVpv(val, 0))); + } + ++col; + } + ++res->row; + } + } diff --git a/src/interfaces/perl5/README b/src/interfaces/perl5/README index 04fa867a90..b49ca34fdf 100644 --- a/src/interfaces/perl5/README +++ b/src/interfaces/perl5/README @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: README,v 1.4 1997/09/25 21:14:46 mergl Exp $ +# $Id: README,v 1.5 1998/02/20 21:25:42 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -9,7 +9,7 @@ DESCRIPTION: ------------ -This is version 1.6.3 of pgsql_perl5 (previously called pg95perl5). +This is version 1.7.0 of pgsql_perl5 (previously called pg95perl5). Pgsql_perl5 is an interface between Larry Wall's language perl version 5 and the database PostgreSQL (previously Postgres95). This has been done by using @@ -49,7 +49,7 @@ REQUIREMENTS: ------------- - build, test and install Perl 5 (at least 5.002) - - build, test and install PostgreSQL (at least 6.2) + - build, test and install PostgreSQL (at least 6.3) PLATFORMS: @@ -85,6 +85,9 @@ 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 @@ -98,6 +101,22 @@ If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a 'find .../lib/perl5 -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" <drnoble@engsci.sandia.gov> + +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 <danla@dimensional.com> + + DOCUMENTATION: -------------- @@ -108,6 +127,6 @@ installation to read the documentation. --------------------------------------------------------------------------- - Edmund Mergl <E.Mergl@bawue.de> September 25, 1997 + Edmund Mergl <E.Mergl@bawue.de> February 20, 1998 --------------------------------------------------------------------------- diff --git a/src/interfaces/perl5/test.pl b/src/interfaces/perl5/test.pl index 422ddea10c..d6414bee7f 100644 --- a/src/interfaces/perl5/test.pl +++ b/src/interfaces/perl5/test.pl @@ -2,7 +2,7 @@ #------------------------------------------------------- # -# $Id: test.pl,v 1.5 1997/09/25 21:14:47 mergl Exp $ +# $Id: test.pl,v 1.6 1998/02/20 21:25:45 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -13,7 +13,7 @@ ######################### We start with some black magic to print on failure. -BEGIN { $| = 1; print "1..50\n"; } +BEGIN { $| = 1; print "1..46\n"; } END {print "not ok 1\n" unless $loaded;} use Pg; $loaded = 1; @@ -23,6 +23,7 @@ print "ok 1\n"; $dbmain = 'template1'; $dbname = 'pgperltest'; +$dbhost = 'localhost'; $trace = '/tmp/pgtrace.out'; $cnt = 2; $DEBUG = 0; # set this to 1 for traces @@ -88,7 +89,7 @@ $SIG{PIPE} = sub { print "broken pipe\n" }; ######################### create and connect to test database # 2-4 -$conn = Pg::connectdb("dbname=$dbmain"); +$conn = Pg::connectdb("dbname=$dbmain host=$dbhost"); cmp_eq(PGRES_CONNECTION_OK, $conn->status); # might fail if $dbname doesn't exist => don't check resultStatus @@ -97,7 +98,7 @@ $result = $conn->exec("DROP DATABASE $dbname"); $result = $conn->exec("CREATE DATABASE $dbname"); cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); -$conn = Pg::connectdb("dbname=$dbname"); +$conn = Pg::connectdb("dbname=$dbname host=$dbhost"); cmp_eq(PGRES_CONNECTION_OK, $conn->status); ######################### debug, PQtrace @@ -178,7 +179,7 @@ $result = $conn->exec("END"); cmp_eq(PGRES_COMMAND_OK, $result->resultStatus); ######################### select from person, PQgetvalue -# 35-48 +# 31-44 $result = $conn->exec("SELECT * FROM person"); cmp_eq(PGRES_TUPLES_OK, $result->resultStatus); @@ -200,14 +201,11 @@ for ($k = 0; $k < $result->nfields; $k++) { cmp_eq($k, $fnumber); } -for ($k = 0; $k < $result->ntuples; $k++) { - $string = ""; - for ($l = 0; $l < $result->nfields; $l++) { - $string .= $result->getvalue($k, $l) . " "; - } - $i = $k + 1; - cmp_eq("$i Edmund Mergl ", $string); +$string = ""; +while (@row = $result->fetchrow) { + $string = join(" ", @row); } +cmp_eq("5 Edmund Mergl", $string); ######################### debug, PQuntrace @@ -217,9 +215,9 @@ if ($DEBUG) { } ######################### disconnect and drop test database -# 49-50 +# 45-46 -$conn = Pg::connectdb("dbname=$dbmain"); +$conn = Pg::connectdb("dbname=$dbmain host=$dbhost"); cmp_eq(PGRES_CONNECTION_OK, $conn->status); $result = $conn->exec("DROP DATABASE $dbname"); diff --git a/src/interfaces/perl5/typemap b/src/interfaces/perl5/typemap index ba18b3c4c5..27b440c53a 100644 --- a/src/interfaces/perl5/typemap +++ b/src/interfaces/perl5/typemap @@ -1,6 +1,6 @@ #------------------------------------------------------- # -# $Id: typemap,v 1.4 1997/09/25 21:14:49 mergl Exp $ +# $Id: typemap,v 1.5 1998/02/20 21:25:47 mergl Exp $ # # Copyright (c) 1997 Edmund Mergl # @@ -11,6 +11,7 @@ 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 -- 2.24.1