perl5 interface moved to gborg
This commit is contained in:
Marc G. Fournier
parent
c411f51dfb
commit
9a0b4d7f84
@ -1,7 +1,7 @@
|
|||||||
#
|
#
|
||||||
# PostgreSQL top level makefile
|
# 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 =
|
subdir =
|
||||||
@ -72,7 +72,7 @@ $(distdir).tar: distdir
|
|||||||
opt_files := src/backend/utils/mb contrib/retep/build.xml \
|
opt_files := src/backend/utils/mb contrib/retep/build.xml \
|
||||||
src/tools src/corba src/data src/tutorial \
|
src/tools src/corba src/data src/tutorial \
|
||||||
$(addprefix src/bin/, pgaccess pgtclsh pg_encoding) \
|
$(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)
|
$(addprefix src/pl/, plperl tcl)
|
||||||
|
|
||||||
docs_files := doc/postgres.tar.gz doc/src doc/TODO.detail
|
docs_files := doc/postgres.tar.gz doc/src doc/TODO.detail
|
||||||
|
|||||||
126
configure
vendored
126
configure
vendored
@ -860,7 +860,6 @@ Optional Packages:
|
|||||||
--without-tk do not build Tk interfaces if Tcl is enabled
|
--without-tk do not build Tk interfaces if Tcl is enabled
|
||||||
--with-tclconfig=DIR tclConfig.sh and tkConfig.sh are in DIR
|
--with-tclconfig=DIR tclConfig.sh and tkConfig.sh are in DIR
|
||||||
--with-tkconfig=DIR tkConfig.sh is 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-python build Python interface module
|
||||||
--with-java build JDBC interface and Java tools
|
--with-java build JDBC interface and Java tools
|
||||||
--with-krb4[=DIR] build with Kerberos 4 support [/usr/athena]
|
--with-krb4[=DIR] build with Kerberos 4 support [/usr/athena]
|
||||||
@ -2945,41 +2944,6 @@ echo "$as_me: error: argument required for --with-tkconfig option" >&2;}
|
|||||||
fi;
|
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
|
# Optionally build Python interface module
|
||||||
#
|
#
|
||||||
@ -4156,87 +4120,6 @@ echo "$as_me: error: 'wish' is required for Tk support" >&2;}
|
|||||||
{ (exit 1); exit 1; }; }
|
{ (exit 1); exit 1; }; }
|
||||||
fi
|
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
|
if test "$with_python" = yes; then
|
||||||
# Extract the first word of "python", so it can be a program name with args.
|
# Extract the first word of "python", so it can be a program name with args.
|
||||||
set dummy python; ac_word=$2
|
set dummy python; ac_word=$2
|
||||||
@ -16290,7 +16173,6 @@ s,@autodepend@,$autodepend,;t t
|
|||||||
s,@INCLUDES@,$INCLUDES,;t t
|
s,@INCLUDES@,$INCLUDES,;t t
|
||||||
s,@with_tcl@,$with_tcl,;t t
|
s,@with_tcl@,$with_tcl,;t t
|
||||||
s,@with_tk@,$with_tk,;t t
|
s,@with_tk@,$with_tk,;t t
|
||||||
s,@with_perl@,$with_perl,;t t
|
|
||||||
s,@with_python@,$with_python,;t t
|
s,@with_python@,$with_python,;t t
|
||||||
s,@ANT@,$ANT,;t t
|
s,@ANT@,$ANT,;t t
|
||||||
s,@with_java@,$with_java,;t t
|
s,@with_java@,$with_java,;t t
|
||||||
@ -16318,14 +16200,6 @@ s,@STRIP_SHARED_LIB@,$STRIP_SHARED_LIB,;t t
|
|||||||
s,@YACC@,$YACC,;t t
|
s,@YACC@,$YACC,;t t
|
||||||
s,@YFLAGS@,$YFLAGS,;t t
|
s,@YFLAGS@,$YFLAGS,;t t
|
||||||
s,@WISH@,$WISH,;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@,$PYTHON,;t t
|
||||||
s,@python_version@,$python_version,;t t
|
s,@python_version@,$python_version,;t t
|
||||||
s,@python_prefix@,$python_prefix,;t t
|
s,@python_prefix@,$python_prefix,;t t
|
||||||
|
|||||||
17
configure.in
17
configure.in
@ -1,5 +1,5 @@
|
|||||||
dnl Process this file with autoconf to produce a configure script.
|
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
|
||||||
dnl Developers, please strive to achieve this order:
|
dnl Developers, please strive to achieve this order:
|
||||||
dnl
|
dnl
|
||||||
@ -356,14 +356,6 @@ PGAC_ARG_REQ(with, tclconfig, [ --with-tclconfig=DIR tclConfig.sh and tkConf
|
|||||||
|
|
||||||
PGAC_ARG_REQ(with, tkconfig, [ --with-tkconfig=DIR tkConfig.sh is in DIR])
|
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
|
# Optionally build Python interface module
|
||||||
#
|
#
|
||||||
@ -579,13 +571,6 @@ if test "$with_tk" = yes; then
|
|||||||
test -z "$WISH" && AC_MSG_ERROR(['wish' is required for Tk support])
|
test -z "$WISH" && AC_MSG_ERROR(['wish' is required for Tk support])
|
||||||
fi
|
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
|
if test "$with_python" = yes; then
|
||||||
PGAC_PATH_PYTHON
|
PGAC_PATH_PYTHON
|
||||||
PGAC_CHECK_PYTHON_MODULE_SETUP
|
PGAC_CHECK_PYTHON_MODULE_SETUP
|
||||||
|
|||||||
@ -4,7 +4,7 @@
|
|||||||
#
|
#
|
||||||
# Copyright (c) 1994, Regents of the University of California
|
# 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 $
|
||||||
#
|
#
|
||||||
#-------------------------------------------------------------------------
|
#-------------------------------------------------------------------------
|
||||||
|
|
||||||
@ -14,16 +14,12 @@ include $(top_builddir)/src/Makefile.global
|
|||||||
|
|
||||||
DIRS := libpq ecpg
|
DIRS := libpq ecpg
|
||||||
|
|
||||||
ALLDIRS := $(DIRS) libpgtcl perl5 python jdbc
|
ALLDIRS := $(DIRS) libpgtcl python jdbc
|
||||||
|
|
||||||
ifeq ($(with_tcl), yes)
|
ifeq ($(with_tcl), yes)
|
||||||
DIRS += libpgtcl
|
DIRS += libpgtcl
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ifeq ($(with_perl), yes)
|
|
||||||
DIRS += perl5
|
|
||||||
endif
|
|
||||||
|
|
||||||
ifeq ($(with_python), yes)
|
ifeq ($(with_python), yes)
|
||||||
DIRS += python
|
DIRS += python
|
||||||
endif
|
endif
|
||||||
|
|||||||
@ -1,126 +0,0 @@
|
|||||||
#-------------------------------------------------------
|
|
||||||
#
|
|
||||||
# $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
|
|
||||||
@ -1,91 +0,0 @@
|
|||||||
# $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
|
|
||||||
@ -1,12 +0,0 @@
|
|||||||
Changes
|
|
||||||
MANIFEST
|
|
||||||
Makefile.PL
|
|
||||||
Pg.pm
|
|
||||||
Pg.xs
|
|
||||||
README
|
|
||||||
examples/ApachePg.pl
|
|
||||||
examples/example.newstyle
|
|
||||||
examples/example.oldstyle
|
|
||||||
ppport.h
|
|
||||||
test.pl
|
|
||||||
typemap
|
|
||||||
@ -1,107 +0,0 @@
|
|||||||
#-------------------------------------------------------
|
|
||||||
#
|
|
||||||
# $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 {
|
|
||||||
'';
|
|
||||||
}
|
|
||||||
@ -1,657 +0,0 @@
|
|||||||
#-------------------------------------------------------
|
|
||||||
#
|
|
||||||
# $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
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -1,137 +0,0 @@
|
|||||||
#-------------------------------------------------------
|
|
||||||
#
|
|
||||||
# $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
|
|
||||||
|
|
||||||
---------------------------------------------------------------------------
|
|
||||||
@ -1,55 +0,0 @@
|
|||||||
#!/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;
|
|
||||||
|
|
||||||
@ -1,274 +0,0 @@
|
|||||||
#!/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
|
|
||||||
@ -1,294 +0,0 @@
|
|||||||
#!/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
|
|
||||||
@ -1,289 +0,0 @@
|
|||||||
|
|
||||||
#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_ */
|
|
||||||
@ -1,275 +0,0 @@
|
|||||||
#!/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
|
|
||||||
@ -1,18 +0,0 @@
|
|||||||
#-------------------------------------------------------
|
|
||||||
#
|
|
||||||
# $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
|
|
||||||
Loading…
x
Reference in New Issue
Block a user