#
# PostgreSQL top level makefile
#
-# $Header: /cvsroot/pgsql/GNUmakefile.in,v 1.26 2002/08/22 22:43:08 scrappy Exp $
+# $Header: /cvsroot/pgsql/GNUmakefile.in,v 1.27 2002/08/30 13:06:12 scrappy Exp $
#
subdir =
opt_files := src/backend/utils/mb contrib/retep/build.xml \
src/tools src/corba src/data src/tutorial \
$(addprefix src/bin/, pgaccess pgtclsh pg_encoding) \
- $(addprefix src/interfaces/, libpgtcl perl5 python jdbc) \
+ $(addprefix src/interfaces/, libpgtcl python jdbc) \
$(addprefix src/pl/, plperl tcl)
docs_files := doc/postgres.tar.gz doc/src doc/TODO.detail
--without-tk do not build Tk interfaces if Tcl is enabled
--with-tclconfig=DIR tclConfig.sh and tkConfig.sh are in DIR
--with-tkconfig=DIR tkConfig.sh is in DIR
- --with-perl build Perl interface and PL/Perl
--with-python build Python interface module
--with-java build JDBC interface and Java tools
--with-krb4[=DIR] build with Kerberos 4 support [/usr/athena]
fi;
-#
-# Optionally build Perl modules (Pg.pm and PL/Perl)
-#
-echo "$as_me:$LINENO: checking whether to build Perl modules" >&5
-echo $ECHO_N "checking whether to build Perl modules... $ECHO_C" >&6
-
-
-
-# Check whether --with-perl or --without-perl was given.
-if test "${with_perl+set}" = set; then
- withval="$with_perl"
-
- case $withval in
- yes)
- :
- ;;
- no)
- :
- ;;
- *)
- { { echo "$as_me:$LINENO: error: no argument expected for --with-perl option" >&5
-echo "$as_me: error: no argument expected for --with-perl option" >&2;}
- { (exit 1); exit 1; }; }
- ;;
- esac
-
-else
- with_perl=no
-
-fi;
-
-echo "$as_me:$LINENO: result: $with_perl" >&5
-echo "${ECHO_T}$with_perl" >&6
-
-
#
# Optionally build Python interface module
#
{ (exit 1); exit 1; }; }
fi
-# Extract the first word of "perl", so it can be a program name with args.
-set dummy perl; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_path_PERL+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- case $PERL in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PERL="$PERL" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_path_PERL="$as_dir/$ac_word$ac_exec_ext"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
- ;;
-esac
-fi
-PERL=$ac_cv_path_PERL
-
-if test -n "$PERL"; then
- echo "$as_me:$LINENO: result: $PERL" >&5
-echo "${ECHO_T}$PERL" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-if test "$with_perl" = yes; then
-
-echo "$as_me:$LINENO: checking for Perl installsitearch" >&5
-echo $ECHO_N "checking for Perl installsitearch... $ECHO_C" >&6
-perl_installsitearch=`$PERL -MConfig -e 'print $Config{installsitearch}'`
-echo "$as_me:$LINENO: result: $perl_installsitearch" >&5
-echo "${ECHO_T}$perl_installsitearch" >&6
-echo "$as_me:$LINENO: checking for Perl installman3dir" >&5
-echo $ECHO_N "checking for Perl installman3dir... $ECHO_C" >&6
-perl_installman3dir=`$PERL -MConfig -e 'print $Config{installman3dir}'`
-echo "$as_me:$LINENO: result: $perl_installman3dir" >&5
-echo "${ECHO_T}$perl_installman3dir" >&6
-echo "$as_me:$LINENO: checking for Perl archlibexp" >&5
-echo $ECHO_N "checking for Perl archlibexp... $ECHO_C" >&6
-perl_archlibexp=`$PERL -MConfig -e 'print $Config{archlibexp}'`
-echo "$as_me:$LINENO: result: $perl_archlibexp" >&5
-echo "${ECHO_T}$perl_archlibexp" >&6
-echo "$as_me:$LINENO: checking for Perl privlibexp" >&5
-echo $ECHO_N "checking for Perl privlibexp... $ECHO_C" >&6
-perl_privlibexp=`$PERL -MConfig -e 'print $Config{privlibexp}'`
-echo "$as_me:$LINENO: result: $perl_privlibexp" >&5
-echo "${ECHO_T}$perl_privlibexp" >&6
-echo "$as_me:$LINENO: checking for Perl useshrplib" >&5
-echo $ECHO_N "checking for Perl useshrplib... $ECHO_C" >&6
-perl_useshrplib=`$PERL -MConfig -e 'print $Config{useshrplib}'`
-echo "$as_me:$LINENO: result: $perl_useshrplib" >&5
-echo "${ECHO_T}$perl_useshrplib" >&6
-echo "$as_me:$LINENO: checking for Perl man3ext" >&5
-echo $ECHO_N "checking for Perl man3ext... $ECHO_C" >&6
-perl_man3ext=`$PERL -MConfig -e 'print $Config{man3ext}'`
-echo "$as_me:$LINENO: result: $perl_man3ext" >&5
-echo "${ECHO_T}$perl_man3ext" >&6
-
-echo "$as_me:$LINENO: checking for flags to link embedded Perl" >&5
-echo $ECHO_N "checking for flags to link embedded Perl... $ECHO_C" >&6
-pgac_tmp1=`$PERL -MExtUtils::Embed -e ldopts`
-pgac_tmp2=`$PERL -MConfig -e 'print $Config{ccdlflags}'`
-perl_embed_ldflags=`echo X"$pgac_tmp1" | sed "s/^X//;s%$pgac_tmp2%%"`
-echo "$as_me:$LINENO: result: $perl_embed_ldflags" >&5
-echo "${ECHO_T}$perl_embed_ldflags" >&6
-fi
-
if test "$with_python" = yes; then
# Extract the first word of "python", so it can be a program name with args.
set dummy python; ac_word=$2
s,@INCLUDES@,$INCLUDES,;t t
s,@with_tcl@,$with_tcl,;t t
s,@with_tk@,$with_tk,;t t
-s,@with_perl@,$with_perl,;t t
s,@with_python@,$with_python,;t t
s,@ANT@,$ANT,;t t
s,@with_java@,$with_java,;t t
s,@YACC@,$YACC,;t t
s,@YFLAGS@,$YFLAGS,;t t
s,@WISH@,$WISH,;t t
-s,@PERL@,$PERL,;t t
-s,@perl_installsitearch@,$perl_installsitearch,;t t
-s,@perl_installman3dir@,$perl_installman3dir,;t t
-s,@perl_archlibexp@,$perl_archlibexp,;t t
-s,@perl_privlibexp@,$perl_privlibexp,;t t
-s,@perl_useshrplib@,$perl_useshrplib,;t t
-s,@perl_man3ext@,$perl_man3ext,;t t
-s,@perl_embed_ldflags@,$perl_embed_ldflags,;t t
s,@PYTHON@,$PYTHON,;t t
s,@python_version@,$python_version,;t t
s,@python_prefix@,$python_prefix,;t t
dnl Process this file with autoconf to produce a configure script.
-dnl $Header: /cvsroot/pgsql/configure.in,v 1.197 2002/08/22 22:43:08 scrappy Exp $
+dnl $Header: /cvsroot/pgsql/configure.in,v 1.198 2002/08/30 13:06:17 scrappy Exp $
dnl
dnl Developers, please strive to achieve this order:
dnl
PGAC_ARG_REQ(with, tkconfig, [ --with-tkconfig=DIR tkConfig.sh is in DIR])
-#
-# Optionally build Perl modules (Pg.pm and PL/Perl)
-#
-AC_MSG_CHECKING([whether to build Perl modules])
-PGAC_ARG_BOOL(with, perl, no, [ --with-perl build Perl interface and PL/Perl])
-AC_MSG_RESULT([$with_perl])
-AC_SUBST(with_perl)
-
#
# Optionally build Python interface module
#
test -z "$WISH" && AC_MSG_ERROR(['wish' is required for Tk support])
fi
-PGAC_PATH_PERL
-if test "$with_perl" = yes; then
- PGAC_CHECK_PERL_CONFIGS([installsitearch,installman3dir,
- archlibexp,privlibexp,useshrplib,man3ext])
- PGAC_CHECK_PERL_EMBED_LDFLAGS
-fi
-
if test "$with_python" = yes; then
PGAC_PATH_PYTHON
PGAC_CHECK_PYTHON_MODULE_SETUP
#
# Copyright (c) 1994, Regents of the University of California
#
-# $Header: /cvsroot/pgsql/src/interfaces/Makefile,v 1.48 2002/08/30 13:03:09 scrappy Exp $
+# $Header: /cvsroot/pgsql/src/interfaces/Makefile,v 1.49 2002/08/30 13:06:20 scrappy Exp $
#
#-------------------------------------------------------------------------
DIRS := libpq ecpg
-ALLDIRS := $(DIRS) libpgtcl perl5 python jdbc
+ALLDIRS := $(DIRS) libpgtcl python jdbc
ifeq ($(with_tcl), yes)
DIRS += libpgtcl
endif
-ifeq ($(with_perl), yes)
-DIRS += perl5
-endif
-
ifeq ($(with_python), yes)
DIRS += python
endif
+++ /dev/null
-#-------------------------------------------------------
-#
-# $Id: Changes,v 1.9 2000/06/01 03:07:33 momjian Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
-
-Revision history for Perl extension Pg.
-
-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 <brook@trillium.NMSU.Edu>:
- 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
+++ /dev/null
-# $Header: /cvsroot/pgsql/src/interfaces/perl5/Attic/GNUmakefile,v 1.9 2002/08/27 03:57:11 momjian Exp $
-
-subdir = src/interfaces/perl5
-top_builddir = ../../..
-include $(top_builddir)/src/Makefile.global
-
-# This would allow a non-root install of the Perl module, but it's not
-# quite implemented yet.
-ifeq ($(mysterious_feature),yes)
-perl_installsitearch = $(pkglibdir)
-perl_installsitelib = $(pkglibdir)
-perl_installman3dir = $(mandir)/man3
-endif
-
-override CPPFLAGS := -I$(libpq_srcdir) -I$(top_srcdir)/src/include $(CPPFLAGS) -I$(perl_archlibexp)/CORE -I$(top_srcdir)/$(subdir)
-override CFLAGS += $(CFLAGS_SL)
-override CPPFLAGS += -DXS_VERSION=\"$(shell sed -n "s/\$$.*::VERSION.*=.*'\(.*\)';/\1/p" $(srcdir)/Pg.pm)\"
-
-# The code isn't clean with regard to these warnings.
-ifeq ($(GCC),yes)
-override CFLAGS := $(filter-out -Wall -Wmissing-declarations -Wmissing-prototypes, $(CFLAGS))
-endif
-
-POD2MAN = pod2man
-
-
-NAME = Pg
-OBJS = Pg.o
-SO_MAJOR_VERSION = 0
-SO_MINOR_VERSION = 0
-SHLIB_LINK = -L$(libpq_builddir) -lpq
-
-include $(top_srcdir)/src/Makefile.shlib
-
-
-all: all-lib Pg.pm Pg.bs auto/Pg/autosplit.ix Pg.$(perl_man3ext)
-
-all-lib: libpq-all
-
-.PHONY: libpq-all
-libpq-all:
- $(MAKE) -C $(libpq_builddir) all
-
-Pg.c: Pg.xs typemap
- $(PERL) $(perl_privlibexp)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap -typemap $(srcdir)/typemap $(srcdir)/Pg.xs >$@
-
-auto/Pg/autosplit.ix: Pg.pm
- @$(mkinstalldirs) auto
- $(PERL) -MAutoSplit -e 'autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);' $< auto
-
-Pg.bs:
- $(PERL) -MExtUtils::Mkbootstrap -e "Mkbootstrap('Pg', '');"
- touch $@
-
-Pg.$(perl_man3ext): Pg.pm
- $(POD2MAN) --section=$(perl_man3ext) $< > Pg.$(perl_man3ext)
-
-
-# During install, we must guard against the likelihood that we don't
-# have permissions to install into the Perl module library. It's not
-# exactly fun to have to scan the build output, but...
-
-install-warning-msg := { \
-echo ""; \
-echo "*** Skipping the installation of the Perl module for lack"; \
-echo "*** of permissions. To install it, change to the directory"; \
-echo "*** `pwd`,"; \
-echo "*** become the appropriate user, and enter '$(MAKE) install'."; \
-echo ""; }
-
-install: all installdirs
- @if test -w $(DESTDIR)$(perl_installsitearch); then \
- $(INSTALL_DATA) Pg.pm $(DESTDIR)$(perl_installsitearch); \
- $(INSTALL_DATA) Pg.bs $(DESTDIR)$(perl_installsitearch)/auto/Pg; \
- $(INSTALL_SHLIB) $(shlib) $(DESTDIR)$(perl_installsitearch)/auto/Pg/Pg$(DLSUFFIX); \
- $(INSTALL_DATA) auto/Pg/autosplit.ix $(DESTDIR)$(perl_installsitearch)/auto/Pg; \
- $(INSTALL_DATA) Pg.$(perl_man3ext) $(DESTDIR)$(perl_installman3dir); \
- else \
- $(install-warning-msg); \
- fi
-
-installdirs:
- -$(mkinstalldirs) $(DESTDIR)$(perl_installsitearch)/auto/Pg $(DESTDIR)$(perl_installman3dir)
-
-uninstall:
- rm -f $(addprefix $(DESTDIR)$(perl_installsitearch)/, Pg.pm auto/Pg/Pg.bs auto/Pg/Pg$(DLSUFFIX) auto/Pg/autosplit.ix) $(DESTDIR)$(perl_installman3dir)/Pg.$(perl_man3ext)
-
-
-clean distclean maintainer-clean: clean-lib
- rm -f $(OBJS) Pg.c Pg.bs Pg.$(perl_man3ext)
- rm -rf auto
+++ /dev/null
-Changes
-MANIFEST
-Makefile.PL
-Pg.pm
-Pg.xs
-README
-examples/ApachePg.pl
-examples/example.newstyle
-examples/example.oldstyle
-ppport.h
-test.pl
-typemap
+++ /dev/null
-#-------------------------------------------------------
-#
-# $Id: Makefile.PL,v 1.18 2001/08/26 22:28:04 petere Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
-
-use ExtUtils::MakeMaker;
-use Config;
-use strict;
-
-my $srcdir=$ENV{SRCDIR};
-
-my %opts;
-
-%opts = (
- NAME => 'Pg',
- VERSION_FROM => "Pg.pm",
- OBJECT => "Pg\$(OBJ_EXT)",
-# explicit mappings required for VPATH builds
- PM => { "$srcdir/Pg.pm" => '$(INST_LIBDIR)/Pg.pm' },
- MAN3PODS => { "$srcdir/Pg.pm" => '$(INST_MAN3DIR)/Pg.$(MAN3EXT)' },
-);
-
-
-if (! -d $ENV{POSTGRES_LIB} || ! -d $ENV{POSTGRES_INCLUDE}) {
-
- # Check that we actually are inside the Postgres source tree
- if (! -d "../libpq") {
- die
-"To install Pg separately from the Postgres distribution, you must
-set environment variables POSTGRES_LIB and POSTGRES_INCLUDE to point
-to where Postgres is installed (often /usr/local/pgsql/{lib,include}).\n";
- }
-
-} else {
-
- # Setup for standalone installation when Postgres already is installed.
-
- %opts = (
- %opts,
- INC => "-I$ENV{POSTGRES_INCLUDE}",
- LIBS => ["-L$ENV{POSTGRES_LIB} -lpq"],
- );
-}
-
-
-WriteMakefile(%opts);
-
-
-
-# Put the proper runpath into the shared object.
-
-sub MY::dynamic_lib {
- package MY;
- my $inherited= shift->SUPER::dynamic_lib(@_);
-
- my $pglibdir = $ENV{PGLIBDIR};
- return $inherited if $pglibdir eq '';
-
- # Remove any misguided attempts to set the runpath.
- $inherited =~ s/LD_RUN_PATH=\"\$\(LD_RUN_PATH\)\" //g;
- $inherited =~ s/-R\S*//g;
- $inherited =~ s/-rpath\S*//g;
-
- my $rpath;
- # Note that this could be different from what Makefile.port has
- # because a different compiler/linker could be used.
- SWITCH: for ($Config::Config{'osname'}) {
- /hpux/ and $rpath = "+b $pglibdir", last;
- /freebsd/ and $rpath = "-R$pglibdir", last;
- /irix/ and $rpath = "-R$pglibdir", last;
- /linux/ and $rpath = "-Wl,-rpath,$pglibdir", last;
- /netbsd/ and $rpath = "-R$pglibdir", last;
- /openbsd/ and $rpath = "-R$pglibdir", last;
- /solaris/ and $rpath = "-R$pglibdir", last;
- /svr5/ and $rpath = "-R$pglibdir", last;
- }
-
- $inherited=~ s,OTHERLDFLAGS =,OTHERLDFLAGS = $rpath , if defined $rpath;
- $inherited;
-}
-
-
-
-# VPATH-aware version of this rule
-sub MY::xs_c {
- my($self) = shift;
- return '' unless $self->needs_linking();
- '
-.xs.c:
- $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $< > $@
-';
-}
-
-# Delete this rule. We can use the above one.
-sub MY::xs_o {
- '';
-}
-
-
-# This rule tries to rebuild the Makefile from Makefile.PL. We can do
-# that better ourselves.
-sub MY::makefile {
- '';
-}
+++ /dev/null
-#-------------------------------------------------------
-#
-# $Id: Pg.pm,v 1.11 2002/08/15 02:56:19 momjian 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.002;
-
-@ISA = qw(Exporter DynaLoader);
-
-# Items to export into callers namespace by default.
-@EXPORT = qw(
- PQconnectdb
- PQsetdbLogin
- PQsetdb
- PQconndefaults
- PQfinish
- PQreset
- PQrequestCancel
- PQdb
- PQuser
- PQpass
- PQhost
- PQport
- PQtty
- PQoptions
- PQstatus
- PQerrorMessage
- PQsocket
- PQbackendPID
- PQtrace
- PQuntrace
- PQexec
- PQnotifies
- PQsendQuery
- PQgetResult
- PQisBusy
- PQconsumeInput
- PQgetline
- PQputline
- PQgetlineAsync
- PQputnbytes
- PQendcopy
- PQmakeEmptyPGresult
- PQresultStatus
- PQntuples
- PQnfields
- PQbinaryTuples
- PQfname
- PQfnumber
- PQftype
- PQfsize
- PQfmod
- PQcmdStatus
- PQoidStatus
- PQcmdTuples
- PQgetvalue
- PQgetlength
- PQgetisnull
- PQclear
- PQprint
- PQdisplayTuples
- PQprintTuples
- PQlo_open
- PQlo_close
- PQlo_read
- PQlo_write
- PQlo_lseek
- PQlo_creat
- PQlo_tell
- PQlo_unlink
- PQlo_import
- PQlo_export
- 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 = '1.9.0';
-
-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);
-
- 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
-
-new style:
-
- use Pg;
- $conn = Pg::connectdb("dbname=template1");
- $result = $conn->exec("create database pgtest");
-
-
-old style (depreciated):
-
- use Pg;
- $conn = PQsetdb('', '', '', '', template1);
- $result = PQexec($conn, "create database pgtest");
- PQclear($result);
- PQfinish($conn);
-
-
-=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. 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.
-
-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 '$'. The new style uses class packages and
-might be more familiar for C++-programmers.
-
-
-=head1 GUIDELINES
-
-=head2 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.
-
-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
-packages name-space. In order to to get a uniform naming,
-all functions start with 'PQ' (e.g. PQlo_open) and all
-constants start with 'PGRES_' (e.g. PGRES_CONNECTION_OK).
-
-There are two functions, which allocate memory, that has
-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:
-
- 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 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.
-
-
-=head1 FUNCTIONS
-
-The functions have been divided into three sections:
-Connection, Result, Large Objects. For details please
-read L<libpq>.
-
-
-=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.
-
- $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.
-
- PQfinish($conn)
-
-Old style only !
-Closes the connection to the backend and frees the connection data 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. 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 $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.
-
- PQclear($result)
-
-Old style only !
-Frees all memory of the given result.
-
- $res->fetchrow
-
-New style only !
-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<undef>.
-
- $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. In order to get a consistent naming, all function
-names have been prepended with 'PQ' (old style only).
-
- $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 <E.Mergl@bawue.de>
-
-=head1 SEE ALSO
-
-L<libpq>, L<large_objects>
-
-=cut
+++ /dev/null
-/*-------------------------------------------------------
- *
- * $Id: Pg.xs,v 1.17 2001/09/10 04:19:19 momjian Exp $ with patch for NULs
- *
- * Copyright (c) 1997, 1998 Edmund Mergl
- *
- *-------------------------------------------------------*/
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ppport.h"
-#include <string.h>
-#include <stdio.h>
-#include <fcntl.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;
-
-
-static double
-constant(name, arg)
-char *name;
-int arg; {
- errno = 0;
- switch (*name) {
- case 'A':
- break;
- case 'B':
- break;
- case 'C':
- break;
- case 'D':
- break;
- case 'E':
- break;
- case 'F':
- break;
- case 'G':
- break;
- case 'H':
- break;
- case 'I':
- break;
- case 'J':
- break;
- case 'K':
- break;
- case 'L':
- break;
- case 'M':
- break;
- case 'N':
- break;
- case 'O':
- break;
- 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;
- case 'Q':
- break;
- case 'R':
- break;
- case 'S':
- break;
- case 'T':
- break;
- case 'U':
- break;
- case 'V':
- break;
- case 'W':
- break;
- case 'X':
- break;
- case 'Y':
- break;
- case 'Z':
- break;
- case 'a':
- break;
- case 'b':
- break;
- case 'c':
- break;
- case 'd':
- break;
- case 'e':
- break;
- case 'f':
- break;
- case 'g':
- break;
- case 'h':
- break;
- case 'i':
- break;
- case 'j':
- break;
- case 'k':
- break;
- case 'l':
- break;
- case 'm':
- break;
- case 'n':
- break;
- case 'o':
- break;
- case 'p':
- break;
- case 'q':
- break;
- case 'r':
- break;
- case 's':
- break;
- case 't':
- break;
- case 'u':
- break;
- case 'v':
- break;
- case 'w':
- break;
- case 'x':
- break;
- case 'y':
- break;
- case 'z':
- 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
-
-
-PGconn *
-PQconnectdb(conninfo)
- char * conninfo
- CODE:
- /* convert dbname to lower case if not surrounded by double quotes */
- char *ptr = strstr(conninfo, "dbname");
- if (ptr) {
- while (*ptr && *ptr != '=') {
- ptr++;
- }
- ptr++;
- while (*ptr == ' ' || *ptr == '\t') {
- ptr++;
- }
- if (*ptr == '"') {
- *ptr++ = ' ';
- while (*ptr && *ptr != '"') {
- ptr++;
- }
- if (*ptr == '"') {
- *ptr++ = ' ';
- }
- } else {
- while (*ptr && *ptr != ' ' && *ptr != '\t') {
- *ptr = tolower((unsigned char) *ptr);
- ptr++;
- }
- }
- }
- RETVAL = PQconnectdb((const char *)conninfo);
- OUTPUT:
- RETVAL
-
-
-PGconn *
-PQsetdbLogin(pghost, pgport, pgoptions, pgtty, dbname, login, pwd)
- char * pghost
- char * pgport
- char * pgoptions
- char * pgtty
- char * dbname
- char * login
- char * pwd
-
-
-PGconn *
-PQsetdb(pghost, pgport, pgoptions, pgtty, dbname)
- char * pghost
- char * pgport
- char * pgoptions
- char * pgtty
- char * dbname
-
-
-HV *
-PQconndefaults()
- 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
-
-
-void
-PQfinish(conn)
- PGconn * conn
-
-
-void
-PQreset(conn)
- PGconn * conn
-
-
-int
-PQrequestCancel(conn)
- PGconn * conn
-
-char *
-PQdb(conn)
- PGconn * conn
-
-
-char *
-PQuser(conn)
- PGconn * conn
-
-
-char *
-PQpass(conn)
- PGconn * conn
-
-
-char *
-PQhost(conn)
- PGconn * conn
-
-
-char *
-PQport(conn)
- PGconn * conn
-
-
-char *
-PQtty(conn)
- PGconn * conn
-
-
-char *
-PQoptions(conn)
- PGconn * conn
-
-
-ConnStatusType
-PQstatus(conn)
- PGconn * conn
-
-
-char *
-PQerrorMessage(conn)
- PGconn * conn
-
-
-int
-PQsocket(conn)
- PGconn * conn
-
-
-int
-PQbackendPID(conn)
- PGconn * conn
-
-
-void
-PQtrace(conn, debug_port)
- PGconn * conn
- FILE * debug_port
-
-
-void
-PQuntrace(conn)
- PGconn * conn
-
-
-
-PGresult *
-PQexec(conn, query)
- PGconn * conn
- char * query
- CODE:
- RETVAL = PQexec(conn, query);
- if (! RETVAL) {
- RETVAL = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR);
- }
- OUTPUT:
- RETVAL
-
-
-void
-PQnotifies(conn)
- PGconn * 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)));
- free(notify);
- }
-
-
-int
-PQsendQuery(conn, query)
- PGconn * conn
- char * query
-
-
-PGresult *
-PQgetResult(conn)
- PGconn * conn
- CODE:
- RETVAL = PQgetResult(conn);
- if (! RETVAL) {
- RETVAL = PQmakeEmptyPGresult(conn, PGRES_FATAL_ERROR);
- }
- OUTPUT:
- RETVAL
-
-
-int
-PQisBusy(conn)
- PGconn * conn
-
-
-int
-PQconsumeInput(conn)
- PGconn * conn
-
-
-int
-PQgetline(conn, string, length)
- PREINIT:
- SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
- INPUT:
- PGconn * conn
- int length
- char * string = sv_grow(bufsv, length);
- CODE:
- RETVAL = PQgetline(conn, string, length);
- OUTPUT:
- RETVAL
- string
-
-
-int
-PQputline(conn, string)
- PGconn * conn
- char * string
-
-
-int
-PQgetlineAsync(conn, buffer, bufsize)
- PREINIT:
- SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
- INPUT:
- PGconn * conn
- int bufsize
- char * buffer = sv_grow(bufsv, bufsize);
- CODE:
- RETVAL = PQgetlineAsync(conn, buffer, bufsize);
- OUTPUT:
- RETVAL
- buffer
-
-
-int
-PQputnbytes(conn, buffer, nbytes)
- PGconn * conn
- char * buffer
- int nbytes
-
-
-int
-PQendcopy(conn)
- PGconn * conn
-
-
-PGresult *
-PQmakeEmptyPGresult(conn, status)
- PGconn * conn
- ExecStatusType status
-
-
-ExecStatusType
-PQresultStatus(res)
- PGresult * res
-
-
-int
-PQntuples(res)
- PGresult * res
-
-
-int
-PQnfields(res)
- PGresult * res
-
-
-int
-PQbinaryTuples(res)
- PGresult * res
-
-
-char *
-PQfname(res, field_num)
- PGresult * res
- int field_num
-
-
-int
-PQfnumber(res, field_name)
- PGresult * res
- char * field_name
-
-
-Oid
-PQftype(res, field_num)
- PGresult * res
- int field_num
-
-
-short
-PQfsize(res, field_num)
- PGresult * res
- int field_num
-
-
-int
-PQfmod(res, field_num)
- PGresult * res
- int field_num
-
-
-char *
-PQcmdStatus(res)
- PGresult * res
-
-
-char *
-PQoidStatus(res)
- PGresult * res
- CODE:
- RETVAL = (char *)PQoidStatus(res);
- OUTPUT:
- RETVAL
-
-
-char *
-PQcmdTuples(res)
- PGresult * res
- CODE:
- RETVAL = (char *)PQcmdTuples(res);
- OUTPUT:
- RETVAL
-
-
-char *
-PQgetvalue(res, tup_num, field_num)
- PGresult * res
- int tup_num
- int field_num
-
-
-int
-PQgetlength(res, tup_num, field_num)
- PGresult * res
- int tup_num
- int field_num
-
-
-int
-PQgetisnull(res, tup_num, field_num)
- PGresult * res
- int tup_num
- int field_num
-
-
-void
-PQclear(res)
- PGresult * res
-
-
-void
-PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, tableOpt, caption, ...)
- FILE * fout
- PGresult * 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, &ps);
- Safefree(ps.fieldName);
-
-
-void
-PQdisplayTuples(res, fp, fillAlign, fieldSep, printHeader, quiet)
- PGresult * res
- FILE * fp
- int fillAlign
- char * fieldSep
- int printHeader
- int quiet
- CODE:
- PQdisplayTuples(res, fp, fillAlign, (const char *)fieldSep, printHeader, quiet);
-
-
-void
-PQprintTuples(res, fout, printAttName, terseOutput, width)
- PGresult * res
- FILE * fout
- int printAttName
- int terseOutput
- int width
-
-
-int
-lo_open(conn, lobjId, mode)
- PGconn * conn
- Oid lobjId
- int mode
- ALIAS:
- PQlo_open = 1
-
-
-int
-lo_close(conn, fd)
- PGconn * conn
- int fd
- ALIAS:
- PQlo_close = 1
-
-
-int
-lo_read(conn, fd, buf, len)
- ALIAS:
- PQlo_read = 1
- PREINIT:
- SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
- INPUT:
- PGconn * conn
- int fd
- int len
- char * buf = sv_grow(bufsv, len + 1);
- CODE:
- RETVAL = lo_read(conn, fd, buf, len);
- if (RETVAL > 0) {
- SvCUR_set(bufsv, RETVAL);
- *SvEND(bufsv) = '\0';
- }
- OUTPUT:
- RETVAL
- buf sv_setpvn((SV*)ST(2), buf, RETVAL); /* to handle NULs */
-
-int
-lo_write(conn, fd, buf, len)
- PGconn * conn
- int fd
- char * buf
- int len
- ALIAS:
- PQlo_write = 1
-
-
-int
-lo_lseek(conn, fd, offset, whence)
- PGconn * conn
- int fd
- int offset
- int whence
- ALIAS:
- PQlo_lseek = 1
-
-
-Oid
-lo_creat(conn, mode)
- PGconn * conn
- int mode
- ALIAS:
- PQlo_creat = 1
-
-
-int
-lo_tell(conn, fd)
- PGconn * conn
- int fd
- ALIAS:
- PQlo_tell = 1
-
-
-int
-lo_unlink(conn, lobjId)
- PGconn * conn
- Oid lobjId
- ALIAS:
- PQlo_unlink = 1
-
-
-Oid
-lo_import(conn, filename)
- PGconn * conn
- char * filename
- ALIAS:
- PQlo_import = 1
-
-
-int
-lo_export(conn, lobjId, filename)
- PGconn * conn
- Oid lobjId
- char * filename
- ALIAS:
- PQlo_export = 1
-
-
-
-
-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((unsigned char) *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
-
-
-
-
-
-
-
-MODULE = Pg PACKAGE = PG_conn PREFIX = PQ
-
-PROTOTYPES: DISABLE
-
-
-void
-DESTROY(conn)
- PG_conn conn
- CODE:
- /* printf("DESTROY connection\n"); */
- 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
-
-
-PG_results
-PQexec(conn, query)
- PG_conn conn
- char * query
- CODE:
- RETVAL = (PG_results)calloc(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)));
- free(notify);
- }
-
-
-int
-PQsendQuery(conn, query)
- PG_conn conn
- char * query
-
-
-PG_results
-PQgetResult(conn)
- PG_conn conn
- CODE:
- RETVAL = (PG_results)calloc(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
-PQendcopy(conn)
- PG_conn conn
-
-
-PG_results
-PQmakeEmptyPGresult(conn, status)
- PG_conn conn
- ExecStatusType status
- CODE:
- RETVAL = (PG_results)calloc(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
-
-
-int
-lo_read(conn, fd, buf, len)
- PREINIT:
- SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
- INPUT:
- PG_conn conn
- int fd
- int len
- char * buf = sv_grow(bufsv, len + 1);
- CODE:
- RETVAL = lo_read(conn, fd, buf, len);
- if (RETVAL > 0) {
- SvCUR_set(bufsv, RETVAL);
- *SvEND(bufsv) = '\0';
- }
- OUTPUT:
- RETVAL
- buf sv_setpvn((SV*)ST(2), buf, RETVAL); /* to handle NULs */
-
-
-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"); */
- PQclear(res->result);
- Safefree(res);
-
-ExecStatusType
-PQresultStatus(res)
- PG_results res
- CODE:
- RETVAL = PQresultStatus(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);
+++ /dev/null
-#-------------------------------------------------------
-#
-# $Id: README,v 1.8 1998/09/27 19:12:24 mergl Exp $
-#
-# Copyright (c) 1997, 1998 Edmund Mergl
-#
-#-------------------------------------------------------
-
-DESCRIPTION:
-------------
-
-This is version 1.8.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
-the Perl5 application programming interface for C extensions which calls the
-Postgres programmer's interface LIBPQ. Pgsql_perl5 tries to implement the LIBPQ-
-interface as close as possible.
-
-You have the choice between two different interfaces: the old C-style like
-interface and a new one, using a more Perl-ish like style. The old style
-has the benefit, that existing Libpq applications can easily be ported to
-perl. The new style uses class packages and might be more familiar for C++-
-programmers.
-
-NOTE: it is planned to drop the old C-style interface in the next major release
- of PostgreSQL.
-
-
-
-COPYRIGHT:
-----------
-
-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 <pgsql-interfaces@postgresql.org>
-
-Please include the output of perl -v,
- and perl -V,
- the version of PostgreSQL,
- and the version of pgsql_perl5
-in your bug-report.
-
-
-REQUIREMENTS:
--------------
-
- - build, test and install Perl5 (at least 5.002)
- - build, test and install PostgreSQL (at least 6.4)
-
-
-PLATFORMS:
-----------
-
- This release of pgsql_perl5 has been developed using Linux 2.0 with
- dynamic loading for the perl extensions. Let me know, if there are
- any problems with other platforms.
-
-
-INSTALLATION:
--------------
-
-Since the perl5 interface is always contained in the source tree of PostgreSQL,
-it is usually build together with PostgreSQL itself. This can be obtained by
-adding the option '--with-perl' to the configure command.
-
-In case you need to build the perl interface stand alone, you need to set the
-environment variable POSTGRES_HOME, pointing to the PostgreSQL home-directory.
-Also PostgreSQL needs to be installed having the include files in
-$POSTGRES_HOME/include and the libs in $POSTGRES_HOME/lib. Then you have to
-build the module as any standard perl-module with the following commands:
-
-1. perl Makefile.PL
-2. make
-3. make test
-4. make install
-
-( 1. to 3. 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", 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:
---------------
-
-Detailed documentation can be found in Pg.pm. Use 'perldoc Pg' after
-installation to read the documentation.
-
-
----------------------------------------------------------------------------
-
- Edmund Mergl <E.Mergl@bawue.de> September 27, 1998
-
----------------------------------------------------------------------------
+++ /dev/null
-#!/usr/bin/perl
-
-# $Id: ApachePg.pl,v 1.2 2001/09/04 11:41:04 petere Exp $
-
-# demo script, tested with:
-# - PostgreSQL-6.4
-# - apache_1.3.1
-# - mod_perl-1.15
-# - perl5.005_02
-
-use CGI;
-use Pg;
-use strict;
-
-my $query = new CGI;
-
-print $query->header,
- $query->start_html(-title=>'A Simple Example'),
- $query->startform,
- "<CENTER><H3>Testing Module Pg</H3></CENTER>",
- "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
- "<TR><TD>Enter conninfo string: </TD>",
- "<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1'), "</TD>",
- "</TR>",
- "<TR><TD>Enter select command: </TD>",
- "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
- "</TR>",
- "</TABLE></CENTER><P>",
- "<CENTER>", $query->submit(-value=>'Submit'), "</CENTER>",
- $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 "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
- my @row;
- while (@row = $result->fetchrow) {
- print "<TR><TD>", join("</TD><TD>", @row), "</TD></TR>";
- }
- print "</TABLE></CENTER><P>\n";
- } else {
- print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
- }
- } else {
- print "<CENTER><H2>", $conn->errorMessage, "</H2></CENTER>\n";
- }
-}
-
-print $query->end_html;
-
+++ /dev/null
-#!/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
+++ /dev/null
-#!/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
+++ /dev/null
-
-#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 <kjahds@kjahds.com>, 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 (<DATA>) {
- $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 (<IN>) { $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 (<DIFF>) { 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_ */
+++ /dev/null
-#!/usr/bin/perl -w
-
-# $Id: test.pl,v 1.14 2001/09/04 11:41:04 petere 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->errorMessage;
-
-$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 =~ 'Database "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;
-( "CREATE" eq $cmd )
- 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
-
-$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
+++ /dev/null
-#-------------------------------------------------------
-#
-# $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
projects / postgresql / commitdiff