adding DBD::Pg and DBIx::DBSchema for 5.005. argh freebsd and solaris!
authorivan <ivan>
Thu, 29 Apr 2004 09:23:31 +0000 (09:23 +0000)
committerivan <ivan>
Thu, 29 Apr 2004 09:23:31 +0000 (09:23 +0000)
57 files changed:
install/5.005/DBD-Pg-1.22-fixvercmp/Changes [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/MANIFEST [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/Makefile.PL [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/Pg.h [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/Pg.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/README [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/README.win32 [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/dbd-pg.pod [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.h [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl [new file with mode: 0755]
install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/00basic.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/01connect.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/01constants.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/01setup.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/02prepare.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/03bind.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/04execute.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/05fetch.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/06disconnect.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/07reuse.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/08txn.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/09autocommit.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/11quoting.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/12placeholders.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/13pgtype.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/99cleanup.t [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm [new file with mode: 0644]
install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm [new file with mode: 0755]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/README [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t [new file with mode: 0644]
install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t [new file with mode: 0644]

diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Changes b/install/5.005/DBD-Pg-1.22-fixvercmp/Changes
new file mode 100644 (file)
index 0000000..c345628
--- /dev/null
@@ -0,0 +1,352 @@
+1.22  Wed Mar 26 22:33:44 EST 2003
+       - Win32 compile fix for snprintf [Joe Spears]
+       - Fix memory allocation problem in bytea escaping [Barrie Slaymaker]
+       - Add utf8 support [Dominic Mitchell <dom@semantico.com>]
+       - Transform Perl arrays into PostgreSQL arrays [Alexey Slynko]
+       - Fix for foreign_key_info() [Keith Keller]
+       - Fix PG_TEXT parameter binding
+       - Doc cleanups [turnstep]
+       - Fix warning from func($table, 'table_attributes') [turnstep]
+       - Added suppport for schemas [turnstep]
+       - Fix binary to a bytea field conversion [Chris Dunlop <chris@onthe.net.au>]
+1.21  Sun Jan 12 21:00:44 EST 2003
+       - System tables no longer returned by tables(). [Dave Rolsky]
+       - Fix table_attributes to handle removal of pg_relcheck in 7.3,
+       from Ian Barwick <barwick@gmx.net>
+       - Properly reset transaction status after failed transaction when
+        autocommit is off.  Properly report transaction failure message.
+        Kai <kai@xs4all.nl>
+       - New pg_bool_tf database handle that when set to true booleans are
+        returned as 't'/'f' rather than 1/0.
+
+1.20  Wed Nov 27 16:19:26 2002
+       - Maintenance transferred to GBorg,
+        http://gborg.postgresql.org/project/dbdpg/projdisplay.php. Incremented
+        version number to reflect new management. [Bruce Momjian]
+       - README cleaned up. [Bruce Momjian]
+       - Added t/15funct.t, a series of tests that determine if the meta data
+        is working. [Thomas Lowery]
+       - Added implementations of column_info() and table_info(), and
+        primary_key_info(). [Thomas Lowery]
+       - The POD formatting was cleaned up. [David Wheeler]
+       - The preparser was updated to better handle escaped characters. [Rudy
+        Lippan]
+       - Removed redundant use of strlen() in pg_error() (Jason E. Stewart).
+       - Test suite cleaned up, converted to use Test::More, and updated to use
+        standard DBI environment variables for connecting to a test database.
+        [Jason E. Stewart]
+       - Added eg/lotest.pl as a demonstration of using large objects in buffers
+        rather than files. Contributed by Garth Webb.
+       - Added LISTEN/NOTIFY functionality. Congributed by Alex Pilosov.
+       - Added constants for common PostgreSQL data types, plus simple tests to
+       make sure that they work. These are exportable via "use DBD::Pg
+       qw(:pg_types);". [David Wheeler]
+       - Deprecatated the undocumented (and invalid) use of SQL_BINARY in
+       bind_param() and documented the correct approach: "bind_param($num,
+       $val { pg_type => PG_BYTEA });". Use of SQL_BINARY in bind_param() will
+        now issue a warning if $h->{Warn} is true. [David Wheeler]
+       - Removed invalid (and broken) support for SQL_BINARY in quote(). [David
+       Wheeler]
+       - Added App::Info::RDBMS::PostgreSQL to the distribution (but it won't
+        be installed) to help Makefile.PL find the PostgreSQL include and
+        library files. [David Wheeler]
+       - Fixed compile-time warnings. [David Wheeler and Jason E. Stewart]
+
+2002-04-27 Jeffrey W. Baker <jwbaker@acm.org>
+
+       - dbdimp.c: Add default at end of switch statement for pg_type attrib.
+       - t/13pgtype.t: test for above.
+    
+2002-04-09 Jeffrey W. Baker <jwbaker@acm.org>
+
+       - Pg.pm, dbdimp.c: Applied patch from 
+       Thomas A. Lowery <tlowery@stlowery.net> concerning metadata
+       in table_info and so forth.
+    
+2002-03-06 Jeffrey W. Baker <jwbaker@acm.org>
+       - Pg.pm (quote): Applied patch from David Wheeler <david@wheeler.net>
+       to simplfiy and speed up quoting.
+       - t/11quoting.t: Tests for above patch.
+       - t/12placeholders.t: Tests for placeholder parsing in quoted strings.
+    
+2002-03-06 Jeffrey W. Baker
+       - Version 1.10 uploaded to CPAN.
+1.01 Jun 27, 2001
+       - fixed core dump when trying to use a BYTEA value with
+         a byte outside 0..127  Alex Pilosov <alex@pilosoft.com>
+
+1.00 May 27, 2001
+       - Fetching all records now resets Active flag as it should.
+
+0.99 May 24, 2001
+       - fix the segmentation fault in pg_error.
+
+0.98 Apr 25, 2001
+       - bug-fix for core-dump after any failed function call.
+       - applied patch from Alex Pilosov <alex@pilosoft.com> 
+         which adds support for the datatype bytea
+
+0.97 Apr 20, 2001
+       - fix bug in connect method, which erroneously set the userid
+         and the password to the environment variables DBI_USER and
+         DBI_PASS.
+       - applied patch from Jan-Pieter Cornet <john@pc.xs4all.nl>,
+         which removed the special handling of a backslash when
+         used for octal presentation. Now a backslash always will
+         be escaped.
+
+0.96 Apr 09, 2001
+       - remove memory-leak in ping function, bug-fix
+         from Doug Perham <dperham@wgate.com>
+       - correct the recognition of primary keys in 
+         table_attributes(). Patch from Brian Powell 
+         <brian@nicklebys.com>.
+       - applied patch from David D. Kilzer <ddkilzer@lubricants-oil.com>
+         which fixes a segmentation fault in DBD::pg::blob_read() when 
+         reading LOBs that required perl to reallocate space for the 
+         variable holding the scalar value
+       - updated test.pl to create a test blob larger than 256 bytes 
+         (now 128 Kbytes)
+       - apply patch from Tom Lane, which fixes a seg-fault when
+         inserting large amounts of text.
+       - apply patch from Peter Haworth   pmh@edison.ioppublishing.com,
+         which removes the newlines from the error messages and which 
+         quotes date placeholders.
+
+0.95 Jul 10, 2000
+       - add Win32 port from Bob Kline <bkline@rksystems.com>.
+
+0.94 Jul 07, 2000
+       - applied patch from Rudy Lippan <almighty@randomc.com>
+         which fixes a memory-leak with failed connections.
+       - applied patch from Hein Roehrig <hein@acm.org>
+         which fixes a bug with escaping a backslash except for 
+         octal presentation
+        - applied patch from Francis J. Lacoste <francis.lacoste@iNsu.COM
+          which fixes a segmentation fault when all binded parameters are NULL
+        - adapt test.pl to avoid warnings with postgresql-7.0
+        - added support for 'COPY FROM STDIN' and 'COPY TO STDOUT'
+        - added patch from Mark Stosberg <mark@summersault.com>
+          to enhance the table_attributes subroutine
+
+0.93 Sep 29, 1999
+       - it is required now to set the environment variables POSTGRES_INCLUDE
+         and POSTGRES_LIB for compiling the module.
+       - add Win32 port from Bob Kline <bkline@rksystems.com>.
+       - support for all large-object functions via the func
+         interface. 
+       - fixed bug with placeholders and casts spotted by
+         mschout@gkg.net
+       - replaced the method attributes by the method table_attributes,
+         from Scott Williams <scott@james.com>.
+       - fix type definitions for type_info_all().
+         bug spotted by "carlos" <emarcet@intramed.net.ar>.
+       - now the Pg-specific quote() method also evaluates the 
+         data-type paramater. 
+
+0.92 Jun 16, 1999
+       - proposal from Philip Warner <pjw@rhyme.com.au>:
+         increase BUFSIZE from 1024 to 32768 in order to improve
+         I/O performance.
+       - bug-fix in Makefile.PL for $POSTGRES_HOME not defined
+         spotted by mdalphin@amgen.com (Mark Dalphin)
+       - bug-fix for data-type datetime in type_info_all
+         spotted by Alan Grover <awgrover@iconnect-inc.com>
+       - bug-fix for escaped 's spotted by Hankin <hankin@consultco.com>
+       - removed 'large objects' related tests from test.pl
+
+0.91 Feb 14, 1999
+       - removed restriction for commercial use in copyright
+       - corrected DATA_TYPE in type_info_all()
+
+0.90 Jan 15, 1998
+       - discard parameter authtype from connect string
+       - remove work-around for bug in the large object 
+         interface of postgresql 
+
+0.89 Nov 05, 1998
+       - bug-fix from Jan Iven <j.iven@rz.uni-sb.de>:
+         fix problem with quoting Null in bind variables.
+
+0.88 Oct 10, 1998
+       - fixed blob_read
+       - suppressed warning when testing DBI::errstr
+
+0.87 Sep 05, 1998
+       - Pg.xs adapted to Driver.xst from DBI-1.0
+       - major rewrite of module documentation 
+       - major rewrite of the test script
+       - use built-in DBI method for $dbh->do 
+       - add macro dHTR in order to avoid compile errors 
+         with threaded perl5.005
+       - renamed attribute AutoEscape to pg_auto_escape
+       - renamed attribute SIZE to pg_size
+       - new attribute pg_type
+       - added support for DBI->data_sources($driver)
+       - added support for $dbh->table_info
+       - blob_read documented and added to test.pl 
+       - added support for attr parameter in bind_param()
+
+0.86 Aug 21, 1998
+       - added /usr/lib/ to search path for libpq.
+       - added ChopBlanks, patch from 
+          Victor Krasinsky <victor@rdovira.lviv.ua>
+       - changed test.pl to test multiple database handles 
+
+0.85 July 19, 1998
+       - non-printable characters in parameters will not be 
+         converted to '.'. They are passed unchanged to the 
+         database. 
+
+0.84 July 18, 1998
+       - bug-fix from Max Cohan <mcohan@adnc.net>:
+         check for \xxx presentation before escaping backslash
+         in parameters. 
+       - introduce new database handle attribute AutoEscape, which 
+         controls escaping of quotes and backslashes in parameters. 
+         When set to on, all quotes except at the beginning and 
+         at the end of a line will be escaped and all backslashes 
+         except when used to indicate an octal presentation (\xxx) 
+         will be escaped. Default of AutoEscape is on. 
+
+0.83 July 10, 1998
+       - bug-fix from Max Cohan <mcohan@adnc.net>:
+         using traces together with undef in place-holders dumped 
+         core. 
+
+0.82 June 20, 1998
+       - bug-fix from Matthew Lenz <matthew@nocturnal.org>:
+         corrected include path in Makefile.PL .
+       - added 'use strict;' to test.pl
+
+0.81 June 13, 1998
+       - bug-fix from Rolf Grossmann <grossman@securitas.net>:
+         undefined parameters in an execute statement will be 
+         translated from 'undef' to 'NULL'. Also every parameter 
+         for bind_param() will be quoted by default (escape quote 
+         and backslash). Appropriate tests have been added to test.pl. 
+       - change ping method to use libpq-interface.
+
+0.80 June 07, 1998
+       - adapted to postgresql-6.4:
+         the backend protocol has changed, which needs an adapted
+         ping method. A ping-test has been added to the test-script.
+         Also some type identifiers have changed. 
+
+0.73 June 03, 1998
+       - changed include directives in Makefile.PL from 
+         archlib to installarchlib and from sitearch to
+         installsitearch (Tony.Curtis@vcpc.univie.ac.at).
+       - applied patch from Junio Hamano <junio@twinsun.com>
+         quote method also doubles backslash.
+
+0.72 April 20, 1998
+       - applied patch from Michael J Schout <mschout@gkg.net>
+         which fixed the bug with queries containing the cast
+          operator.
+       - applied patch from "Irving Reid" <irving@tor.securecomputing.com>
+         which fixed a memory leak.
+
+0.71 April 04, 1998
+       - applied patch from "Irving Reid" 
+         <irving@tor.securecomputing.com> which fixed the
+         the problem with the InactiveDestroy message.
+
+0.70 March 28, 1998
+        - linking again with the shared version of libpq 
+          due to problems on several operating systems.
+
+0.69 March  6, 1998
+       - expanded the search path for include files
+        - module is now linked with static libpq.a
+
+0.68  March 3, 1998
+        - return to UNIX domain sockets in test-scripts
+
+0.67  February 21, 1998
+       - remove part of Driver.xst due to compile
+         error on some systems.
+
+0.66  February 19, 1998
+       - remove defines in Pg.h so that
+         it compiles also with postgresql-6.2.1
+       - changed ping method: set RaiseError=0
+
+0.65  February 14, 1998
+       - adapted to changes in DBI-0.91, so that the
+         default setting for AutoCommit and PrintError is 
+         again conformant to the DBI specs.
+
+0.64  February 01, 1998
+        - changed syntax of data_source (ODBC-conformant): 
+          'dbi:Pg:dbname=dbname;host=host;port=port'
+          !!! PLEASE ADAPT YOUR SCRIPTS !!!
+        - implemented place-holders 
+        - implemented ping-method
+        - added support for $dbh->{RaiseError} and $dbh->{PrintError},
+          note: DBI-default for PrintError is on !
+        - allow commit and rollback only if AutoCommit = off
+        - added documentation for $dbh->tables;
+        - new method to get meta-information about a given table:
+          $dbh->DBD::Pg::db::attributes($table);
+        - host-parameter in test.pl is set explicitly to localhost
+
+0.63  October 05, 1997
+       - adapted to PostgreSQL-6.2:
+          o $sth->rows as well as $sth->execute
+            and $sth->do return the number of 
+            affected rows even for non-Select
+            statements.
+          o support for password authorization added, 
+            please check the man-page for pg_passwd. 
+        - the data_source parameter of the connect 
+          method accepts two additional parameters 
+          which are  treated as host and port:
+          DBI->connect("dbi:Pg:dbname:host:port", "uid", "pwd")
+        - support for AutoCommit, please read the 
+          module documentation for impacts on your 
+          scripts !
+        - more perl-ish handling of data type bool, 
+          please read the module documentation for 
+          impacts on your scripts !
+
+0.62  August 26, 1997
+       - added blobs/README
+
+0.61  August 23, 1997
+        - adapted to DBI-0.89/Driver.xst
+       - added support for blob_read
+
+0.52  August 15, 1997
+        - added support for literal $sth->{'TYPE'},
+          pg_type.pl / pg_type.pm.
+
+0.51  August 12, 1997
+        - changed attributes to be DBI conformant:
+          o OID_STATUS to pg_oid_status
+          o CMD_STATUS to pg_cmd_status
+
+0.5   August 05, 1997
+       - support for user authentication
+       - support for bind_columns
+       - added $dbh->tables
+
+0.4   Jun 24, 1997
+        - adapted to DBI-0.84:
+          o new syntax for DBI->connect !
+          o execute returns 0E0 -> n for     SELECT stmt
+                                  -1 for non SELECT stmt
+                                  -2 on error
+        - new attribute $sth->{'OID_STATUS'}
+        - new attribute $sth->{'CMD_STATUS'}
+
+0.3   Apr 24, 1997
+        - bug fix release, ( still alpha ! )
+
+0.2   Mar 13, 1997
+       - complete rewrite, ( still alpha ! )
+
+0.1   Feb 15, 1997
+       - creation, ( totally pre-alpha ! )
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/MANIFEST b/install/5.005/DBD-Pg-1.22-fixvercmp/MANIFEST
new file mode 100644 (file)
index 0000000..7d1b700
--- /dev/null
@@ -0,0 +1,38 @@
+Changes
+MANIFEST
+Makefile.PL
+Pg.h
+Pg.pm
+Pg.xs
+README
+README.win32
+dbd-pg.pod
+dbdimp.c
+dbdimp.h
+eg/ApacheDBI.pl
+eg/lotest.pl
+eg/notify_test.patch
+t/00basic.t
+t/01connect.t
+t/01constants.t
+t/01setup.t
+t/02prepare.t
+t/03bind.t
+t/04execute.t
+t/05fetch.t
+t/06disconnect.t
+t/07reuse.t
+t/08txn.t
+t/09autocommit.t
+t/11quoting.t
+t/12placeholders.t
+t/13pgtype.t
+t/15funct.t
+t/99cleanup.t
+t/lib/App/Info.pm
+t/lib/App/Info/Handler.pm
+t/lib/App/Info/Handler/Prompt.pm
+t/lib/App/Info/RDBMS.pm
+t/lib/App/Info/RDBMS/PostgreSQL.pm
+t/lib/App/Info/Request.pm
+t/lib/App/Info/Util.pm
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Makefile.PL b/install/5.005/DBD-Pg-1.22-fixvercmp/Makefile.PL
new file mode 100644 (file)
index 0000000..0633280
--- /dev/null
@@ -0,0 +1,83 @@
+
+# $Id: Makefile.PL,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+use ExtUtils::MakeMaker;
+use Config;
+use strict;
+
+use DBI 1.00;
+use DBI::DBD;
+
+my $lib;
+BEGIN {
+    my %sep = (MacOS   => ':',
+               MSWin32 => '\\',
+               os2     => '\\',
+               VMS     => '\\',
+               NetWare => '\\',
+               dos     => '\\');
+    my $s = $sep{$^O} || '/';
+    $lib = join $s, 't', 'lib';
+}
+
+use lib $lib;
+print "Configuring Pg\n";
+print "Remember to actually read the README file !\n";
+
+my $POSTGRES_INCLUDE;
+my $POSTGRES_LIB;
+
+if ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and !$ENV{POSTGRES_HOME}) {
+    # Use App::Info to get the data we need.
+    require App::Info::RDBMS::PostgreSQL;
+    require App::Info::Handler::Prompt;
+    my $p = App::Info::Handler::Prompt->new;
+    my $pg = App::Info::RDBMS::PostgreSQL->new(on_unknown => $p);
+    $POSTGRES_INCLUDE = $pg->inc_dir;
+    $POSTGRES_LIB     = $pg->lib_dir;
+} elsif ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and $ENV{POSTGRES_HOME}) {
+    $POSTGRES_INCLUDE = "$ENV{POSTGRES_HOME}/include";
+    $POSTGRES_LIB     = "$ENV{POSTGRES_HOME}/lib";
+} else {
+    $POSTGRES_INCLUDE = "$ENV{POSTGRES_INCLUDE}";
+    $POSTGRES_LIB     = "$ENV{POSTGRES_LIB}";
+}
+
+my $os = $^O;
+print "OS: $os\n";
+
+my $dbi_arch_dir;
+if ($os eq 'MSWin32') {
+    $dbi_arch_dir = "\$(INSTALLSITEARCH)/auto/DBI";
+} else {
+    $dbi_arch_dir = dbd_dbi_arch_dir();
+}
+
+my %opts = (
+    NAME         => 'DBD::Pg',
+    VERSION_FROM => 'Pg.pm',
+    INC          => "-I$POSTGRES_INCLUDE -I$dbi_arch_dir",
+    OBJECT       => "Pg\$(OBJ_EXT) dbdimp\$(OBJ_EXT)",
+    LIBS         => ["-L$POSTGRES_LIB -lpq"],
+    AUTHOR       => 'http://gborg.postgresql.org/project/dbdpg/projdisplay.php',
+    ABSTRACT     => 'PostgreSQL database driver for the DBI module',
+    PREREQ_PM   => { 'Test::Simple' => 0.17 }, # Need Test::More
+);
+
+if ($os eq 'hpux') {
+    my $osvers = $Config{osvers};
+    if ($osvers < 10) {
+        print "Warning: Forced to build static not dynamic on $os $osvers.\a\n";
+        $opts{LINKTYPE} = 'static';
+    }
+}
+
+if ($Config{dlsrc} =~ /dl_none/) {
+    $opts{LINKTYPE} = 'static';
+}
+
+WriteMakefile(%opts);
+
+exit(0);
+
+# end of Makefile.PL
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.h b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.h
new file mode 100644 (file)
index 0000000..b77a9f8
--- /dev/null
@@ -0,0 +1,46 @@
+/*
+   $Id: Pg.h,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+   Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+   Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+   You may distribute under the terms of either the GNU General Public
+   License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+#ifdef WIN32
+static int errno;
+#endif
+
+#include "libpq-fe.h"
+
+#ifdef NEVER
+#include<sys/stat.h>
+#include "libpq/libpq-fs.h"
+#endif
+#ifndef INV_READ
+#define INV_READ 0x00040000
+#endif
+#ifndef INV_WRITE
+#define INV_WRITE 0x00020000
+#endif
+
+#ifdef BUFSIZ
+#undef BUFSIZ
+#endif
+/* this should improve I/O performance for large objects */
+#define BUFSIZ 32768
+
+
+#define NEED_DBIXS_VERSION 93
+
+#include <DBIXS.h>             /* installed by the DBI module  */
+
+#include "dbdimp.h"            /* read in our implementation details */
+
+#include <dbd_xsh.h>           /* installed by the DBI module  */
+
+
+/* end of Pg.h */
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.pm
new file mode 100644 (file)
index 0000000..284e563
--- /dev/null
@@ -0,0 +1,1913 @@
+
+#  $Id: Pg.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+#
+#  Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+#  Copyright (c) 2002 Jeffrey W. Baker
+#  Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+#
+#  You may distribute under the terms of either the GNU General Public
+#  License or the Artistic License, as specified in the Perl README file.
+
+
+require 5.004;
+
+$DBD::Pg::VERSION = '1.22';
+
+{
+    package DBD::Pg;
+
+    use DBI ();
+    use DynaLoader ();
+    use Exporter ();
+    @ISA = qw(DynaLoader Exporter);
+
+    %EXPORT_TAGS = (
+       pg_types => [ qw(
+           PG_BOOL PG_BYTEA PG_CHAR PG_INT8 PG_INT2 PG_INT4 PG_TEXT PG_OID
+           PG_FLOAT4 PG_FLOAT8 PG_ABSTIME PG_RELTIME PG_TINTERVAL PG_BPCHAR
+           PG_VARCHAR PG_DATE PG_TIME PG_DATETIME PG_TIMESPAN PG_TIMESTAMP
+       )]);
+
+    Exporter::export_ok_tags('pg_types');
+
+    require_version DBI 1.00;
+
+    bootstrap DBD::Pg $VERSION;
+
+    $err = 0;          # holds error code   for DBI::err
+    $errstr = "";      # holds error string for DBI::errstr
+    $drh = undef;      # holds driver handle once initialized
+
+    sub driver{
+       return $drh if $drh;
+       my($class, $attr) = @_;
+
+       $class .= "::dr";
+
+       # not a 'my' since we use it above to prevent multiple drivers
+
+       $drh = DBI::_new_drh($class, {
+           'Name' => 'Pg',
+           'Version' => $VERSION,
+           'Err'    => \$DBD::Pg::err,
+           'Errstr' => \$DBD::Pg::errstr,
+           'Attribution' => 'PostgreSQL DBD by Edmund Mergl',
+       });
+
+       $drh;
+    }
+
+    ## Used by both the dr and db packages
+    sub pg_server_version {
+               my $dbh = shift;
+               return $dbh->{pg_server_version} if defined $dbh->{pg_server_version};
+        my ($version) = $dbh->selectrow_array("SELECT version();");
+        return 0 unless $version =~ /^PostgreSQL ([\d\.]+)/;
+        $dbh{pg_server_version} = $1;
+        return $dbh{pg_server_version};
+       }
+
+    sub pg_use_catalog {
+      my $dbh = shift;
+      my $version = DBD::Pg::pg_server_version($dbh);
+      $version =~ /^(\d+\.\d+)/;
+      return $1 < 7.3 ? "" : "pg_catalog.";
+    }
+
+    1;
+}
+
+
+{   package DBD::Pg::dr; # ====== DRIVER ======
+    use strict;
+
+    sub data_sources {
+        my $drh = shift;
+        my $dbh = DBD::Pg::dr::connect($drh, 'dbname=template1') or return undef;
+        $dbh->{AutoCommit} = 1;
+        my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+        my $sth = $dbh->prepare("SELECT datname FROM ${CATALOG}pg_database ORDER BY datname");
+        $sth->execute or return undef;
+        my (@sources, @datname);
+        while (@datname = $sth->fetchrow_array) {
+            push @sources, "dbi:Pg:dbname=$datname[0]";
+        }
+        $sth->finish;
+        $dbh->disconnect;
+        return @sources;
+    }
+
+
+    sub connect {
+        my($drh, $dbname, $user, $auth)= @_;
+
+        # create a 'blank' dbh
+
+        my $Name = $dbname;
+        $Name =~ s/^.*dbname\s*=\s*//;
+        $Name =~ s/\s*;.*$//;
+
+        $user = "" unless defined($user);
+        $auth = "" unless defined($auth);
+
+        $user = $ENV{DBI_USER} if $user eq "";
+        $auth = $ENV{DBI_PASS} if $auth eq "";
+
+        $user = "" unless defined($user);
+        $auth = "" unless defined($auth);
+
+        my($dbh) = DBI::_new_dbh($drh, {
+            'Name' => $Name,
+            'User' => $user, 'CURRENT_USER' => $user,
+        });
+
+        # Connect to the database..
+        DBD::Pg::db::_login($dbh, $dbname, $user, $auth) or return undef;
+
+        $dbh;
+    }
+
+}
+
+
+{   package DBD::Pg::db; # ====== DATABASE ======
+    use strict;
+    use Carp ();
+
+    sub prepare {
+        my($dbh, $statement, @attribs)= @_;
+
+        # create a 'blank' sth
+
+        my $sth = DBI::_new_sth($dbh, {
+            'Statement' => $statement,
+        });
+
+        DBD::Pg::st::_prepare($sth, $statement, @attribs) or return undef;
+
+        $sth;
+    }
+
+
+    sub ping {
+        my($dbh) = @_;
+
+       local $SIG{__WARN__} = sub { } if $dbh->{PrintError};
+        local $dbh->{RaiseError} = 0 if $dbh->{RaiseError};
+        my $ret = DBD::Pg::db::_ping($dbh);
+
+        return $ret;
+    }
+
+       # Column expected in statement handle returned.
+       # table_cat, table_schem, table_name, column_name, data_type, type_name,
+       # column_size, buffer_length, DECIMAL_DIGITS, NUM_PREC_RADIX, NULLABLE,
+       # REMARKS, COLUMN_DEF, SQL_DATA_TYPE, SQL_DATETIME_SUB, CHAR_OCTET_LENGTH,
+       # ORDINAL_POSITION, IS_NULLABLE
+       # The result set is ordered by TABLE_CAT, TABLE_SCHEM, 
+       # TABLE_NAME and ORDINAL_POSITION.
+
+       sub column_info {
+               my ($dbh) = shift;
+               my @attrs = @_;
+               # my ($dbh, $catalog, $schema, $table, $column) = @_;
+               my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+               my @wh = ();
+               my @flds = qw/catname n.nspname c.relname a.attname/;
+
+               for my $idx (0 .. $#attrs) {
+                       next if ($flds[$idx] eq 'catname'); # Skip catalog
+                       if(defined $attrs[$idx] and length $attrs[$idx]) {
+                               # Insure that the value is enclosed in single quotes.
+                               $attrs[$idx] =~ s/^'?(\w+)'?$/'$1'/;
+                               if ($attrs[$idx] =~ m/[,%]/) {
+                                       # contains a meta character.
+                                       push( @wh, q{( } . join ( " OR "
+                                               , map { m/\%/ 
+                                                       ? qq{$flds[$idx] ILIKE $_ }
+                                                       : qq{$flds[$idx]    = $_ }
+                                                       } (split /,/, $attrs[$idx]) )
+                                                       . q{ )}
+                                               );
+                               }
+                               else {
+                                       push( @wh, qq{$flds[$idx] = $attrs[$idx]} );
+                               }
+                       }
+               }
+
+               my $wh = ""; # ();
+               $wh = join( " AND ", '', @wh ) if (@wh);
+               my $version = DBD::Pg::pg_server_version($dbh);
+               $version =~ /^(\d+\.\d+)/;
+               $version = $1;
+               my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+               my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)";
+               my $col_info_sql = qq{
+                       SELECT
+                                 NULL::text    AS "TABLE_CAT"
+                               , $showschema   AS "TABLE_SCHEM"
+                               , c.relname             AS "TABLE_NAME"
+                               , a.attname             AS "COLUMN_NAME"
+                               , t.typname             AS "DATA_TYPE"
+                               , NULL::text    AS "TYPE_NAME"
+                               , a.attlen              AS "COLUMN_SIZE"
+                               , NULL::text    AS "BUFFER_LENGTH"
+                               , NULL::text    AS "DECIMAL_DIGITS"
+                               , NULL::text    AS "NUM_PREC_RADIX"
+                               , a.attnotnull  AS "NULLABLE"
+                               , NULL::text    AS "REMARKS"
+                               , a.atthasdef   AS "COLUMN_DEF"
+                               , NULL::text    AS "SQL_DATA_TYPE"
+                               , NULL::text    AS "SQL_DATETIME_SUB"
+                               , NULL::text    AS "CHAR_OCTET_LENGTH"
+                               , a.attnum              AS "ORDINAL_POSITION"
+                               , a.attnotnull  AS "IS_NULLABLE"
+                               , a.atttypmod   as atttypmod
+                               , a.attnotnull  as attnotnull
+                               , a.atthasdef   as atthasdef
+                               , a.attnum              as attnum
+                       FROM 
+                                 ${CATALOG}pg_attribute        a
+                               , ${CATALOG}pg_type             t
+                               , ${CATALOG}pg_class            c
+                               $schemajoin
+                       WHERE
+                                       a.attrelid = c.oid
+                               AND a.attnum  >= 0
+                               AND t.oid      = a.atttypid
+                               AND c.relkind  in ('r','v')
+                               $wh
+                       ORDER BY 2, 3, 4
+               };
+
+               my $sth = $dbh->prepare( $col_info_sql ) or return undef;
+               $sth->execute();
+
+               return $sth;
+       }
+
+       sub primary_key_info {
+        my $dbh = shift;
+               my ($catalog, $schema, $table) = @_;
+               my @attrs = @_;
+        my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+               # TABLE_CAT:, TABLE_SCHEM:, TABLE_NAME:, COLUMN_NAME:, KEY_SEQ:
+               # , PK_NAME:
+
+               my @wh = (); my @dat = ();  # Used to hold data for the attributes.
+
+               my $version = DBD::Pg::pg_server_version($dbh);
+               $version =~ /^(\d+\.\d+)/;
+               $version = $1;
+
+               my @flds = qw/catname u.usename bc.relname/;
+               $flds[1] = 'n.nspname' unless ($version < 7.3);
+
+               for my $idx (0 .. $#attrs) {
+                       next if ($flds[$idx] eq 'catname'); # Skip catalog
+                       if(defined $attrs[$idx] and length $attrs[$idx]) {
+                               if ($attrs[$idx] =~ m/[,%_?]/) {
+                                       # contains a meta character.
+                                       push( @wh, q{( } . join ( " OR "
+                                               , map { push(@dat, $_);
+                                                       m/[%_?]/ 
+                                                       ? qq{$flds[$idx] iLIKE ? }
+                                                       : qq{$flds[$idx]    = ?  }
+                                                       } (split /,/, $attrs[$idx]) )
+                                                       . q{ )}
+                                               );
+                               }
+                               else {
+                                       push( @dat, $attrs[$idx] );
+                                       push( @wh, qq{$flds[$idx] = ? } );
+                               }
+                       }
+               }
+
+               my $wh = '';
+               $wh = join( " AND ", '', @wh ) if (@wh);
+
+               # Base primary key selection query borrowed from phpPgAdmin.
+               my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+               my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = bc.relnamespace)";
+               my $pri_key_sql = qq{
+                       SELECT
+                               NULL::text              AS "TABLE_CAT"
+                               , $showschema   AS "TABLE_SCHEM"
+                               , bc.relname    AS "TABLE_NAME"
+                               , a.attname             AS "COLUMN_NAME"
+                               , a.attnum              AS "KEY_SEQ"
+                               , ic.relname    AS "PK_NAME"
+                       FROM
+                               ${CATALOG}pg_index i
+                               , ${CATALOG}pg_attribute a
+                               , ${CATALOG}pg_class ic
+                               , ${CATALOG}pg_class bc
+                               $schemajoin
+                       WHERE
+                               i.indrelid = bc.oid
+                       AND i.indexrelid = ic.oid
+                       AND
+                       (
+                               i.indkey[0] = a.attnum
+                               OR
+                               i.indkey[1] = a.attnum
+                               OR
+                               i.indkey[2] = a.attnum
+                               OR
+                               i.indkey[3] = a.attnum
+                               OR
+                               i.indkey[4] = a.attnum
+                               OR
+                               i.indkey[5] = a.attnum
+                               OR
+                               i.indkey[6] = a.attnum
+                               OR
+                               i.indkey[7] = a.attnum
+                               OR
+                               i.indkey[8] = a.attnum
+                               OR
+                               i.indkey[9] = a.attnum
+                               OR
+                               i.indkey[10] = a.attnum
+                               OR
+                               i.indkey[11] = a.attnum
+                               OR
+                               i.indkey[12] = a.attnum
+                       )
+                       AND a.attrelid = bc.oid
+                       AND i.indproc = '0'::oid
+                       AND i.indisprimary = 't' 
+                       $wh
+                       ORDER BY 2, 3, 5
+               };
+
+        my $sth = $dbh->prepare( $pri_key_sql ) or return undef;
+        $sth->execute(@dat);
+
+        return $sth;
+       }
+
+    sub foreign_key_info {
+       # todo: verify schema work as expected
+       # add code to handle multiple-column keys correctly
+       # return something nicer for pre-7.3?
+       # try to clean up SQL, perl code
+       # create a test script?
+
+       my $dbh = shift;
+       my ($pk_catalog, $pk_schema, $pk_table,
+               $fk_catalog, $fk_schema, $fk_table) = @_;
+
+       # this query doesn't work for Postgres before 7.3
+       my $version = $dbh->pg_server_version;
+       $version =~ /^(\d+)\.(\d)/;
+       return undef if ($1.$2 < 73);
+
+       # Used to hold data for the attributes.
+       my @dat = ();
+
+       # SQL to find primary/unique keys of a table
+       my $pkey_sql = qq{
+       SELECT
+       NULL::text AS PKTABLE_CAT,
+       pknam.nspname AS PKTABLE_SCHEM,
+       pkc.relname AS PKTABLE_NAME,
+       pka.attname AS PKCOLUMN_NAME,
+       NULL::text AS FKTABLE_CAT,
+       NULL::text AS FKTABLE_SCHEM,
+       NULL::text AS FKTABLE_NAME,
+       NULL::text AS FKCOLUMN_NAME,
+       pkcon.conkey[1] AS KEY_SEQ,
+       CASE
+               WHEN pkcon.confupdtype = 'c' THEN 0
+               WHEN pkcon.confupdtype = 'r' THEN 1
+               WHEN pkcon.confupdtype = 'n' THEN 2
+               WHEN pkcon.confupdtype = 'a' THEN 3
+               WHEN pkcon.confupdtype = 'd' THEN 4
+               END AS UPDATE_RULE,
+       CASE
+               WHEN pkcon.confdeltype = 'c' THEN 0
+               WHEN pkcon.confdeltype = 'r' THEN 1
+               WHEN pkcon.confdeltype = 'n' THEN 2
+               WHEN pkcon.confdeltype = 'a' THEN 3
+               WHEN pkcon.confdeltype = 'd' THEN 4
+               END AS DELETE_RULE,
+       NULL::text AS FK_NAME,
+       pkcon.conname AS PK_NAME,
+       CASE
+               WHEN pkcon.condeferrable = 'f' THEN 7
+               WHEN pkcon.condeferred = 't' THEN 6
+               WHEN pkcon.condeferred = 'f' THEN 5
+               END AS DEFERRABILITY,
+       CASE
+               WHEN pkcon.contype = 'p' THEN 'PRIMARY'
+               WHEN pkcon.contype = 'u' THEN 'UNIQUE'
+               END AS UNIQUE_OR_PRIMARY
+       FROM
+               pg_constraint AS pkcon
+       JOIN
+               pg_class pkc ON pkc.oid=pkcon.conrelid
+       JOIN
+               pg_namespace pknam ON pkcon.connamespace=pknam.oid
+       JOIN
+               pg_attribute pka ON pka.attnum=pkcon.conkey[1] AND pka.attrelid=pkc.oid
+       };
+
+       # SQL to find foreign keys of a table
+       my $fkey_sql = qq{
+       SELECT
+       NULL::text AS PKTABLE_CAT,
+       pknam.nspname AS PKTABLE_SCHEM,
+       pkc.relname AS PKTABLE_NAME,
+       pka.attname AS PKCOLUMN_NAME,
+       NULL::text AS FKTABLE_CAT,
+       fknam.nspname AS FKTABLE_SCHEM,
+       fkc.relname AS FKTABLE_NAME,
+       fka.attname AS FKCOLUMN_NAME,
+       fkcon.conkey[1] AS KEY_SEQ,
+       CASE
+               WHEN fkcon.confupdtype = 'c' THEN 0
+               WHEN fkcon.confupdtype = 'r' THEN 1
+               WHEN fkcon.confupdtype = 'n' THEN 2
+               WHEN fkcon.confupdtype = 'a' THEN 3
+               WHEN fkcon.confupdtype = 'd' THEN 4
+               END AS UPDATE_RULE,
+       CASE
+               WHEN fkcon.confdeltype = 'c' THEN 0
+               WHEN fkcon.confdeltype = 'r' THEN 1
+               WHEN fkcon.confdeltype = 'n' THEN 2
+               WHEN fkcon.confdeltype = 'a' THEN 3
+               WHEN fkcon.confdeltype = 'd' THEN 4
+               END AS DELETE_RULE,
+       fkcon.conname AS FK_NAME,
+       pkcon.conname AS PK_NAME,
+       CASE
+               WHEN fkcon.condeferrable = 'f' THEN 7
+               WHEN fkcon.condeferred = 't' THEN 6
+               WHEN fkcon.condeferred = 'f' THEN 5
+               END AS DEFERRABILITY,
+       CASE
+               WHEN pkcon.contype = 'p' THEN 'PRIMARY'
+               WHEN pkcon.contype = 'u' THEN 'UNIQUE'
+               END AS UNIQUE_OR_PRIMARY
+       FROM
+               pg_constraint AS fkcon
+       JOIN
+               pg_constraint AS pkcon ON fkcon.confrelid=pkcon.conrelid
+                       AND fkcon.confkey=pkcon.conkey
+       JOIN
+               pg_class fkc ON fkc.oid=fkcon.conrelid
+       JOIN
+               pg_class pkc ON pkc.oid=fkcon.confrelid
+       JOIN
+               pg_namespace pknam ON pkcon.connamespace=pknam.oid
+       JOIN
+               pg_namespace fknam ON fkcon.connamespace=fknam.oid
+       JOIN
+               pg_attribute fka ON fka.attnum=fkcon.conkey[1] AND fka.attrelid=fkc.oid
+       JOIN
+               pg_attribute pka ON pka.attnum=pkcon.conkey[1] AND pka.attrelid=pkc.oid
+       };
+
+       # if schema are provided, use this SQL
+       my $pk_schema_sql = " AND pknam.nspname = ? ";
+       my $fk_schema_sql = " AND fknam.nspname = ? ";
+
+       my $key_sql;
+
+       # if $fk_table: generate SQL stub, which will be same
+       # whether or not $pk_table supplied
+       if ($fk_table)
+       {
+               $key_sql = $fkey_sql . qq{
+               WHERE
+                       fkc.relname = ?
+               };
+               push @dat, $fk_table;
+
+               if ($fk_schema)
+               {
+                       $key_sql .= $fk_schema_sql;
+                       push @dat,$fk_schema;
+               }
+       }
+
+       # if $fk_table and $pk_table: (defined by DBI, not SQL/CLI)
+       # return foreign key of $fk_table that refers to $pk_table
+       # (if any)
+       if ($pk_table and $fk_table)
+       {
+               $key_sql .= qq{
+               AND
+                       pkc.relname = ?
+               };
+               push @dat, $pk_table;
+
+               if ($pk_schema)
+               {
+                       $key_sql .= $pk_schema_sql;
+                       push @dat,$pk_schema;
+               }
+       }
+
+       # if $fk_table but no $pk_table:
+       # return all foreign keys of $fk_table, and all
+       # primary keys of tables to which $fk_table refers
+       if (!$pk_table and $fk_table)
+       {
+               # find primary/unique keys referenced by $fk_table
+               # (this one is a little tricky)
+               $key_sql .= ' UNION ' . $pkey_sql . qq{
+               WHERE
+                       pkcon.conname IN
+               (
+               SELECT
+                       pkcon.conname
+               FROM
+                       pg_constraint AS fkcon
+               JOIN
+                       pg_constraint AS pkcon ON fkcon.confrelid=pkcon.conrelid AND
+                                       fkcon.confkey=pkcon.conkey
+               JOIN
+                       pg_class fkc ON fkc.oid=fkcon.conrelid
+               WHERE
+                       fkc.relname = ?
+               )       
+               };
+               push @dat, $fk_table;
+
+               if ($fk_schema)
+               {
+                       $key_sql .= $pk_schema_sql;
+                       push @dat,$fk_schema;
+               }
+       }
+
+       # if $pk_table but no $fk_table:
+       # return primary key of $pk_table and all foreign keys
+       # that reference $pk_table
+       # question: what about unique keys?
+       # (DBI and SQL/CLI both state to omit unique keys)
+
+       if ($pk_table and !$fk_table)
+       {
+               # find primary key (only!) of $pk_table
+               $key_sql = $pkey_sql . qq{
+               WHERE
+                       pkc.relname = ?
+               AND
+                       pkcon.contype = 'p'
+               };
+               @dat = ($pk_table);
+
+               if ($pk_schema)
+               {
+                       $key_sql .= $pk_schema_sql;
+                       push @dat,$pk_schema;
+               }
+
+               # find all foreign keys that reference $pk_table
+               $key_sql .= 'UNION ' . $fkey_sql . qq{
+               WHERE
+                       pkc.relname = ?
+               AND
+                       pkcon.contype = 'p'
+               };
+               push @dat, $pk_table;
+
+               if ($pk_schema)
+               {
+                       $key_sql .= $fk_schema_sql;
+                       push @dat,$pk_schema;
+               }
+       }
+
+       return undef unless $key_sql;
+       my $sth = $dbh->prepare( $key_sql ) or
+               return undef;
+       $sth->execute(@dat);
+
+       return $sth;
+    }
+
+
+    sub table_info {         # DBI spec: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TABLE_TYPE, REMARKS
+        my $dbh = shift;
+               my ($catalog, $schema, $table, $type) = @_;
+               my @attrs = @_;
+
+               my $tbl_sql = ();
+
+        my $version = DBD::Pg::pg_server_version($dbh);
+       $version =~ /^(\d+\.\d+)/;
+       $version = $1;
+        my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+               if ( # Rules 19a
+                           (defined $catalog and $catalog eq '%')
+                       and (defined $schema  and $schema  eq  '')
+                       and (defined $table   and $table   eq  '')
+                       ) {
+                               $tbl_sql = q{
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , NULL::text    AS "TABLE_TYPE"
+                                        , NULL::text    AS "REMARKS"
+                                       };
+               }
+               elsif (# Rules 19b
+                           (defined $catalog and $catalog eq  '')
+                       and (defined $schema  and $schema  eq '%')
+                       and (defined $table   and $table   eq  '')
+                       ) {
+                               $tbl_sql = ($version < 7.3) ? q{
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , NULL::text    AS "TABLE_TYPE"
+                                        , NULL::text    AS "REMARKS"
+                    } : q{
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , n.nspname     AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , NULL::text    AS "TABLE_TYPE"
+                                        , NULL::text    AS "REMARKS"
+                                       FROM pg_catalog.pg_namespace n
+                                       ORDER BY 1
+                                       };
+               }
+               elsif (# Rules 19c
+                           (defined $catalog and $catalog eq  '')
+                       and (defined $schema  and $schema  eq  '')
+                       and (defined $table   and $table   eq  '')
+                       and (defined $type    and $type    eq  '%')
+                       ) {
+                               # From the postgresql 7.2.1 manual 3.5 pg_class
+                               #  'r' = ordinary table
+                               #, 'i' = index
+                               #, 'S' = sequence
+                               #, 'v' = view
+                               #, 's' = special
+                               #, 't' = secondary TOAST table 
+                               $tbl_sql = q{
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'table'       AS "TABLE_TYPE"
+                                        , 'ordinary table - r'    AS "REMARKS"
+                                       union
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'index'       AS "TABLE_TYPE"
+                                        , 'index - i'    AS "REMARKS"
+                                       union
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'sequence'     AS "TABLE_TYPE"
+                                        , 'sequence - S'    AS "REMARKS"
+                                       union
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'view'       AS "TABLE_TYPE"
+                                        , 'view - v'    AS "REMARKS"
+                                       union
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'special'       AS "TABLE_TYPE"
+                                        , 'special - s'    AS "REMARKS"
+                                       union
+                                       SELECT 
+                                          NULL::text    AS "TABLE_CAT"
+                                        , NULL::text    AS "TABLE_SCHEM"
+                                        , NULL::text    AS "TABLE_NAME"
+                                        , 'secondary'   AS "TABLE_TYPE"
+                                        , 'secondary TOAST table - t'    AS "REMARKS"
+                               };
+               }
+               else {
+                               # Default SQL
+                               my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+                               my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)";
+                               my $schemacase = $version < 7.3 ? "CASE WHEN c.relname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END" : 
+                                       "CASE WHEN n.nspname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END";
+                               $tbl_sql = qq{
+                               SELECT NULL::text    AS "TABLE_CAT"
+                                        , $showschema   AS "TABLE_SCHEM"
+                                        , c.relname     AS "TABLE_NAME"
+                                        , CASE
+                                                WHEN c.relkind = 'v' THEN 'VIEW'
+                                                ELSE $schemacase
+                                               END                      AS "TABLE_TYPE"
+                                        , d.description AS "REMARKS"
+                               FROM ${CATALOG}pg_user          AS u
+                                  , ${CATALOG}pg_class         AS c
+                                        LEFT JOIN 
+                                        ${CATALOG}pg_description       AS d 
+                                               ON (c.relfilenode = d.objoid AND d.objsubid = 0)
+                               $schemajoin
+                               WHERE 
+                                         ((c.relkind     =  'r'
+                                 AND c.relhasrules =  FALSE) OR
+                                         (c.relkind     =  'v'
+                                 AND c.relhasrules =  TRUE))
+                                 AND c.relname     !~ '^xin[vx][0-9]+'
+                                 AND c.relowner    =  u.usesysid
+                               ORDER BY 1, 2, 3
+                               };
+
+                       # Did we receive any arguments?
+                       if (@attrs) {
+                               my @wh = ();
+                               my @flds = qw/catname n.nspname c.relname c.relkind/;
+
+                               for my $idx (0 .. $#attrs) {
+                                       next if ($flds[$idx] eq 'catname'); # Skip catalog
+                                       if(defined $attrs[$idx] and length $attrs[$idx]) {
+                                               # Change the "name" of the types to the real value.
+                                               if ($flds[$idx]  =~ m/relkind/) {
+                                                       $attrs[$idx] =~ s/^\'?table\'?/'r'/i;
+                                                       $attrs[$idx] =~ s/^\'?index\'?/'i'/i;
+                                                       $attrs[$idx] =~ s/^\'?sequence\'?/'S'/i;
+                                                       $attrs[$idx] =~ s/^\'?view\'?/'v'/i;
+                                                       $attrs[$idx] =~ s/^\'?special\'?/'s'/i;
+                                                       $attrs[$idx] =~ s/^\'?secondary\'?/'t'/i;
+                                               }
+                                               # Insure that the value is enclosed in single quotes.
+                                               $attrs[$idx] =~ s/^'?(\w+)'?$/'$1'/;
+                                               if ($attrs[$idx] =~ m/[,%]/) {
+                                                       # contains a meta character.
+                                                       push( @wh, q{( } . join ( " OR "
+                                                               , map { m/\%/ 
+                                                                       ? qq{$flds[$idx] LIKE $_ }
+                                                                       : qq{$flds[$idx]    = $_ }
+                                                                       } (split /,/, $attrs[$idx]) )
+                                                                       . q{ )}
+                                                               );
+                                               }
+                                               else {
+                                                       push( @wh, qq{$flds[$idx] = $attrs[$idx]} );
+                                               }
+                                       }
+                               }
+
+                               my $wh = ();
+                               if (@wh) {
+                                       $wh = join( " AND ",'', @wh );
+                                       $tbl_sql = qq{
+                                       SELECT NULL::text    AS "TABLE_CAT"
+                                                , $showschema   AS "TABLE_SCHEM"
+                                                , c.relname     AS "TABLE_NAME"
+                                                , CASE
+                                                        WHEN c.relkind = 'r' THEN 
+                                                               CASE WHEN n.nspname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END
+                                                        WHEN c.relkind = 'v' THEN 'VIEW'
+                                                        WHEN c.relkind = 'i' THEN 'INDEX'
+                                                        WHEN c.relkind = 'S' THEN 'SEQUENCE'
+                                                        WHEN c.relkind = 's' THEN 'SPECIAL'
+                                                        WHEN c.relkind = 't' THEN 'SECONDARY'
+                                                        ELSE 'UNKNOWN'
+                                                       END                      AS "TABLE_TYPE"
+                                                , d.description AS "REMARKS"
+                                       FROM ${CATALOG}pg_class         AS c
+                                               LEFT JOIN 
+                                                ${CATALOG}pg_description       AS d 
+                                                       ON (c.relfilenode = d.objoid AND d.objsubid = 0)
+                                               $schemajoin
+                                       WHERE 
+                                                 c.relname     !~ '^xin[vx][0-9]+'
+                                         $wh
+                                       ORDER BY 2, 3
+                                       };
+                               }
+                       }
+               }
+
+        my $sth = $dbh->prepare( $tbl_sql ) or return undef;
+        $sth->execute();
+
+        return $sth;
+    }
+
+
+    sub tables {
+        my($dbh) = @_;
+        my $version = DBD::Pg::pg_server_version($dbh);
+       $version =~ /^(\d+\.\d+)/;
+       $version = $1;
+       my $SQL = ($version < 7.3) ? 
+            "SELECT relname  AS \"TABLE_NAME\"
+            FROM   pg_class 
+            WHERE  relkind = 'r'
+            AND    relname !~ '^pg_'
+            AND    relname !~ '^xin[vx][0-9]+'
+            ORDER BY 1" : 
+            "SELECT n.nspname AS \"SCHEMA_NAME\", c.relname  AS \"TABLE_NAME\"
+            FROM   pg_catalog.pg_class c
+            LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)
+            WHERE  c.relkind = 'r'
+            AND n.nspname NOT IN ('pg_catalog', 'pg_toast')
+            AND pg_catalog.pg_table_is_visible(c.oid)
+            ORDER BY 1,2";
+        my $sth = $dbh->prepare($SQL) or return undef;
+        $sth->execute or return undef;
+        my (@tables, @relname);
+        while (@relname = $sth->fetchrow_array) {
+            push @tables, $version < 7.3 ? $relname[0] : "$relname[0].$relname[1]";
+        }
+        $sth->finish;
+
+        return @tables;
+    }
+
+
+    sub table_attributes {
+        my ($dbh, $table) = @_;
+        my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+        my $result = [];    
+        my $attrs  = $dbh->selectall_arrayref(
+             "select a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull, a.atthasdef, a.attnum
+              from ${CATALOG}pg_attribute a,
+                   ${CATALOG}pg_class     c,
+                   ${CATALOG}pg_type      t
+              where c.relname  = ?
+                and a.attrelid = c.oid
+                and a.attnum  >= 0
+                and t.oid      = a.atttypid
+                order by 1 
+             ", undef, $table);
+    
+        return $result unless scalar(@$attrs);
+
+       # Select the array value for tables primary key.
+       my $pk_key_sql = qq{SELECT pg_index.indkey
+                            FROM   ${CATALOG}pg_class, ${CATALOG}pg_index
+                            WHERE
+                                   pg_class.oid          = pg_index.indrelid
+                            AND    pg_class.relname      = '$table'
+                            AND    pg_index.indisprimary = 't'
+                       };
+       # Expand this (returned as a string) a real array.
+       my @pk = ();
+    my $pkeys = $dbh->selectrow_array( $pk_key_sql );
+    if (defined $pkeys) {
+       foreach (split( /\s+/, $pkeys))
+           {
+                   push @pk, $_;
+           }
+    }
+       my $pk_bt = 
+               (@pk)   ? "AND    pg_attribute.attnum in (" . join ( ", ", @pk ) . ")"
+                       : "";
+               
+        # Get the primary key
+        my $pri_key = $dbh->selectcol_arrayref("SELECT pg_attribute.attname
+                                               FROM   ${CATALOG}pg_class, ${CATALOG}pg_attribute, ${CATALOG}pg_index
+                                               WHERE  pg_class.oid          = pg_attribute.attrelid 
+                                               AND    pg_class.oid          = pg_index.indrelid 
+                                              $pk_bt
+                                               AND    pg_index.indisprimary = 't'
+                                               AND    pg_class.relname      = ?
+                                              ORDER BY pg_attribute.attnum
+                                              ", undef, $table );
+        $pri_key = [] unless $pri_key;
+
+        foreach my $attr (reverse @$attrs) {
+            my ($col_name, $col_type, $size, $mod, $notnull, $hasdef, $attnum) = @$attr;
+            my $col_size = do { 
+                if ($size > 0) {
+                    $size;
+                } elsif ($mod > 0xffff) {
+                    my $prec = ($mod & 0xffff) - 4;
+                    $mod >>= 16;
+                    my $dig = $mod;
+                    $dig;
+                } elsif ($mod >= 4) {
+                    $mod - 4;
+                } else {
+                    $mod;
+                }
+            };
+
+            # Get the default value, if any
+            my ($default) = $dbh->selectrow_array("SELECT adsrc FROM ${CATALOG}pg_attrdef WHERE  adnum = $attnum") if -1 == $attnum;
+            $default = '' unless $default;
+
+            # Test for any constraints
+            # Note: as of PostgreSQL 7.3 pg_relcheck has been replaced
+            # by pg_constraint. To maintain compatibility, check 
+            # version number and execute appropriate query.
+       
+            my $version = pg_server_version( $dbh );
+            
+            my $con_query = $version < 7.3
+             ? "SELECT rcsrc FROM pg_relcheck WHERE rcname = '${table}_$col_name'"
+             : "SELECT consrc FROM pg_catalog.pg_constraint WHERE contype = 'c' AND conname = '${table}_$col_name'";
+            my ($constraint) = $dbh->selectrow_array($con_query);
+            $constraint = '' unless $constraint;
+
+            # Check to see if this is the primary key
+            my $is_primary_key = scalar(grep { /^$col_name$/i } @$pri_key) ? 1 : 0;
+
+            push @$result,
+                { NAME        => $col_name,
+                  TYPE        => $col_type,
+                  SIZE        => $col_size,
+                  NOTNULL     => $notnull,
+                  DEFAULT     => $default,
+                  CONSTRAINT  => $constraint,
+                  PRIMARY_KEY => $is_primary_key,
+                };
+        }
+
+        return $result;
+    }
+
+
+    sub type_info_all {
+        my ($dbh) = @_;
+
+       #my $names = {
+    #      TYPE_NAME           => 0,
+    #      DATA_TYPE           => 1,
+    #      PRECISION           => 2,
+    #      LITERAL_PREFIX      => 3,
+    #      LITERAL_SUFFIX      => 4,
+    #      CREATE_PARAMS               => 5,
+    #      NULLABLE            => 6,
+    #      CASE_SENSITIVE      => 7,
+    #      SEARCHABLE          => 8,
+    #      UNSIGNED_ATTRIBUTE  => 9,
+    #      MONEY                       =>10,
+    #      AUTO_INCREMENT      =>11,
+    #      LOCAL_TYPE_NAME     =>12,
+    #      MINIMUM_SCALE               =>13,
+    #      MAXIMUM_SCALE               =>14,
+    #    };
+
+       my $names = {
+        TYPE_NAME         => 0,
+        DATA_TYPE         => 1,
+        COLUMN_SIZE       => 2,     # was PRECISION originally
+        LITERAL_PREFIX    => 3,
+        LITERAL_SUFFIX    => 4,
+        CREATE_PARAMS     => 5,
+        NULLABLE          => 6,
+        CASE_SENSITIVE    => 7,
+        SEARCHABLE        => 8,
+        UNSIGNED_ATTRIBUTE=> 9,
+        FIXED_PREC_SCALE  => 10,    # was MONEY originally
+        AUTO_UNIQUE_VALUE => 11,    # was AUTO_INCREMENT originally
+        LOCAL_TYPE_NAME   => 12,
+        MINIMUM_SCALE     => 13,
+        MAXIMUM_SCALE     => 14,
+        NUM_PREC_RADIX    => 15,
+    };
+
+
+       #  typname       |typlen|typprtlen|    SQL92
+       #  --------------+------+---------+    -------
+       #  bool          |     1|        1|    BOOLEAN
+       #  text          |    -1|       -1|    like VARCHAR, but automatic storage allocation
+       #  bpchar        |    -1|       -1|    CHARACTER(n)    bp=blank padded
+       #  varchar       |    -1|       -1|    VARCHAR(n)
+       #  int2          |     2|        5|    SMALLINT
+       #  int4          |     4|       10|    INTEGER
+       #  int8          |     8|       20|    /
+       #  money         |     4|       24|    /
+       #  float4        |     4|       12|    FLOAT(p)   for p<7=float4, for p<16=float8
+       #  float8        |     8|       24|    REAL
+       #  abstime       |     4|       20|    /
+       #  reltime       |     4|       20|    /
+       #  tinterval     |    12|       47|    /
+       #  date          |     4|       10|    /
+       #  time          |     8|       16|    /
+       #  datetime      |     8|       47|    /
+       #  timespan      |    12|       47|    INTERVAL
+       #  timestamp     |     4|       19|    TIMESTAMP
+       #  --------------+------+---------+
+
+        # DBI type definitions / PostgreSQL definitions     # type needs to be DBI-specific (not pg_type)
+        #
+        # SQL_ALL_TYPES  0     
+        # SQL_CHAR       1     1042 bpchar
+        # SQL_NUMERIC    2      700 float4
+        # SQL_DECIMAL    3      700 float4
+        # SQL_INTEGER    4       23 int4
+        # SQL_SMALLINT   5       21 int2
+        # SQL_FLOAT      6      700 float4
+        # SQL_REAL       7      701 float8
+        # SQL_DOUBLE     8       20 int8
+        # SQL_DATE       9     1082 date
+        # SQL_TIME      10     1083 time
+        # SQL_TIMESTAMP 11     1296 timestamp
+        # SQL_VARCHAR   12     1043 varchar
+
+       my $ti = [
+         $names,
+          # name          type  prec  prefix suffix  create params null case se unsign mon  incr       local   min    max
+          #                                         
+          [ 'bytea',        -2, 4096,  '\'',  '\'',           undef, 1, '1', 3, undef, '0', '0',     'BYTEA', undef, undef, undef ],
+          [ 'bool',          0,    1,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',   'BOOLEAN', undef, undef, undef ],
+          [ 'int8',          8,   20, undef, undef,           undef, 1, '0', 2,   '0', '0', '0',   'LONGINT', undef, undef, undef ],
+          [ 'int2',          5,    5, undef, undef,           undef, 1, '0', 2,   '0', '0', '0',  'SMALLINT', undef, undef, undef ],
+          [ 'int4',          4,   10, undef, undef,           undef, 1, '0', 2,   '0', '0', '0',   'INTEGER', undef, undef, undef ],
+          [ 'text',         12, 4096,  '\'',  '\'',           undef, 1, '1', 3, undef, '0', '0',      'TEXT', undef, undef, undef ],
+          [ 'float4',        6,   12, undef, undef,     'precision', 1, '0', 2,   '0', '0', '0',     'FLOAT', undef, undef, undef ],
+          [ 'float8',        7,   24, undef, undef,     'precision', 1, '0', 2,   '0', '0', '0',      'REAL', undef, undef, undef ],
+          [ 'abstime',      10,   20,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',   'ABSTIME', undef, undef, undef ],
+          [ 'reltime',      10,   20,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',   'RELTIME', undef, undef, undef ],
+          [ 'tinterval',    11,   47,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0', 'TINTERVAL', undef, undef, undef ],
+          [ 'money',         0,   24, undef, undef,           undef, 1, '0', 2, undef, '1', '0',     'MONEY', undef, undef, undef ],
+          [ 'bpchar',        1, 4096,  '\'',  '\'',    'max length', 1, '1', 3, undef, '0', '0', 'CHARACTER', undef, undef, undef ],
+          [ 'bpchar',       12, 4096,  '\'',  '\'',    'max length', 1, '1', 3, undef, '0', '0', 'CHARACTER', undef, undef, undef ],
+          [ 'varchar',      12, 4096,  '\'',  '\'',    'max length', 1, '1', 3, undef, '0', '0',   'VARCHAR', undef, undef, undef ],
+          [ 'date',          9,   10,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',      'DATE', undef, undef, undef ],
+          [ 'time',         10,   16,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',      'TIME', undef, undef, undef ],
+          [ 'datetime',     11,   47,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',  'DATETIME', undef, undef, undef ],
+          [ 'timespan',     11,   47,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0',  'INTERVAL', undef, undef, undef ],
+          [ 'timestamp',    10,   19,  '\'',  '\'',           undef, 1, '0', 2, undef, '0', '0', 'TIMESTAMP', undef, undef, undef ]
+          #
+          # intentionally omitted: char, all geometric types, all array types
+        ];
+       return $ti;
+    }
+
+
+    # Characters that need to be escaped by quote().
+    my %esc = ( "'"  => '\\047', # '\\' . sprintf("%03o", ord("'")), # ISO SQL 2
+                '\\' => '\\134', # '\\' . sprintf("%03o", ord("\\")),
+              );
+
+    # Set up lookup for SQL types we don't want to escape.
+    my %no_escape = map { $_ => 1 }
+      DBI::SQL_INTEGER, DBI::SQL_SMALLINT, DBI::SQL_DECIMAL,
+      DBI::SQL_FLOAT, DBI::SQL_REAL, DBI::SQL_DOUBLE, DBI::SQL_NUMERIC;
+
+    sub quote {
+        my ($dbh, $str, $data_type) = @_;
+        return "NULL" unless defined $str;
+               return $str if $data_type && $no_escape{$data_type};
+
+        $dbh->DBI::set_err(1, "Use of SQL_BINARY invalid in quote()")
+          if $data_type && $data_type == DBI::SQL_BINARY;
+
+               $str =~ s/(['\\\0])/$esc{$1}/g;
+               return "'$str'";
+    }
+
+}    # end of package DBD::Pg::db
+
+{   package DBD::Pg::st; # ====== STATEMENT ======
+
+    # all done in XS
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBD::Pg - PostgreSQL database driver for the DBI module
+
+=head1 SYNOPSIS
+
+  use DBI;
+
+  $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", "");
+
+  # for some advanced uses you may need PostgreSQL type values:
+  use DBD::Oracle qw(:pg_types);
+
+  # See the DBI module documentation for full details
+
+=head1 DESCRIPTION
+
+DBD::Pg is a Perl module which works with the DBI module to provide access to
+PostgreSQL databases.
+
+=head1 MODULE DOCUMENTATION
+
+This documentation describes driver specific behavior and restrictions. It is
+not supposed to be used as the only reference for the user. In any case
+consult the DBI documentation first!
+
+=head1 THE DBI CLASS
+
+=head2 DBI Class Methods
+
+=over 4
+
+=item B<connect>
+
+To connect to a database with a minimum of parameters, use the following
+syntax:
+
+  $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", "");
+
+This connects to the database $dbname at localhost without any user
+authentication. This is sufficient for the defaults of PostgreSQL.
+
+The following connect statement shows all possible parameters:
+
+  $dbh = DBI->connect("dbi:Pg:dbname=$dbname;host=$host;port=$port;" .
+                      "options=$options;tty=$tty", "$username", "$password");
+
+If a parameter is undefined PostgreSQL first looks for specific environment
+variables and then it uses hard coded defaults:
+
+    parameter  environment variable  hard coded default
+    --------------------------------------------------
+    dbname     PGDATABASE            current userid
+    host       PGHOST                localhost
+    port       PGPORT                5432
+    options    PGOPTIONS             ""
+    tty        PGTTY                 ""
+    username   PGUSER                current userid
+    password   PGPASSWORD            ""
+
+If a host is specified, the postmaster on this host needs to be started with
+the C<-i> option (TCP/IP sockets).
+
+The options parameter specifies runtime options for the Postgres
+backend. Common usage is to increase the number of buffers with the C<-B>
+option. Also important is the C<-F> option, which disables automatic fsync()
+call after each transaction. For further details please refer to the
+L<postgres>.
+
+For authentication with username and password appropriate entries have to be
+made in pg_hba.conf. Please refer to the L<pg_hba.conf> and the L<pg_passwd>
+for the different types of authentication. Note that for these two parameters
+DBI distinguishes between empty and undefined. If these parameters are
+undefined DBI substitutes the values of the environment variables DBI_USER and
+DBI_PASS if present.
+
+=item B<available_drivers>
+
+  @driver_names = DBI->available_drivers;
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<data_sources>
+
+  @data_sources = DBI->data_sources('Pg');
+
+The driver supports this method. Note that the necessary database connection to
+the database template1 will be done on the localhost without any
+user-authentication. Other preferences can only be set with the environment
+variables PGHOST, DBI_USER and DBI_PASS.
+
+=item B<trace>
+
+  DBI->trace($trace_level, $trace_file)
+
+Implemented by DBI, no driver-specific impact.
+
+=back
+
+=head2 DBI Dynamic Attributes
+
+See Common Methods.
+
+=head1 METHODS COMMON TO ALL HANDLES
+
+=over 4
+
+=item B<err>
+
+  $rv = $h->err;
+
+Supported by the driver as proposed by DBI. For the connect method it returns
+PQstatus. In all other cases it returns PQresultStatus of the current handle.
+
+=item B<errstr>
+
+  $str = $h->errstr;
+
+Supported by the driver as proposed by DBI. It returns the PQerrorMessage
+related to the current handle.
+
+=item B<state>
+
+  $str = $h->state;
+
+This driver does not (yet) support the state method.
+
+=item B<trace>
+
+  $h->trace($trace_level, $trace_filename);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<trace_msg>
+
+  $h->trace_msg($message_text);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<func>
+
+This driver supports a variety of driver specific functions accessible via the
+func interface:
+
+  $attrs = $dbh->func($table, 'table_attributes');
+
+This method returns for the given table a reference to an array of hashes:
+
+  NAME        attribute name
+  TYPE        attribute type
+  SIZE        attribute size (-1 for variable size)
+  NULLABLE    flag nullable
+  DEFAULT     default value
+  CONSTRAINT  constraint
+  PRIMARY_KEY flag is_primary_key
+
+  $lobjId = $dbh->func($mode, 'lo_creat');
+
+Creates a new large object and returns the object-id. $mode is a bit-mask
+describing different attributes of the new object. Use the following
+constants:
+
+  $dbh->{pg_INV_WRITE}
+  $dbh->{pg_INV_READ}
+
+Upon failure it returns undef.
+
+  $lobj_fd = $dbh->func($lobjId, $mode, 'lo_open');
+
+Opens an existing large object and returns an object-descriptor for use in
+subsequent lo_* calls. For the mode bits see lo_create. Returns undef upon
+failure. Note that 0 is a perfectly correct object descriptor!
+
+  $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_write');
+
+Writes $len bytes of $buf into the large object $lobj_fd. Returns the number
+of bytes written and undef upon failure.
+
+  $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_read');
+
+Reads $len bytes into $buf from large object $lobj_fd. Returns the number of
+bytes read and undef upon failure.
+
+  $loc = $dbh->func($lobj_fd, $offset, $whence, 'lo_lseek');
+
+Change the current read or write location on the large object
+$obj_id. Currently $whence can only be 0 (L_SET). Returns the current location
+and undef upon failure.
+
+  $loc = $dbh->func($lobj_fd, 'lo_tell');
+
+Returns the current read or write location on the large object $lobj_fd and
+undef upon failure.
+
+  $lobj_fd = $dbh->func($lobj_fd, 'lo_close');
+
+Closes an existing large object. Returns true upon success and false upon
+failure.
+
+  $lobj_fd = $dbh->func($lobj_fd, 'lo_unlink');
+
+Deletes an existing large object. Returns true upon success and false upon
+failure.
+
+  $lobjId = $dbh->func($filename, 'lo_import');
+
+Imports a Unix file as large object and returns the object id of the new
+object or undef upon failure.
+
+  $ret = $dbh->func($lobjId, 'lo_export', 'filename');
+
+Exports a large object into a Unix file. Returns false upon failure, true
+otherwise.
+
+  $ret = $dbh->func($line, 'putline');
+
+Used together with the SQL-command 'COPY table FROM STDIN' to copy large
+amount of data into a table avoiding the overhead of using single
+insert commands. The application must explicitly send the two characters "\."
+to indicate to the backend that it has finished sending its data. See test.pl
+for an example on how to use this function.
+
+  $ret = $dbh->func($buffer, length, 'getline');
+
+Used together with the SQL-command 'COPY table TO STDOUT' to dump a complete
+table. See test.pl for an example on how to use this function.
+
+  $ret = $dbh->func('pg_notifies');
+
+Returns either undef or a reference to two-element array [ $table,
+$backend_pid ] of asynchronous notifications received.
+
+  $fd = $dbh->func('getfd');
+
+Returns fd of the actual connection to server. Can be used with select() and
+func('pg_notifies').
+
+=back
+
+=head1 ATTRIBUTES COMMON TO ALL HANDLES
+
+=over 4
+
+=item B<Warn> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<Active> (boolean, read-only)
+
+Supported by the driver as proposed by DBI. A database handle is active while
+it is connected and statement handle is active until it is finished.
+
+=item B<Kids> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<ActiveKids> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<CachedKids> (hash ref)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<CompatMode> (boolean, inherited)
+
+Not used by this driver.
+
+=item B<InactiveDestroy> (boolean)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<PrintError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<RaiseError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<HandleError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<ChopBlanks> (boolean, inherited)
+
+Supported by the driver as proposed by DBI. This method is similar to the
+SQL-function RTRIM.
+
+=item B<LongReadLen> (integer, inherited)
+
+Implemented by DBI, not used by the driver.
+
+=item B<LongTruncOk> (boolean, inherited)
+
+Implemented by DBI, not used by the driver.
+
+=item B<Taint> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<private_*>
+
+Implemented by DBI, no driver-specific impact.
+
+=back
+
+=head1 DBI DATABASE HANDLE OBJECTS
+
+=head2 Database Handle Methods
+
+=over 4
+
+=item B<selectrow_array>
+
+  @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectrow_arrayref>
+
+  $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectrow_hashref>
+
+  $hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectall_arrayref>
+
+  $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectall_hashref>
+
+  $hash_ref = $dbh->selectall_hashref($statement, $key_field);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectcol_arrayref>
+
+  $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<prepare>
+
+  $sth = $dbh->prepare($statement, \%attr);
+
+PostgreSQL does not have the concept of preparing a statement. Hence the
+prepare method just stores the statement after checking for place-holders. No
+information about the statement is available after preparing it.
+
+=item B<prepare_cached>
+
+  $sth = $dbh->prepare_cached($statement, \%attr);
+
+Implemented by DBI, no driver-specific impact. This method is not useful for
+this driver, because preparing a statement has no database interaction.
+
+=item B<do>
+
+  $rv  = $dbh->do($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact. See the notes for the execute
+method elsewhere in this document.
+
+=item B<commit>
+
+  $rc  = $dbh->commit;
+
+Supported by the driver as proposed by DBI. See also the notes about
+B<Transactions> elsewhere in this document.
+
+=item B<rollback>
+
+  $rc  = $dbh->rollback;
+
+Supported by the driver as proposed by DBI. See also the notes about
+B<Transactions> elsewhere in this document.
+
+=item B<disconnect>
+
+  $rc  = $dbh->disconnect;
+
+Supported by the driver as proposed by DBI.
+
+=item B<ping>
+
+  $rc = $dbh->ping;
+
+This driver supports the ping-method, which can be used to check the validity
+of a database-handle. The ping method issues an empty query and checks the
+result status.
+
+=item B<table_info>
+
+  $sth = $dbh->table_info;
+
+Supported by the driver as proposed by DBI. This method returns all tables and
+views which are owned by the current user. It does not select any indexes and
+sequences. Also System tables are not selected. As TABLE_QUALIFIER the reltype
+attribute is returned and the REMARKS are undefined.
+
+=item B<foreign_key_info>
+
+  $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table,
+                                 $fk_catalog, $fk_schema, $fk_table );
+
+Supported by the driver as proposed by DBI. Unimplemented for Postgres
+servers before 7.3 (returns undef).  Currently only returns information
+about first column of any multiple-column keys.
+
+=item B<tables>
+
+  @names = $dbh->tables;
+
+Supported by the driver as proposed by DBI. This method returns all tables and
+views which are owned by the current user. It does not select any indexes and
+sequences, or system tables.
+
+=item B<type_info_all>
+
+  $type_info_all = $dbh->type_info_all;
+
+Supported by the driver as proposed by DBI. Only for SQL data-types and for
+frequently used data-types information is provided. The mapping between the
+PostgreSQL typename and the SQL92 data-type (if possible) has been done
+according to the following table:
+
+       +---------------+------------------------------------+
+       | typname       | SQL92                              |
+       |---------------+------------------------------------|
+       | bool          | BOOL                               |
+       | text          | /                                  |
+       | bpchar        | CHAR(n)                            |
+       | varchar       | VARCHAR(n)                         |
+       | int2          | SMALLINT                           |
+       | int4          | INT                                |
+       | int8          | /                                  |
+       | money         | /                                  |
+       | float4        | FLOAT(p)   p<7=float4, p<16=float8 |
+       | float8        | REAL                               |
+       | abstime       | /                                  |
+       | reltime       | /                                  |
+       | tinterval     | /                                  |
+       | date          | /                                  |
+       | time          | /                                  |
+       | datetime      | /                                  |
+       | timespan      | TINTERVAL                          |
+       | timestamp     | TIMESTAMP                          |
+       +---------------+------------------------------------+
+
+For further details concerning the PostgreSQL specific data-types please read
+the L<pgbuiltin>.
+
+=item B<type_info>
+
+  @type_info = $dbh->type_info($data_type);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<quote>
+
+  $sql = $dbh->quote($value, $data_type);
+
+This module implements its own quote method. In addition to the DBI method it
+also doubles the backslash, because PostgreSQL treats a backslash as an escape
+character.
+
+B<NOTE:> The undocumented (and invalid) support for the C<SQL_BINARY> data
+type is officially deprecated. Use C<PG_BYTEA> with C<bind_param()> instead:
+
+  $rv = $sth->bind_param($param_num, $bind_value,
+                         { pg_type => DBD::Pg::PG_BYTEA });
+
+=back
+
+=head2 Database Handle Attributes
+
+=over 4
+
+=item B<AutoCommit>  (boolean)
+
+Supported by the driver as proposed by DBI. According to the classification of
+DBI, PostgreSQL is a database, in which a transaction must be explicitly
+started. Without starting a transaction, every change to the database becomes
+immediately permanent. The default of AutoCommit is on, which corresponds to
+the default behavior of PostgreSQL. When setting AutoCommit to off, a
+transaction will be started and every commit or rollback will automatically
+start a new transaction. For details see the notes about B<Transactions>
+elsewhere in this document.
+
+=item B<Driver>  (handle)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<Name>  (string, read-only)
+
+The default method of DBI is overridden by a driver specific method, which
+returns only the database name. Anything else from the connection string is
+stripped off. Note, that here the method is read-only in contrast to the DBI
+specs.
+
+=item B<RowCacheSize>  (integer)
+
+Implemented by DBI, not used by the driver.
+
+=item B<pg_auto_escape> (boolean)
+
+PostgreSQL specific attribute. If true, then quotes and backslashes in all
+parameters will be escaped in the following way:
+
+  escape quote with a quote (SQL)
+  escape backslash with a backslash
+
+The default is on. Note, that PostgreSQL also accepts quotes, which are
+escaped by a backslash. Any other ASCII character can be used directly in a
+string constant.
+
+=item B<pg_enable_utf8> (boolean)
+
+PostgreSQL specific attribute.  If true, then the utf8 flag will be
+turned for returned character data (if the data is valid utf8).  For
+details about the utf8 flag, see L<Encode>.  This is only relevant under
+perl 5.8 and higher.
+
+B<NB>: This attribute is experimental and may be subject to change.
+
+=item B<pg_INV_READ> (integer, read-only)
+
+Constant to be used for the mode in lo_creat and lo_open.
+
+=item B<pg_INV_WRITE> (integer, read-only)
+
+Constant to be used for the mode in lo_creat and lo_open.
+
+=back
+
+=head1 DBI STATEMENT HANDLE OBJECTS
+
+=head2 Statement Handle Methods
+
+=over 4
+
+=item B<bind_param>
+
+  $rv = $sth->bind_param($param_num, $bind_value, \%attr);
+
+Supported by the driver as proposed by DBI.
+
+B<NOTE:> The undocumented (and invalid) support for the C<SQL_BINARY>
+SQL type is officially deprecated. Use C<PG_BYTEA> instead:
+
+  $rv = $sth->bind_param($param_num, $bind_value,
+                         { pg_type => DBD::Pg::PG_BYTEA });
+
+=item B<bind_param_inout>
+
+Not supported by this driver.
+
+=item B<execute>
+
+  $rv = $sth->execute(@bind_values);
+
+Supported by the driver as proposed by DBI. In addition to 'UPDATE', 'DELETE',
+'INSERT' statements, for which it returns always the number of affected rows,
+the execute method can also be used for 'SELECT ... INTO table' statements.
+
+=item B<fetchrow_arrayref>
+
+  $ary_ref = $sth->fetchrow_arrayref;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchrow_array>
+
+  @ary = $sth->fetchrow_array;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchrow_hashref>
+
+  $hash_ref = $sth->fetchrow_hashref;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchall_arrayref>
+
+  $tbl_ary_ref = $sth->fetchall_arrayref;
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<finish>
+
+  $rc = $sth->finish;
+
+Supported by the driver as proposed by DBI.
+
+=item B<rows>
+
+  $rv = $sth->rows;
+
+Supported by the driver as proposed by DBI. In contrast to many other drivers
+the number of rows is available immediately after executing the statement.
+
+=item B<bind_col>
+
+  $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr);
+
+Supported by the driver as proposed by DBI.
+
+=item B<bind_columns>
+
+  $rc = $sth->bind_columns(\%attr, @list_of_refs_to_vars_to_bind);
+
+Supported by the driver as proposed by DBI.
+
+=item B<dump_results>
+
+  $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<blob_read>
+
+  $blob = $sth->blob_read($id, $offset, $len);
+
+Supported by this driver as proposed by DBI. Implemented by DBI but not
+documented, so this method might change.
+
+This method seems to be heavily influenced by the current implementation of
+blobs in Oracle. Nevertheless we try to be as compatible as possible. Whereas
+Oracle suffers from the limitation that blobs are related to tables and every
+table can have only one blob (data-type LONG), PostgreSQL handles its blobs
+independent of any table by using so called object identifiers. This explains
+why the blob_read method is blessed into the STATEMENT package and not part of
+the DATABASE package. Here the field parameter has been used to handle this
+object identifier. The offset and len parameter may be set to zero, in which
+case the driver fetches the whole blob at once.
+
+Starting with PostgreSQL-6.5 every access to a blob has to be put into a
+transaction. This holds even for a read-only access.
+
+See also the PostgreSQL-specific functions concerning blobs which are
+available via the func-interface.
+
+For further information and examples about blobs, please read the chapter
+about Large Objects in the PostgreSQL Programmer's Guide.
+
+=back
+
+=head2 Statement Handle Attributes
+
+=over 4
+
+=item B<NUM_OF_FIELDS>  (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NUM_OF_PARAMS>  (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NAME>  (array-ref, read-only)
+
+Supported by the driver as proposed by DBI.
+
+=item B<NAME_lc>  (array-ref, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NAME_uc>  (array-ref, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<TYPE>  (array-ref, read-only)
+
+Supported by the driver as proposed by DBI, with the restriction, that the
+types are PostgreSQL specific data-types which do not correspond to
+international standards.
+
+=item B<PRECISION>  (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<SCALE>  (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<NULLABLE>  (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<CursorName>  (string, read-only)
+
+Not supported by the driver. See the note about B<Cursors> elsewhere in this
+document.
+
+=item B<Statement>  (string, read-only)
+
+Supported by the driver as proposed by DBI.
+
+=item B<RowCache>  (integer, read-only)
+
+Not supported by the driver.
+
+=item B<pg_size>  (array-ref, read-only)
+
+PostgreSQL specific attribute. It returns a reference to an array of integer
+values for each column. The integer shows the size of the column in
+bytes. Variable length columns are indicated by -1.
+
+=item B<pg_type>  (hash-ref, read-only)
+
+PostgreSQL specific attribute. It returns a reference to an array of strings
+for each column. The string shows the name of the data_type.
+
+=item B<pg_oid_status> (integer, read-only)
+
+PostgreSQL specific attribute. It returns the OID of the last INSERT command.
+
+=item B<pg_cmd_status> (integer, read-only)
+
+PostgreSQL specific attribute. It returns the type of the last
+command. Possible types are: INSERT, DELETE, UPDATE, SELECT.
+
+=back
+
+=head1 FURTHER INFORMATION
+
+=head2 Transactions
+
+The transaction behavior is now controlled with the attribute AutoCommit. For
+a complete definition of AutoCommit please refer to the DBI documentation.
+
+According to the DBI specification the default for AutoCommit is TRUE. In this
+mode, any change to the database becomes valid immediately. Any 'begin',
+'commit' or 'rollback' statement will be rejected.
+
+If AutoCommit is switched-off, immediately a transaction will be started by
+issuing a 'begin' statement. Any 'commit' or 'rollback' will start a new
+transaction. A disconnect will issue a 'rollback' statement.
+
+=head2 Large Objects
+
+The driver supports all large-objects related functions provided by libpq via
+the func-interface. Please note, that starting with PostgreSQL 6.5 any access
+to a large object - even read-only - has to be put into a transaction!
+
+=head2 Cursors
+
+Although PostgreSQL has a cursor concept, it has not been used in the current
+implementation. Cursors in PostgreSQL can only be used inside a transaction
+block. Because only one transaction block at a time is allowed, this would
+have implied the restriction, not to use any nested SELECT statements. Hence
+the execute method fetches all data at once into data structures located in
+the frontend application. This has to be considered when selecting large
+amounts of data!
+
+=head2 Data-Type bool
+
+The current implementation of PostgreSQL returns 't' for true and 'f' for
+false. From the Perl point of view a rather unfortunate choice. The DBD::Pg
+module translates the result for the data-type bool in a perl-ish like manner:
+'f' -> '0' and 't' -> '1'. This way the application does not have to check the
+database-specific returned values for the data-type bool, because Perl treats
+'0' as false and '1' as true.
+
+Boolean values can be passed to PostgreSQL as TRUE, 't', 'true', 'y', 'yes' or
+'1' for true and FALSE, 'f', 'false', 'n', 'no' or '0' for false.
+
+=head2 Schema support
+
+PostgreSQL version 7.3 introduced schema support. Note that the PostgreSQL
+schema concept may differ to that of other databases. Please refer to the
+PostgreSQL documentation for more details.
+
+Currently DBD::Pg does not provide explicit support for PostgreSQL schemas.
+However, schema functionality may be used without any restrictions by
+explicitly addressing schema objects, e.g.
+
+  my $res = $dbh->selectall_arrayref("SELECT * FROM my_schema.my_table");
+
+or by manipulating the schema search path with SET search_path, e.g.
+
+  $dbh->do("SET search_path TO my_schema, public");
+
+B<NOTE:> If you create an object with the same name as a PostgreSQL system
+object (as contained in the pg_catalog schema) and explicitly set the search
+path so that pg_catalog comes after the new object's schema, some DBD::Pg
+methods (particularly those querying PostgreSQL system objects) may fail.
+This problem should be fixed in a future release of DBD::Pg. Creating objects
+with the same name as system objects (or beginning with 'pg_') is not
+recommended practice and should be avoided in any case.
+
+=head1 SEE ALSO
+
+L<DBI>
+
+=head1 AUTHORS
+
+DBI and DBD-Oracle by Tim Bunce (Tim.Bunce@ig.co.uk)
+
+DBD-Pg by Edmund Mergl (E.Mergl@bawue.de) and Jeffrey W. Baker
+(jwbaker@acm.org). By David Wheeler <david@wheeler.net>, Jason
+Stewart <jason@openinformatics.com> and Bruce Momjian
+<pgman@candle.pha.pa.us> after v1.13.
+
+Major parts of this package have been copied from DBI and DBD-Oracle.
+
+=head1 COPYRIGHT
+
+The DBD::Pg module is free software. You may distribute under the terms of
+either the GNU General Public License or the Artistic License, as specified in
+the Perl README file.
+
+=head1 ACKNOWLEDGMENTS
+
+See also B<DBI/ACKNOWLEDGMENTS>.
+
+=cut
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs
new file mode 100644 (file)
index 0000000..e5e4362
--- /dev/null
@@ -0,0 +1,644 @@
+/*
+   $Id: Pg.xs,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+   Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+   Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+   You may distribute under the terms of either the GNU General Public
+   License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+#include "Pg.h"
+
+
+#ifdef _MSC_VER
+#define strncasecmp(a,b,c) _strnicmp((a),(b),(c))
+#endif
+
+
+
+DBISTATE_DECLARE;
+
+
+MODULE = DBD::Pg       PACKAGE = DBD::Pg
+
+I32
+constant(name=Nullch)
+    char *name
+    PROTOTYPE:
+    ALIAS:
+    PG_BOOL      = 16
+    PG_BYTEA     = 17
+    PG_CHAR      = 18
+    PG_INT8      = 20
+    PG_INT2      = 21
+    PG_INT4      = 23
+    PG_TEXT      = 25
+    PG_OID       = 26
+    PG_FLOAT4    = 700
+    PG_FLOAT8    = 701
+    PG_ABSTIME   = 702
+    PG_RELTIME   = 703
+    PG_TINTERVAL = 704
+    PG_BPCHAR    = 1042
+    PG_VARCHAR   = 1043
+    PG_DATE      = 1082
+    PG_TIME      = 1083
+    PG_DATETIME  = 1184
+    PG_TIMESPAN  = 1186
+    PG_TIMESTAMP = 1296
+    CODE:
+    if (!ix) {
+       if (!name) name = GvNAME(CvGV(cv));
+       croak("Unknown DBD::Pg constant '%s'", name);
+    }
+    else RETVAL = ix;
+    OUTPUT:
+    RETVAL
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    items = 0;  /* avoid 'unused variable' warning */
+    DBISTATE_INIT;
+    /* XXX this interface will change: */
+    DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t));
+    DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t));
+    DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t));
+    dbd_init(DBIS);
+
+
+# ------------------------------------------------------------
+# driver level interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg       PACKAGE = DBD::Pg::dr
+
+# disconnect_all renamed and ALIASed to avoid length clash on VMS :-(
+void
+discon_all_(drh)
+    SV *       drh
+    ALIAS:
+        disconnect_all = 1
+    CODE:
+    D_imp_drh(drh);
+    ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
+
+
+
+# ------------------------------------------------------------
+# database level interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg       PACKAGE = DBD::Pg::db
+
+void
+_login(dbh, dbname, username, pwd)
+    SV *       dbh
+    char *     dbname
+    char *     username
+    char *     pwd
+    CODE:
+    D_imp_dbh(dbh);
+    ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no;
+
+
+int
+_ping(dbh)
+    SV *       dbh
+    CODE:
+    int ret;
+    ret = dbd_db_ping(dbh);
+    if (ret == 0) {
+        XST_mUNDEF(0);
+    }
+    else {
+        XST_mIV(0, ret);
+    }
+
+void
+getfd(dbh)
+    SV *       dbh
+    CODE:
+    int ret;
+    D_imp_dbh(dbh);
+
+    ret = dbd_db_getfd(dbh, imp_dbh);
+    ST(0) = sv_2mortal( newSViv( ret ) );
+
+void
+pg_notifies(dbh)
+    SV *       dbh
+    CODE:
+    D_imp_dbh(dbh);
+
+    ST(0) = dbd_db_pg_notifies(dbh, imp_dbh);
+
+void
+commit(dbh)
+    SV *       dbh
+    CODE:
+    D_imp_dbh(dbh);
+    if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
+        warn("commit ineffective with AutoCommit enabled");
+    }
+    ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+rollback(dbh)
+    SV *       dbh
+    CODE:
+    D_imp_dbh(dbh);
+    if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
+        warn("rollback ineffective with AutoCommit enabled");
+    }
+    ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+disconnect(dbh)
+    SV *       dbh
+    CODE:
+    D_imp_dbh(dbh);
+    if ( !DBIc_ACTIVE(imp_dbh) ) {
+        XSRETURN_YES;
+    }
+    /* pre-disconnect checks and tidy-ups */
+    if (DBIc_CACHED_KIDS(imp_dbh)) {
+        SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
+        DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
+    }
+    /* Check for disconnect() being called whilst refs to cursors      */
+    /* still exists. This possibly needs some more thought.            */
+    if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
+        char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s";
+        warn("disconnect(%s) invalidates %d active statement%s. %s",
+            SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
+            "Either destroy statement handles or call finish on them before disconnecting.");
+    }
+    ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+STORE(dbh, keysv, valuesv)
+    SV *       dbh
+    SV *       keysv
+    SV *       valuesv
+    CODE:
+    D_imp_dbh(dbh);
+    ST(0) = &sv_yes;
+    if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) {
+        if (!DBIS->set_attr(dbh, keysv, valuesv)) {
+            ST(0) = &sv_no;
+        }
+    }
+
+
+void
+FETCH(dbh, keysv)
+    SV *       dbh
+    SV *       keysv
+    CODE:
+    D_imp_dbh(dbh);
+    SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
+    if (!valuesv) {
+        valuesv = DBIS->get_attr(dbh, keysv);
+    }
+    ST(0) = valuesv;   /* dbd_db_FETCH_attrib did sv_2mortal   */
+
+
+void
+DESTROY(dbh)
+    SV *       dbh
+    PPCODE:
+    D_imp_dbh(dbh);
+    ST(0) = &sv_yes;
+    if (!DBIc_IMPSET(imp_dbh)) {       /* was never fully set up       */
+        if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) {
+            warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na));
+        }
+    }
+    else {
+       /* pre-disconnect checks and tidy-ups */
+        if (DBIc_CACHED_KIDS(imp_dbh)) {
+            SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
+            DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
+        }
+        if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy    */
+            DBIc_ACTIVE_off(imp_dbh);
+        }
+        if (DBIc_ACTIVE(imp_dbh)) {
+            if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) {
+                warn("Database handle destroyed without explicit disconnect");
+            }
+           /* The application has not explicitly disconnected. That's bad.     */
+           /* To ensure integrity we *must* issue a rollback. This will be     */
+           /* harmless if the application has issued a commit. If it hasn't    */
+           /* then it'll ensure integrity. Consider a Ctrl-C killing perl      */
+           /* between two statements that must be executed as a transaction.   */
+           /* Perl will call DESTROY on the dbh and, if we don't rollback,     */
+           /* the server will automatically commit! Bham! Corrupt database!    */
+            if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
+                dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
+            }
+            dbd_db_disconnect(dbh, imp_dbh);
+        }
+        dbd_db_destroy(dbh, imp_dbh);
+    }
+
+
+# driver specific functions
+
+
+void
+lo_open(dbh, lobjId, mode)
+    SV *       dbh
+    unsigned int       lobjId
+    int        mode
+    CODE:
+        int ret = pg_db_lo_open(dbh, lobjId, mode);
+        ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+void
+lo_close(dbh, fd)
+    SV *       dbh
+    int        fd
+    CODE:
+        ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no;
+
+
+void
+lo_read(dbh, fd, buf, len)
+           SV *        dbh
+           int fd
+           char *      buf
+           int len
+       PREINIT:
+           SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
+           int ret;
+       CODE:
+           buf = SvGROW(bufsv, len + 1);
+           ret = pg_db_lo_read(dbh, fd, buf, len);
+           if (ret > 0) {
+               SvCUR_set(bufsv, ret);
+               *SvEND(bufsv) = '\0';
+               sv_setpvn(ST(2), buf, ret);
+               SvSETMAGIC(ST(2));
+           }
+           ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_write(dbh, fd, buf, len)
+    SV *       dbh
+    int        fd
+    char *     buf
+    int        len
+    CODE:
+        int ret = pg_db_lo_write(dbh, fd, buf, len);
+        ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_lseek(dbh, fd, offset, whence)
+    SV *       dbh
+    int        fd
+    int        offset
+    int        whence
+    CODE:
+        int ret = pg_db_lo_lseek(dbh, fd, offset, whence);
+        ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_creat(dbh, mode)
+    SV *       dbh
+    int        mode
+    CODE:
+        int ret = pg_db_lo_creat(dbh, mode);
+        ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_tell(dbh, fd)
+    SV *       dbh
+    int        fd
+    CODE:
+        int ret = pg_db_lo_tell(dbh, fd);
+        ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_unlink(dbh, lobjId)
+    SV *       dbh
+    unsigned int       lobjId
+    CODE:
+        ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no;
+
+
+void
+lo_import(dbh, filename)
+    SV *       dbh
+    char *     filename
+    CODE:
+        unsigned int ret = pg_db_lo_import(dbh, filename);
+        ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_export(dbh, lobjId, filename)
+    SV *       dbh
+    unsigned int       lobjId
+    char *     filename
+    CODE:
+        ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no;
+
+
+void
+putline(dbh, buf)
+    SV *       dbh
+    char *     buf
+    CODE:
+        int ret = pg_db_putline(dbh, buf);
+        ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
+
+
+void
+getline(dbh, buf, len)
+    PREINIT:
+        SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+    INPUT:
+        SV *   dbh
+        int    len
+        char * buf = sv_grow(bufsv, len);
+    CODE:
+        int ret = pg_db_getline(dbh, buf, len);
+        if (*buf == '\\' && *(buf+1) == '.') {
+            ret = -1;
+        }
+       sv_setpv((SV*)ST(1), buf);
+       SvSETMAGIC(ST(1));
+        ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
+
+
+void
+endcopy(dbh)
+    SV *       dbh
+    CODE:
+        ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no;
+
+
+# -- end of DBD::Pg::db
+
+
+# ------------------------------------------------------------
+# statement interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg       PACKAGE = DBD::Pg::st
+
+void
+_prepare(sth, statement, attribs=Nullsv)
+    SV *       sth
+    char *     statement
+    SV *       attribs
+    CODE:
+    {
+    D_imp_sth(sth);
+    D_imp_dbh_from_sth;
+    DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
+    if (!strncasecmp(statement, "begin",    5) ||
+        !strncasecmp(statement, "end",      4) ||
+        !strncasecmp(statement, "commit",   6) ||
+        !strncasecmp(statement, "abort",    5) ||
+        !strncasecmp(statement, "rollback", 8) ) {
+        warn("please use DBI functions for transaction handling");
+        ST(0) = &sv_no;
+    } else {
+        ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
+    }
+    }
+
+
+void
+rows(sth)
+    SV *       sth
+    CODE:
+    D_imp_sth(sth);
+    XST_mIV(0, dbd_st_rows(sth, imp_sth));
+
+
+void
+bind_param(sth, param, value, attribs=Nullsv)
+    SV *       sth
+    SV *       param
+    SV *       value
+    SV *       attribs
+    CODE:
+    {
+    IV sql_type = 0;
+    D_imp_sth(sth);
+    if (attribs) {
+        if (SvNIOK(attribs)) {
+            sql_type = SvIV(attribs);
+            attribs = Nullsv;
+        }
+        else {
+            SV **svp;
+            DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+           /* XXX we should perhaps complain if TYPE is not SvNIOK */
+            DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
+        }
+    }
+    ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no;
+    }
+
+
+void
+bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
+    SV *       sth
+    SV *       param
+    SV *       value_ref
+    IV                 maxlen
+    SV *       attribs
+    CODE:
+    {
+    IV sql_type = 0;
+    D_imp_sth(sth);
+    if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) {
+        croak("bind_param_inout needs a reference to a scalar value");
+    }
+    if (SvREADONLY(SvRV(value_ref))) {
+       croak(no_modify);
+    }
+    if (attribs) {
+        if (SvNIOK(attribs)) {
+            sql_type = SvIV(attribs);
+            attribs = Nullsv;
+        }
+        else {
+            SV **svp;
+            DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+            DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
+        }
+    }
+    ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no;
+    }
+
+
+void
+execute(sth, ...)
+    SV *       sth
+    CODE:
+    D_imp_sth(sth);
+    int ret;
+    if (items > 1) {
+       /* Handle binding supplied values to placeholders       */
+        int i;
+        SV *idx;
+        imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */
+        if (items-1 != DBIc_NUM_PARAMS(imp_sth)) {
+            croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth));
+            XSRETURN_UNDEF;
+        }
+        idx = sv_2mortal(newSViv(0));
+        for(i=1; i < items ; ++i) {
+            sv_setiv(idx, i);
+            if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) {
+               XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
+            }
+        }
+    }
+    ret = dbd_st_execute(sth, imp_sth);
+    /* remember that dbd_st_execute must return <= -2 for error        */
+    if (ret == 0) {            /* ok with no rows affected     */
+        XST_mPV(0, "0E0");     /* (true but zero)              */
+    }
+    else if (ret < -1) {       /* -1 == unknown number of rows */
+        XST_mUNDEF(0);         /* <= -2 means error            */
+    }
+    else {
+        XST_mIV(0, ret);       /* typically 1, rowcount or -1  */
+    }
+
+
+void
+fetchrow_arrayref(sth)
+    SV *       sth
+    ALIAS:
+        fetch = 1
+    CODE:
+    D_imp_sth(sth);
+    AV *av = dbd_st_fetch(sth, imp_sth);
+    ST(0) = (av) ? sv_2mortal(newRV_inc((SV *)av)) : &sv_undef;
+
+
+void
+fetchrow_array(sth)
+    SV *       sth
+    ALIAS:
+        fetchrow = 1
+    PPCODE:
+    D_imp_sth(sth);
+    AV *av;
+    av = dbd_st_fetch(sth, imp_sth);
+    if (av) {
+        int num_fields = AvFILL(av)+1;
+        int i;
+        EXTEND(sp, num_fields);
+        for(i=0; i < num_fields; ++i) {
+            PUSHs(AvARRAY(av)[i]);
+        }
+    }
+
+
+void
+finish(sth)
+    SV *       sth
+    CODE:
+    D_imp_sth(sth);
+    D_imp_dbh_from_sth;
+    if (!DBIc_ACTIVE(imp_dbh)) {
+       /* Either an explicit disconnect() or global destruction        */
+       /* has disconnected us from the database. Finish is meaningless */
+       /* XXX warn */
+        XSRETURN_YES;
+    }
+    if (!DBIc_ACTIVE(imp_sth)) {
+       /* No active statement to finish        */
+        XSRETURN_YES;
+    }
+    ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
+
+
+void
+blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
+    SV *        sth
+    int field
+    long        offset
+    long        len
+    SV *        destrv
+    long        destoffset
+    CODE:
+    {
+    D_imp_sth(sth);
+    if (!destrv) {
+        destrv = sv_2mortal(newRV_inc(sv_2mortal(newSViv(0))));
+    }
+    ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef;
+    }
+
+void
+STORE(sth, keysv, valuesv)
+    SV *       sth
+    SV *       keysv
+    SV *       valuesv
+    CODE:
+    D_imp_sth(sth);
+    ST(0) = &sv_yes;
+    if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) {
+        if (!DBIS->set_attr(sth, keysv, valuesv)) {
+            ST(0) = &sv_no;
+        }
+    }
+
+
+# FETCH renamed and ALIASed to avoid case clash on VMS :-(
+void
+FETCH_attrib(sth, keysv)
+    SV *       sth
+    SV *       keysv
+    ALIAS:
+    FETCH = 1
+    CODE:
+    D_imp_sth(sth);
+    SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
+    if (!valuesv) {
+        valuesv = DBIS->get_attr(sth, keysv);
+    }
+    ST(0) = valuesv;   /* dbd_st_FETCH_attrib did sv_2mortal   */
+
+
+void
+DESTROY(sth)
+    SV *       sth
+    PPCODE:
+    D_imp_sth(sth);
+    ST(0) = &sv_yes;
+    if (!DBIc_IMPSET(imp_sth)) {       /* was never fully set up       */
+        if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) {
+            warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na));
+        }
+    }
+    else {
+        if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy    */
+            DBIc_ACTIVE_off(imp_sth);
+        }
+        if (DBIc_ACTIVE(imp_sth)) {
+            dbd_st_finish(sth, imp_sth);
+        }
+        dbd_st_destroy(sth, imp_sth);
+    }
+
+
+# end of Pg.xs
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/README b/install/5.005/DBD-Pg-1.22-fixvercmp/README
new file mode 100644 (file)
index 0000000..7edebde
--- /dev/null
@@ -0,0 +1,166 @@
+
+DBD::Pg  --  the DBI PostgreSQL interface for Perl
+
+# $Id: README,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+DESCRIPTION:
+------------
+
+This is version 1.21 of DBD-Pg.  The web site for this interface is at:
+
+       http://gborg.postgresql.org/project/dbdpg/projdisplay.php
+
+For further information about DBI look at:
+
+       http://dbi.perl.org/
+
+For information about PostgreSQL, visit:
+    
+       http://www.postgresql.org/
+
+COPYRIGHT:
+----------
+
+       Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+       Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+       Copyright (c) 2002 Jeffrey W. Baker
+       Copyright (c) 2002 PostgreSQL Global Development Group
+   
+You may distribute under the terms of either the GNU General Public
+License or the Artistic License, as specified in the Perl README file.
+
+
+HOW TO GET THE LATEST VERSION:
+------------------------------
+
+Use the following URL to look for new versions of this module: 
+
+       http://gborg.postgresql.org/project/dbdpg/projdisplay.php
+
+or
+
+       http://www.perl.com/CPAN/modules/by-module/DBD/
+
+Note, that this request will be redirected automatically to the 
+nearest CPAN site. 
+
+
+IF YOU HAVE PROBLEMS:
+---------------------
+
+Please send comments and bug-reports to <dbd-general@gborg.postgresql.org>
+
+Please include the output of perl -v and perl -V, the version of PostgreSQL,
+the version of DBD-Pg, the version of DBI, and details about your platform
+in your bug-report.
+
+
+REQUIREMENTS:
+-------------
+
+       build, test, and install Perl 5         (at least 5.005)
+       build, test, and install the DBI module (at least 1.30)
+       build, test, and install PostgreSQL     (at least 7.3)
+        build, test, and install Test::Simple   (at least 0.17)
+
+INSTALLATION:
+-------------
+
+By default Makefile.PL uses App:Info to find the location of the
+PostgreSQL library and include directories.  However, if you want to
+control it yourself, define the environment variables POSTGRES_INCLUDE
+and POSTGRES_LIB, or POSTGRES_HOME.
+
+       1.   perl Makefile.PL
+       2.   make
+       3.   make test
+       4.   make install
+
+Do steps 1 to 3 as normal user, not as root!
+
+
+TESTING:
+--------
+
+The tests are designed to connect to a live database.  The following
+environment variables must be set for the tests to run:
+
+        DBI_DSN=dbi:Pg:dbname=<database>
+        DBI_USER=<username>
+        DBI_PASS=<password>
+
+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: 
+
+       install_driver(Pg) failed: Can't load './blib/arch/auto/DBD/Pg/Pg.so' 
+       for module DBD::Pg: File not found at 
+
+If you get an error message like:
+
+       perl: error while loading shared libraries:
+       /usr/lib/perl5/site_perl/5.6.0/i386-linux/auto/DBD/Pg/Pg.so: undefined
+       symbol: PQconnectdb
+
+when you call DBI->connect, then your libpq.so was probably not seen at
+build-time. This should have caused 'make test' to fail; did you really
+run it and look at the output? Check the setting of POSTGRES_LIB and
+recompile DBD-Pg.
+Some linux distributions have incomplete perl installations. If you have
+compile errors like "XS_VERSION_BOOTCHECK undeclared", do:
+
+       find .../lib/perl5 -name XSUB.h -print
+
+If this file is not present, you need to recompile and re-install 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>
+
+
+FreeBSD users: if you get during make test the error message:
+
+       'DBD driver has not implemented the AutoCommit attribute'
+
+recompile the DBI module and the DBD-Pg module and disable optimization.
+This error message is due to the broken optimization in gcc-2.7.2.1.
+
+If you get compiler errors like:
+       In function `XS_DBD__Pg__dr_discon_all_'
+    `sv_yes' undeclared (first use in this function)
+
+It may be because there is a 'patchlevel.h' file from another package 
+(such as 'hdf') in your POSTGRES_INCLUDE dir.  The presence of this file 
+prevents the compiler from finding the perl include file 
+'mach/CORE/patchlevel.h'.  Do 'pg_config --includedir' to identify the 
+POSTGRES_INCLUDE dir.  Rename patchlevel.h whilst you build DBD::Pg. 
+
+
+Sun Users: if you get compile errors like:
+
+       /usr/include/string.h:57: parse error before `]'
+
+then you need to remove from pgsql/include/libpq-fe.h the define for
+strerror, which clashes with the definition in the standard include
+file.
+
+Win32 Users: Running DBD-Pg scripts on Win32 needs some configuration work
+on the server side:
+
+       o add a postgres user with the same name as the NT-User 
+         (eg Administrator)
+       o make sure, that your pg_hba.conf on the server is configured,
+         such that a connection from another host will be accepted
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/README.win32 b/install/5.005/DBD-Pg-1.22-fixvercmp/README.win32
new file mode 100644 (file)
index 0000000..3cbe673
--- /dev/null
@@ -0,0 +1,63 @@
+
+$Id: README.win32,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+
+Here is a step-by-step procedure for getting DBD-Pg to work on Windows
+NT. This Port has been done by Bob Kline <bkline@rksystems.com>. 
+
+
+prerequisites: (older versions might also work, but these are the 
+--------------   versions I used)
+
+       o Windows NT4 SP4
+       o Visual Studio 6.0
+       o ActivePerl-5_6_0_613 with DBI-1.13
+       o postgresql-7.0.2
+       o DBD-Pg-0.95
+
+Here we assume, that perl and postgresql have been installed in C:\. Now
+perform the following steps:
+
+
+1. compile libpq
+----------------
+
+set POSTGRES_HOME=C:\postgresql-7.0.2
+cd postgresql-7.0.2
+mkdir lib
+mkdir include
+cd src
+copy include\port\win32.h include\os.h
+edit interfaces\libpq\fe-connect.c and add as first statement in connectDBStart() the following code:
+  #ifdef WIN32
+      static int WeHaveCalledWSAStartup;
+      if (!WeHaveCalledWSAStartup) {
+          WSADATA wsaData;
+          if (WSAStartup(MAKEWORD(1, 1), &wsaData)) {
+              printfPQExpBuffer(&conn->errorMessage, "WSAStartup failed: errno=%d\n", h_errno);
+              goto connect_errReturn;
+          }
+          WeHaveCalledWSAStartup = 1;
+      }
+  #endif
+edit interfaces\libpq\win32.mak and change the flag /ML to /MD:   CPP_PROJ=/nologo /MD ...
+nmake /f win32.mak
+cd ..
+copy src\interfaces\libpq\Release\libpq.lib  lib
+copy src\interfaces\libpq\libpq-fe.h         include
+copy src\include\postgres_ext.h              include
+cd ..
+
+
+2. build DBD-Pg
+---------------
+
+cd DBD-Pg
+perl Makefile.PL CAPI=TRUE
+nmake
+set the environment variable PGHOST to the name of the postgresql server: set PGHOST=myserver
+add on the server a postgres user with the same name as the NT-User (eg Administrator)
+make sure, that your pg_hba.conf on the server is configured, such that a connection from another host will be accepted
+mkdir C:\tmp
+nmake test   (expect to get errors concerning blobs)
+nmake install
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/dbd-pg.pod b/install/5.005/DBD-Pg-1.22-fixvercmp/dbd-pg.pod
new file mode 100644 (file)
index 0000000..ccbbc63
--- /dev/null
@@ -0,0 +1,411 @@
+
+# $Id: dbd-pg.pod,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+DBD::Pg - PostgreSQL database driver for the DBI module
+
+=head1 DESCRIPTION
+
+DBD::Pg is a Perl module which works with the DBI module to provide
+access to PostgreSQL databases.
+
+=head1 DBD::Pg
+
+=begin docbook
+<!-- The following blank =head1 is to allow us to use purely =head2 headings -->
+<!-- This keeps the POD fairly simple with regards to Pod::DocBook -->
+
+=end docbook
+
+=head1
+
+=head2 Version
+
+Version 0.91.
+
+=head2 Author and Contact Details
+
+The driver author is Edmund Mergl.  He can be contacted via the
+I<dbi-users> mailing list.
+
+
+=head2 Supported Database Versions and Options
+
+The DBD-Pg-0.92 module supports Postgresql 6.5.
+
+
+=head2 Connect Syntax
+
+The C<DBI-E<gt>connect()> Data Source Name, or I<DSN>, can be one of the
+following:
+
+  dbi:Pg:dbname=$dbname
+  dbi:Pg:dbname=$dbname;host=$host;port=$port;options=$options;tty=$tty
+
+All parameters, including the userid and password parameter of the 
+connect command, have a hard-coded default which can be overridden 
+by setting appropriate environment variables:
+
+  Parameter  Environment Variable  Default
+  ---------  --------------------  --------------
+  dbname     PGDATABASE            current userid
+  host       PGHOST                localhost
+  port       PGPORT                5432
+  options    PGOPTIONS             ""
+  tty        PGTTY                 ""
+  username   PGUSER                current userid
+  password   PGPASSWORD            ""
+
+There are no driver specific attributes for the C<DBI->connect()> method.
+
+
+=head2 Numeric Data Handling
+
+Postgresql supports the following numeric types:
+
+  Postgresql     Range
+  ----------     --------------------------
+  int2           -32768 to +32767
+  int4           -2147483648 to +2147483647
+  float4         6 decimal places
+  float8         15 decimal places
+
+Some platforms also support the int8 type.
+C<DBD::Pg> always returns all numbers as strings.
+
+
+=head2 String Data Handling
+
+Postgresql supports the following string data types:
+
+  CHAR            single character
+  CHAR(size)      fixed length blank-padded
+  VARCHAR(size)   variable length with limit
+  TEXT            variable length
+
+All string data types have a limit of 4096 bytes. 
+The CHAR type is fixed length and blank padded.
+
+There is no special handling for data with the 8th bit set. They
+are stored unchanged in the database. 
+None of the character types can store embedded nulls and Unicode is
+not formally supported.
+
+Strings can be concatenated using the C<||> operator.
+
+
+=head2 Date Data Handling
+
+Postgresql supports the following date time data types:
+
+  Type       Storage   Recommendation              Description
+  ---------  --------  --------------------------  ----------------------------
+  abstime     4 bytes  original date and time      limited range
+  date        4 bytes  SQL92 type                  wide range
+  datetime    8 bytes  best general date and time  wide range, high precision
+  interval   12 bytes  SQL92 type                  equivalent to timespan
+  reltime     4 bytes  original time interval      limited range, low precision
+  time        4 bytes  SQL92 type                  wide range
+  timespan   12 bytes  best general time interval  wide range, high precision
+  timestamp   4 bytes  SQL92 type                  limited range
+
+  Data Type    Range                               Resolution
+  ----------   ----------------------------------  -----------
+  abstime      1901-12-14        2038-01-19        1 sec
+  timestamp    1901-12-14        2038-01-19        1 sec
+  reltime      -68 years         +68 years         1 sec
+  tinterval    -178000000 years  +178000000 years  1 microsec
+  timespan     -178000000 years  178000000 years   1 microsec
+  date         4713 BC             32767 AD        1 day
+  datetime     4713 BC           1465001 AD        1 microsec
+  time         00:00:00:00       23:59:59:99       1 microsec
+
+Postgresql supports a range of date formats:
+
+  Name           Example
+  -----------    ----------------------
+  ISO            1997-12-17 0:37:16-08
+  SQL            12/17/1997 07:37:16.00 PST
+  Postgres       Wed Dec 17 07:37:16 1997 PST
+  European       17/12/1997 15:37:16.00 MET
+  NonEuropean    12/17/1997 15:37:16.00 MET
+  US             12/17/1997 07:37:16.00 MET
+
+The default output format does not depend on the client/server locale.
+It depends on, in increasing priority: the PGDATESTYLE environment
+variable at the server, the PGDATESTYLE environment variable at the client, and
+the C<SET DATESTYLE> SQL command.
+
+All of the formats described above can be used for input. A great many
+others can also be used. There is no specific default input format.
+If the format of a date input is ambiguous then the current DATESTYLE
+is used to help disambiguate.
+
+If you specify a date/time value without a time component, the default 
+time is 00:00:00 (midnight). To specify a date/time value without a date 
+is not allowed. 
+If a date with a two digit year is input then if the year was less than
+70, add 2000; otherwise, add 1900.
+
+The currect date/time is returned by the keyword C<'now'> or C<'current'>,
+which has to be casted to a valid data type. For example:
+
+  SELECT 'now'::datetime
+
+Postgresql supports a range of date time functions for converting
+between types, extracting parts of a date time value, truncating to a
+given unit, etc. The usual arithmetic can be performed on date and
+interval values, e.g., date-date=interval, etc.
+
+The following SQL expression can be used to convert an integer "seconds
+since 1-jan-1970 GMT" value to the corresponding database date time:
+
+  DATETIME(unixtime_field)
+
+and to do the reverse:
+
+  DATE_PART('epoch', datetime_field)
+
+The server stores all dates internally in GMT.  Times are converted to
+local time on the database server before being sent to the client
+frontend, hence by default are in the server time zone.
+
+The TZ environment variable is used by the server as default time
+zone.  The PGTZ environment variable on the client side is used to send
+the time zone information to the backend upon connection. The SQL C<SET
+TIME ZONE> command can set the time zone for the current session.
+
+
+=head2 LONG/BLOB Data Handling
+
+Postgresql handles BLOBS using a so called "large objects" type. The
+handling of this type differs from all other data types. The data are
+broken into chunks, which are stored in tuples in the database. Access
+to large objects is given by an interface which is modelled closely
+after the UNIX file system. The maximum size is limited by the file
+size of the operating system.
+
+
+If you just select the field, you get a "large object identifier" and
+not the data itself. The I<LongReadLen> and I<LongTruncOk> attributes are
+not implemented because they don't make sense in this case. The only
+method implemented by the driver is the undocumented DBI method
+C<blob_read()>.
+
+
+=head2 Other Data Handling issues
+
+The C<DBD::Pg> driver supports the C<type_info()> method.
+
+Postgresql supports automatic conversions between data types wherever
+it's reasonable.
+
+=head2 Transactions, Isolation and Locking
+
+Postgresql supports transactions.
+The current default isolation transaction level is "Serializable" and
+is currently implemented using table level locks. Both may change.
+No other isolation levels for transactions are supported.
+
+With AutoCommit on, a query never places a lock on a table. Readers
+never block writers and writers never block readers. This behavior
+changes whenever a transaction is started (AutoCommit off). Then a
+query induces a shared lock on a table and blocks anyone else
+until the transaction has been finished.
+
+The C<LOCK TABLE table_name> statement can be used to apply an explicit
+lock on a table. This only works inside a transaction (AutoCommit off).
+
+To ensure that a table being selected does not change before you make
+an update later in the transaction, you must explicitly lock it with a
+C<LOCK TABLE> statement before executing the select.
+
+
+=head2 No-Table Expression Select Syntax
+
+To select a constant expression, that is, an expression that doesn't involve
+data from a database table or view, just omit the "from" clause.
+Here's an example that selects the current time as a datetime:
+
+  SELECT 'now'::datetime;
+
+=head2 Table Join Syntax
+
+Outer joins are not supported. Inner joins use the traditional syntax.
+
+=head2 Table and Column Names
+
+The max size of table and column names cannot exceed 31 charaters in
+length.
+Only alphanumeric characters can be used; the first character must
+be a letter.
+
+If an identifier is enclosed by double quotation marks (C<">), it can
+contain any combination of characters except double quotation marks.
+
+Postgresql converts all identifiers to lower-case unless enclosed in
+double quotation marks.
+National character set characters can be used, if enclosed in quotation
+marks.
+
+
+=head2 Case Sensitivity of LIKE Operator
+
+Postgresql has the following string matching operators:
+
+ Glyph Description                                Example
+ ----- ----------------------------------------   -----------------------------
+ ~~    Same as SQL "LIKE" operator                'scrappy,marc' ~~ '%scrappy%'
+ !~~   Same as SQL "NOT LIKE" operator            'bruce' !~~ '%al%'
+ ~     Match (regex), case sensitive              'thomas' ~ '.*thomas.*'
+ ~*    Match (regex), case insensitive            'thomas' ~* '.*Thomas.*'
+ !~    Does not match (regex), case sensitive     'thomas' !~ '.*Thomas.*'
+ !~*   Does not match (regex), case insensitive   'thomas' !~ '.*vadim.*'
+
+
+=head2 Row ID
+
+The Postgresql "row id" pseudocolumn is called I<oid>, object identifier.
+It can be treated as a string and used to rapidly (re)select rows.
+
+
+=head2 Automatic Key or Sequence Generation
+
+Postgresql does not support automatic key generation such as "auto
+increment" or "system generated" keys.
+
+However, Postgresql does support "sequence generators". Any number of
+named sequence generators can be created in a database. Sequences 
+are used via functions called C<NEXTVAL> and C<CURRVAL>. Typical usage:
+
+  INSERT INTO table (k, v) VALUES (nextval('seq_name'), ?);
+
+To get the value just inserted, you can use the corresponding C<currval()>
+SQL function in the same session, or
+
+  SELECT last_value FROM seq_name
+
+
+=head2 Automatic Row Numbering and Row Count Limiting
+
+Postgresql does not support any way of automatically numbering returned rows.
+
+
+=head2 Parameter Binding
+
+Parameter binding is emulated by the driver.
+Both the C<?> and C<:1> style of placeholders are supported.
+
+The TYPE attribute of the C<bind_param()> method may be used to
+influence how parameters are treated. These SQL types are bound as
+VARCHAR: SQL_NUMERIC, SQL_DECIMAL, SQL_INTEGER, SQL_SMALLINT,
+SQL_FLOAT, SQL_REAL, SQL_DOUBLE, SQL_VARCHAR.
+
+The SQL_CHAR type is bound as a CHAR thus enabling fixed-width blank
+padded comparison semantics.
+
+Unsupported values of the TYPE attribute generate a warning.
+
+
+=head2 Stored Procedures
+
+C<DBD::Pg> does not support stored procedures.
+
+
+=head2 Table Metadata
+
+C<DBD::Pg> supports the C<table_info()> method.
+
+The I<pg_attribute> table contains detailed information about all columns
+of all the tables in the database, one row per table. 
+
+The I<pg_index> table contains detailed information about all indexes in
+the database, one row per index.
+
+Primary keys are implemented as unique indexes. See I<pg_index> above.
+
+
+=head2 Driver-specific Attributes and Methods
+
+There are no significant C<DBD::Pg> driver-specific database handle attributes.
+
+C<DBD::Pg> has the following driver-specific statement handle attributes:
+
+=over 8
+
+=item I<pg_size>
+
+Returns a reference to an array of integer values for each column. The
+integer shows the storage (not display) size of the column in bytes.
+Variable length columns are indicated by -1.
+
+=item I<pg_type>
+
+Returns a reference to an array of strings for each column. The string
+shows the name of the data type.
+
+=item I<pg_oid_status>
+
+Returns the OID of the last INSERT command.
+
+=item I<pg_cmd_status>
+
+Returns the name of the last command type. Possible types are: INSERT,
+DELETE, UPDATE, SELECT.
+
+=back
+
+
+C<DBD::Pg> has no private methods.
+
+
+=head2 Positioned updates and deletes
+
+Postgresql does not support positioned updates or deletes.
+
+
+=head2 Differences from the DBI Specification
+
+C<DBD::Pg> has no significant differences in behavior from the
+current DBI specification.
+
+Note that C<DBD::Pg> does not fully parse the statement until
+it's executed. Thus attributes like I<$sth-E<gt>{NUM_OF_FIELDS}> are not
+available until after C<$sth-E<gt>execute> has been called. This is valid
+behaviour but is important to note when porting applications
+originally written for other drivers.
+
+
+=head2 URLs to More Database/Driver Specific Information
+
+  http://www.postgresql.org
+
+
+=head2 Concurrent use of Multiple Handles
+
+C<DBD::Pg> supports an unlimited number of concurrent database
+connections to one or more databases.
+
+It also supports the preparation and execution of a new statement
+handle while still fetching data from another statement handle,
+provided it is 
+associated with the same database handle.
+
+
+=head2 Other Significant Database or Driver Features
+
+Postgres offers substantial additional power by incorporating the
+following four additional basic concepts in such a way that users can
+easily extend the system: classes, inheritance, types, and functions.
+
+Other features provide additional power and flexibility: constraints,
+triggers, rules, transaction integrity, procedural languages, and large objects.
+
+It's also free Open Source Software with an active community of developers.
+
+=cut
+
+# This driver summary for DBD::Pg is Copyright (c) 1999 Tim Bunce
+# and Edmund Mergl.
+# $Id: dbd-pg.pod,v 1.1 2004-04-29 09:21:28 ivan Exp $
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c b/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c
new file mode 100644 (file)
index 0000000..55f4ee7
--- /dev/null
@@ -0,0 +1,2024 @@
+/*
+   $Id: dbdimp.c,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+   Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+   Copyright (c) 2002 Jeffrey W. Baker
+   Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+   
+   You may distribute under the terms of either the GNU General Public
+   License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+/* 
+   hard-coded OIDs:   (here we need the postgresql types)
+                    pg_sql_type()  1042 (bpchar), 1043 (varchar)
+                    ddb_st_fetch() 1042 (bpchar),   16 (bool)
+                    ddb_preparse() 1043 (varchar)
+                    pgtype_bind_ok()
+*/
+
+#include "Pg.h"
+
+/* XXX DBI should provide a better version of this */
+#define IS_DBI_HANDLE(h)  (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P')
+
+DBISTATE_DECLARE;
+
+/* hard-coded array delimiter */
+static char* array_delimiter = ",";
+
+static void dbd_preparse  (imp_sth_t *imp_sth, char *statement);
+
+
+void
+dbd_init (dbistate)
+    dbistate_t *dbistate;
+{
+    DBIS = dbistate;
+}
+
+
+int
+dbd_discon_all (drh, imp_drh)
+    SV *drh;
+    imp_drh_t *imp_drh;
+{
+    dTHR;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_discon_all\n"); }
+
+    /* The disconnect_all concept is flawed and needs more work */
+    if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
+        sv_setiv(DBIc_ERR(imp_drh), (IV)1);
+        sv_setpv(DBIc_ERRSTR(imp_drh),
+                 (char*)"disconnect_all not implemented");
+        DBIh_EVENT2(drh, ERROR_event,
+                 DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh));
+        return FALSE;
+    }
+    if (perl_destruct_level) {
+        perl_destruct_level = 0;
+    }
+    return FALSE;
+}
+
+
+/* Database specific error handling. */
+
+void
+pg_error (h, error_num, error_msg)
+    SV *h;
+    int error_num;
+    char *error_msg;
+{
+    D_imp_xxh(h);
+    char *err, *src, *dst; 
+    int  len  = strlen(error_msg);
+
+    err = (char *)malloc(len + 1);
+    if (!err) {
+      return;
+    }
+    src = error_msg;
+    dst = err;
+
+    /* copy error message without trailing newlines */
+    while (*src != '\0' && *src != '\n') {
+        *dst++ = *src++;
+    }
+    *dst = '\0';
+
+    sv_setiv(DBIc_ERR(imp_xxh), (IV)error_num);         /* set err early */
+    sv_setpv(DBIc_ERRSTR(imp_xxh), (char*)err);
+    DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), DBIc_ERRSTR(imp_xxh));
+    if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "%s error %d recorded: %s\n", err, error_num, SvPV(DBIc_ERRSTR(imp_xxh),na)); }
+    free(err);
+}
+
+static int
+pgtype_bind_ok (dbtype)
+    int dbtype;
+{
+    /* basically we support types that can be returned as strings */
+    switch(dbtype) {
+    case   16: /* bool         */
+    case   17: /* bytea        */
+    case   18: /* char         */
+    case   20: /* int8         */
+    case   21: /* int2         */
+    case   23: /* int4         */
+    case   25: /* text         */
+    case   26: /* oid          */
+    case  700: /* float4       */
+    case  701: /* float8       */
+    case  702: /* abstime      */
+    case  703: /* reltime      */
+    case  704: /* tinterval    */
+    case 1042: /* bpchar       */
+    case 1043: /* varchar      */
+    case 1082: /* date         */
+    case 1083: /* time         */
+    case 1184: /* datetime     */
+    case 1186: /* timespan     */
+    case 1296: /* timestamp    */
+        return 1;
+    }
+    return 0;
+}
+
+
+/* ================================================================== */
+
+int
+pg_db_login (dbh, imp_dbh, dbname, uid, pwd)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+    char *dbname;
+    char *uid;
+    char *pwd;
+{
+    dTHR;
+
+    char *conn_str;
+    char *src;
+    char *dest;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "pg_db_login\n"); }
+
+    /* build connect string */
+    /* DBD-Pg syntax: 'dbname=dbname;host=host;port=port' */
+    /* pgsql  syntax: 'dbname=dbname host=host port=port user=uid password=pwd' */
+
+    conn_str = (char *)malloc(strlen(dbname) + strlen(uid) + strlen(pwd) + 16 + 1);
+    if (! conn_str) {
+        return 0;
+    }
+
+    src  = dbname;
+    dest = conn_str;
+    while (*src) {
+        if (*src != ';') {
+            *dest++ = *src++;
+            continue;
+        }
+        *dest++ = ' ';
+        src++;
+    }
+    *dest = '\0';
+
+    if (strlen(uid)) {
+        strcat(conn_str, " user=");
+        strcat(conn_str, uid);
+    }
+    if (strlen(uid) && strlen(pwd)) {
+        strcat(conn_str, " password=");
+        strcat(conn_str, pwd);
+    }
+
+    if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "pg_db_login: conn_str = >%s<\n", conn_str); }
+
+    /* make a connection to the database */
+    imp_dbh->conn = PQconnectdb(conn_str);
+    free(conn_str);
+
+    /* check to see that the backend connection was successfully made */
+    if (PQstatus(imp_dbh->conn) != CONNECTION_OK) {
+        pg_error(dbh, PQstatus(imp_dbh->conn), PQerrorMessage(imp_dbh->conn));
+        PQfinish(imp_dbh->conn);
+        return 0;
+    }
+
+    imp_dbh->init_commit = 1;                  /* initialize AutoCommit */
+    imp_dbh->pg_auto_escape = 1;               /* initialize pg_auto_escape */
+    imp_dbh->pg_bool_tf = 0;                    /* initialize pg_bool_tf */
+
+    DBIc_IMPSET_on(imp_dbh);                   /* imp_dbh set up now */
+    DBIc_ACTIVE_on(imp_dbh);                   /* call disconnect before freeing */
+    return 1;
+}
+
+
+int 
+dbd_db_getfd (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    char id;
+    SV* retsv;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_getfd\n"); }
+
+    return PQsocket(imp_dbh->conn);
+}
+
+SV * 
+dbd_db_pg_notifies (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    char id;
+    PGnotify* notify;
+    AV* ret;
+    SV* retsv;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_pg_notifies\n"); }
+
+    PQconsumeInput(imp_dbh->conn);
+
+    notify = PQnotifies(imp_dbh->conn);
+
+    if (!notify) return &sv_undef; 
+
+    ret=newAV();
+
+    av_push(ret, newSVpv(notify->relname,0) );
+    av_push(ret, newSViv(notify->be_pid) );
+
+    /* Should free notify memory with PQfreemem() */
+    retsv = newRV(sv_2mortal((SV*)ret));
+
+    return retsv;
+}
+
+int
+dbd_db_ping (dbh)
+    SV *dbh;
+{
+    char id;
+    D_imp_dbh(dbh);
+    PGresult* result;
+    ExecStatusType status;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_ping\n"); }
+
+    if (NULL != imp_dbh->conn) {
+        result = PQexec(imp_dbh->conn, " ");
+        status = result ? PQresultStatus(result) : -1;
+        PQclear(result);
+
+        if (PGRES_EMPTY_QUERY != status) {
+            return 0;
+        }
+
+        return 1;
+    }
+    
+    return 0;
+}
+
+
+int
+dbd_db_commit (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_commit\n"); }
+
+    /* no commit if AutoCommit = on */
+    if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
+        return 0;
+    }
+
+    if (NULL != imp_dbh->conn) {
+        PGresult* result = 0;
+        ExecStatusType commitstatus, beginstatus;
+
+        /* execute commit */
+        result = PQexec(imp_dbh->conn, "commit");
+        commitstatus = result ? PQresultStatus(result) : -1;
+        PQclear(result);
+
+        /* check result */
+        if (commitstatus != PGRES_COMMAND_OK) {
+           /* Only put the error message in DBH->errstr */
+           pg_error(dbh, commitstatus, PQerrorMessage(imp_dbh->conn));
+        }
+
+        /* start new transaction.  AutoCommit must be FALSE, ref. 20 lines up */
+        result = PQexec(imp_dbh->conn, "begin");
+        beginstatus = result ? PQresultStatus(result) : -1;
+        PQclear(result);
+        if (beginstatus != PGRES_COMMAND_OK) {
+           /* Maybe add some loud barf here? Raising some very high error? */
+            pg_error(dbh, beginstatus, "begin failed\n");
+            return 0;
+        }
+
+       /* if the initial COMMIT failed, return 0 now */
+       if (commitstatus != PGRES_COMMAND_OK) {
+            return 0;
+        }
+        
+        return 1;
+    }
+    
+    return 0;
+}
+
+
+int
+dbd_db_rollback (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_rollback\n"); }
+
+    /* no rollback if AutoCommit = on */
+    if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
+        return 0;
+    }
+
+    if (NULL != imp_dbh->conn) {
+        PGresult* result = 0;
+        ExecStatusType status;
+        
+        /* execute rollback */
+        result = PQexec(imp_dbh->conn, "rollback");
+        status = result ? PQresultStatus(result) : -1;
+        PQclear(result);
+
+        /* check result */
+        if (status != PGRES_COMMAND_OK) {
+            pg_error(dbh, status, "rollback failed\n");
+            return 0;
+        }
+
+        /* start new transaction.  AutoCommit must be FALSE, ref. 20 lines up */
+        result = PQexec(imp_dbh->conn, "begin");
+        status = result ? PQresultStatus(result) : -1;
+        PQclear(result);
+        if (status != PGRES_COMMAND_OK) {
+            pg_error(dbh, status, "begin failed\n");
+            return 0;
+        }
+        
+        return 1;
+    }
+
+    return 0;
+}
+
+
+int
+dbd_db_disconnect (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    dTHR;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect\n"); }
+
+    /* We assume that disconnect will always work      */
+    /* since most errors imply already disconnected.   */
+    DBIc_ACTIVE_off(imp_dbh);
+
+    if (NULL != imp_dbh->conn) {
+        /* rollback if AutoCommit = off */
+        if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) {
+            PGresult* result = 0;
+            ExecStatusType status;
+            result = PQexec(imp_dbh->conn, "rollback");
+            status = result ? PQresultStatus(result) : -1;
+            PQclear(result);
+            if (status != PGRES_COMMAND_OK) {
+                pg_error(dbh, status, "rollback failed\n");
+                return 0;
+            }
+            if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect: AutoCommit=off -> rollback\n"); }
+        }
+
+        PQfinish(imp_dbh->conn);
+        
+        imp_dbh->conn = NULL;
+    }
+    
+    /* We don't free imp_dbh since a reference still exists    */
+    /* The DESTROY method is the only one to 'free' memory.    */
+    /* Note that statement objects may still exists for this dbh!      */
+    return 1;
+}
+
+
+void
+dbd_db_destroy (dbh, imp_dbh)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_destroy\n"); }
+
+    if (DBIc_ACTIVE(imp_dbh)) {
+        dbd_db_disconnect(dbh, imp_dbh);
+    }
+
+    /* Nothing in imp_dbh to be freed  */
+    DBIc_IMPSET_off(imp_dbh);
+}
+
+
+int
+dbd_db_STORE_attrib (dbh, imp_dbh, keysv, valuesv)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+    SV *keysv;
+    SV *valuesv;
+{
+    STRLEN kl;
+    char *key = SvPV(keysv,kl);
+    int newval = SvTRUE(valuesv);
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_STORE\n"); }
+
+    if (kl==10 && strEQ(key, "AutoCommit")) {
+        int oldval = DBIc_has(imp_dbh, DBIcf_AutoCommit);
+        DBIc_set(imp_dbh, DBIcf_AutoCommit, newval);
+        if (oldval == FALSE && newval != FALSE && imp_dbh->init_commit) {
+            /* do nothing, fall through */
+            if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: initialize AutoCommit to on\n"); }
+        } else if (oldval == FALSE && newval != FALSE) {
+            if (NULL != imp_dbh->conn) {
+                /* commit any outstanding changes */
+                PGresult* result = 0;
+                ExecStatusType status;
+                result = PQexec(imp_dbh->conn, "commit");
+                status = result ? PQresultStatus(result) : -1;
+                PQclear(result);
+                if (status != PGRES_COMMAND_OK) {
+                    pg_error(dbh, status, "commit failed\n");
+                    return 0;
+                }
+            }            
+            if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to on: commit\n"); }
+        } else if ((oldval != FALSE && newval == FALSE) || (oldval == FALSE && newval == FALSE && imp_dbh->init_commit)) {
+            if (NULL != imp_dbh->conn) {
+                /* start new transaction */
+                PGresult* result = 0;
+                ExecStatusType status;
+                result = PQexec(imp_dbh->conn, "begin");
+                status = result ? PQresultStatus(result) : -1;
+                PQclear(result);
+                if (status != PGRES_COMMAND_OK) {
+                    pg_error(dbh, status, "begin failed\n");
+                    return 0;
+                }
+            }
+            if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to off: begin\n"); }
+        }
+        /* only needed once */
+        imp_dbh->init_commit = 0;
+        return 1;
+    } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
+        imp_dbh->pg_auto_escape = newval;
+    } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
+       imp_dbh->pg_bool_tf = newval;
+#ifdef SvUTF8_off
+    } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
+        imp_dbh->pg_enable_utf8 = newval;
+#endif
+    } else {
+        return 0;
+    }
+}
+
+
+SV *
+dbd_db_FETCH_attrib (dbh, imp_dbh, keysv)
+    SV *dbh;
+    imp_dbh_t *imp_dbh;
+    SV *keysv;
+{
+    STRLEN kl;
+    char *key = SvPV(keysv,kl);
+    SV *retsv = Nullsv;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_FETCH\n"); }
+
+    if (kl==10 && strEQ(key, "AutoCommit")) {
+        retsv = boolSV(DBIc_has(imp_dbh, DBIcf_AutoCommit));
+    } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
+        retsv = newSViv((IV)imp_dbh->pg_auto_escape);
+    } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
+       retsv = newSViv((IV)imp_dbh->pg_bool_tf);
+#ifdef SvUTF8_off
+    } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
+        retsv = newSViv((IV)imp_dbh->pg_enable_utf8);
+#endif
+    } else if (kl==11 && strEQ(key, "pg_INV_READ")) {
+        retsv = newSViv((IV)INV_READ);
+    } else if (kl==12 && strEQ(key, "pg_INV_WRITE")) {
+        retsv = newSViv((IV)INV_WRITE);
+    }
+
+    if (!retsv) {
+        return Nullsv;
+    }
+    if (retsv == &sv_yes || retsv == &sv_no) {
+        return retsv; /* no need to mortalize yes or no */
+    }
+    return sv_2mortal(retsv);
+}
+
+
+/* driver specific functins */
+
+
+int
+pg_db_lo_open (dbh, lobjId, mode)
+    SV *dbh;
+    unsigned int lobjId;
+    int mode;
+{
+    D_imp_dbh(dbh);
+    return lo_open(imp_dbh->conn, lobjId, mode);
+}
+
+
+int
+pg_db_lo_close (dbh, fd)
+    SV *dbh;
+    int fd;
+{
+    D_imp_dbh(dbh);
+    return lo_close(imp_dbh->conn, fd);
+}
+
+
+int
+pg_db_lo_read (dbh, fd, buf, len)
+    SV *dbh;
+    int fd;
+    char *buf;
+    int len;
+{
+    D_imp_dbh(dbh);
+    return lo_read(imp_dbh->conn, fd, buf, len);
+}
+
+
+int
+pg_db_lo_write (dbh, fd, buf, len)
+    SV *dbh;
+    int fd;
+    char *buf;
+    int len;
+{
+    D_imp_dbh(dbh);
+    return lo_write(imp_dbh->conn, fd, buf, len);
+}
+
+
+int
+pg_db_lo_lseek (dbh, fd, offset, whence)
+    SV *dbh;
+    int fd;
+    int offset;
+    int whence;
+{
+    D_imp_dbh(dbh);
+    return lo_lseek(imp_dbh->conn, fd, offset, whence);
+}
+
+
+unsigned int
+pg_db_lo_creat (dbh, mode)
+    SV *dbh;
+    int mode;
+{
+    D_imp_dbh(dbh);
+    return lo_creat(imp_dbh->conn, mode);
+}
+
+
+int
+pg_db_lo_tell (dbh, fd)
+    SV *dbh;
+    int fd;
+{
+    D_imp_dbh(dbh);
+    return lo_tell(imp_dbh->conn, fd);
+}
+
+
+int
+pg_db_lo_unlink (dbh, lobjId)
+    SV *dbh;
+    unsigned int lobjId;
+{
+    D_imp_dbh(dbh);
+    return lo_unlink(imp_dbh->conn, lobjId);
+}
+
+
+unsigned int
+pg_db_lo_import (dbh, filename)
+    SV *dbh;
+    char *filename;
+{
+    D_imp_dbh(dbh);
+    return lo_import(imp_dbh->conn, filename);
+}
+
+
+int
+pg_db_lo_export (dbh, lobjId, filename)
+    SV *dbh;
+    unsigned int lobjId;
+    char *filename;
+{
+    D_imp_dbh(dbh);
+    return lo_export(imp_dbh->conn, lobjId, filename);
+}
+
+
+int
+pg_db_putline (dbh, buffer)
+    SV *dbh;
+    char *buffer;
+{
+    D_imp_dbh(dbh);
+    return PQputline(imp_dbh->conn, buffer);
+}
+
+
+int
+pg_db_getline (dbh, buffer, length)
+    SV *dbh;
+    char *buffer;
+    int length;
+{
+    D_imp_dbh(dbh);
+    return PQgetline(imp_dbh->conn, buffer, length);
+}
+
+
+int
+pg_db_endcopy (dbh)
+    SV *dbh;
+{
+    D_imp_dbh(dbh);
+    return PQendcopy(imp_dbh->conn);
+}
+
+
+/* ================================================================== */
+
+
+int
+dbd_st_prepare (sth, imp_sth, statement, attribs)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    char *statement;
+    SV *attribs;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_prepare: statement = >%s<\n", statement); }
+
+    /* scan statement for '?', ':1' and/or ':foo' style placeholders */
+    dbd_preparse(imp_sth, statement);
+
+    /* initialize new statement handle */
+    imp_sth->result    = 0;
+    imp_sth->cur_tuple = 0;
+
+    DBIc_IMPSET_on(imp_sth);
+    return 1;
+}
+
+
+static void
+dbd_preparse (imp_sth, statement)
+    imp_sth_t *imp_sth;
+    char *statement;
+{
+    bool in_literal = FALSE;
+    char in_comment = '\0';
+    char *src, *start, *dest;
+    phs_t phs_tpl;
+    SV *phs_sv;
+    int idx=0;
+    char *style="", *laststyle=Nullch;
+    STRLEN namelen;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_preparse: statement = >%s<\n", statement); }
+
+    /* allocate room for copy of statement with spare capacity */
+    /* for editing '?' or ':1' into ':p1'.                     */
+    /*                                                         */
+    /* Note: the calculated length used here for the safemalloc        */
+    /* isn't related in any way to the actual worst case length        */
+    /* of the translated statement, but allowing for 3 times   */
+    /* the length of the original statement should be safe...  */
+    imp_sth->statement = (char*)safemalloc(strlen(statement) * 3 + 1);
+
+    /* initialise phs ready to be cloned per placeholder       */
+    memset(&phs_tpl, 0, sizeof(phs_tpl));
+    phs_tpl.ftype = 1043;      /* VARCHAR */
+
+    src  = statement;
+    dest = imp_sth->statement;
+    while(*src) {
+
+        if (in_comment) {
+            /* SQL-style and C++-style */ 
+            if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
+                in_comment = '\0';
+            }
+            /* C-style */
+            else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
+                *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
+                in_comment = '\0';
+            }
+            *dest++ = *src++;
+            continue;
+        }
+
+        if (in_literal) {
+            /* check if literal ends but keep quotes in literal */
+            if (*src == in_literal) {
+                int bs=0;
+                char *str;
+                str = src-1;
+                while (*(str-bs) == '\\')
+                bs++;
+                if (!(bs & 1))
+                    in_literal = 0;
+            }
+            *dest++ = *src++;
+            continue;
+        }
+
+        /* Look for comments: SQL-style or C++-style or C-style        */
+        if ((*src == '-' && *(src+1) == '-') ||
+            (*src == '/' && *(src+1) == '/') ||
+            (*src == '/' && *(src+1) == '*'))
+        {
+            in_comment = *(src+1);
+            /* We know *src & the next char are to be copied, so do */
+            /* it. In the case of C-style comments, it happens to */
+            /* help us avoid slash-asterisk-slash oddities. */
+            *dest++ = *src++;
+            *dest++ = *src++;
+            continue;
+        }
+
+        /* check if no placeholders */
+        if (*src != ':' && *src != '?') {
+            if (*src == '\'' || *src == '"') {
+                in_literal = *src;
+            }
+            *dest++ = *src++;
+            continue;
+        }
+
+        /* check for cast operator */
+        if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
+            *dest++ = *src++;
+            continue;
+        }
+
+        /* only here for : or ? outside of a comment or literal and no cast */
+
+        start = dest;                  /* save name inc colon  */ 
+        *dest++ = *src++;
+        if (*start == '?') {           /* X/Open standard      */
+            sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc)        */
+            dest = start+strlen(start);
+            style = "?";
+
+        } else if (isDIGIT(*src)) {    /* ':1'         */
+            idx = atoi(src);
+            *dest++ = 'p';             /* ':1'->':p1'  */
+            if (idx <= 0) {
+                croak("Placeholder :%d invalid, placeholders must be >= 1", idx);
+            }
+            while(isDIGIT(*src)) {
+                *dest++ = *src++;
+            }
+            style = ":1";
+
+        } else if (isALNUM(*src)) {    /* ':foo'       */
+            while(isALNUM(*src)) {     /* includes '_' */
+                *dest++ = *src++;
+            }
+            style = ":foo";
+        } else {                       /* perhaps ':=' PL/SQL construct */
+            continue;
+        }
+        *dest = '\0';                  /* handy for debugging  */
+        namelen = (dest-start);
+        if (laststyle && style != laststyle) {
+            croak("Can't mix placeholder styles (%s/%s)",style,laststyle);
+        }
+        laststyle = style;
+        if (imp_sth->all_params_hv == NULL) {
+            imp_sth->all_params_hv = newHV();
+        }
+        phs_tpl.sv = &sv_undef;
+        phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
+        hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
+        strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start);
+    }
+    *dest = '\0';
+    if (imp_sth->all_params_hv) {
+        DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
+        if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "    dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); }
+    }
+}
+
+
+/* if it LOOKS like a string, this function will determine whether the type needs to be surrounded in single quotes */
+static int pg_sql_needquote (sql_type)
+    int sql_type;
+{
+    if (sql_type > 1000 || sql_type == 17 || sql_type == 25 ) { 
+        return 1;
+    }
+    return 0;
+}
+
+
+
+static int
+pg_sql_type (imp_sth, name, sql_type)
+    imp_sth_t *imp_sth;
+    char *name;
+    int sql_type;
+{
+    switch (sql_type) {
+        case SQL_CHAR:
+            return 1042;       /* bpchar */
+        case SQL_NUMERIC:
+            return 700;                /* float4 */
+        case SQL_DECIMAL:
+            return 700;                /* float4 */
+        case SQL_INTEGER:
+            return 23;         /* int4 */
+        case SQL_SMALLINT:
+            return 21;         /* int2 */
+        case SQL_FLOAT:
+            return 700;                /* float4 */
+        case SQL_REAL:
+            return 701;                /* float8 */
+        case SQL_DOUBLE:
+            return 20;         /* int8 */
+        case SQL_VARCHAR:
+            return 1043;       /* varchar */
+        case SQL_BINARY:
+            return 17;         /* bytea */
+        default:
+            if (DBIc_WARN(imp_sth) && imp_sth && name) {
+                warn("SQL type %d for '%s' is not fully supported, bound as VARCHAR instead",
+                                               sql_type, name);
+            }
+            return pg_sql_type(imp_sth, name, SQL_VARCHAR);
+    }
+}
+
+static int
+sql_pg_type (imp_sth, name, sql_type)
+    imp_sth_t *imp_sth;
+    char *name;
+    int sql_type;
+{
+    if (dbis->debug >= 1) { 
+               PerlIO_printf(DBILOGFP, "sql_pg_type name '%s' type '%d'\n", name, sql_type ); 
+       }
+
+    switch (sql_type) {
+        case   17:             /* bytea */
+               return SQL_BINARY;
+        case   20:             /* int8 */
+               return SQL_DOUBLE;
+        case   21:             /* int2 */
+               return SQL_SMALLINT;
+        case   23:             /* int4 */
+               return SQL_INTEGER;
+        case  700:             /* float4 */
+               return SQL_NUMERIC;
+        case  701:             /* float8 */
+               return SQL_REAL;
+        case 1042:     /* bpchar */
+               return SQL_CHAR;
+        case 1043:     /* varchar */
+               return SQL_VARCHAR;
+        case 1082:     /* date */
+               return SQL_DATE;
+        case 1083:     /* time */
+               return SQL_TIME;
+        case 1296:     /* date */
+               return SQL_TIMESTAMP;
+
+        default:
+                       return sql_type;
+    }
+}
+
+
+static int
+dbd_rebind_ph (sth, imp_sth, phs)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    phs_t *phs;
+{
+    STRLEN value_len;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_rebind\n"); }
+
+    /* convert to a string ASAP */
+    if (!SvPOK(phs->sv) && SvOK(phs->sv)) {
+        sv_2pv(phs->sv, &na);
+    }
+
+    if (dbis->debug >= 2) {
+        char *val = neatsvpv(phs->sv,0);
+        PerlIO_printf(DBILOGFP, "       bind %s <== %.1000s (", phs->name, val);
+        if (SvOK(phs->sv)) {
+             PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen);
+        } else {
+            PerlIO_printf(DBILOGFP, "NULL, ");
+        }
+        PerlIO_printf(DBILOGFP, "ptype %d, otype %d%s)\n", (int)SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" : "");
+    }
+
+    /* At the moment we always do sv_setsv() and rebind.        */
+    /* Later we may optimise this so that more often we can     */
+    /* just copy the value & length over and not rebind.        */
+
+    if (phs->is_inout) {        /* XXX */
+        if (SvREADONLY(phs->sv)) {
+            croak(no_modify);
+        }
+        /* phs->sv _is_ the real live variable, it may 'mutate' later   */
+        /* pre-upgrade high to reduce risk of SvPVX realloc/move        */
+        (void)SvUPGRADE(phs->sv, SVt_PVNV);
+        /* ensure room for result, 28 is magic number (see sv_2pv)      */
+        SvGROW(phs->sv, (phs->maxlen < 28) ? 28 : phs->maxlen+1);
+    }
+    else {
+        /* phs->sv is copy of real variable, upgrade to at least string */
+        (void)SvUPGRADE(phs->sv, SVt_PV);
+    }
+
+    /* At this point phs->sv must be at least a PV with a valid buffer, */
+    /* even if it's undef (null)                                        */
+    /* Here we set phs->progv, phs->indp, and value_len.                */
+    if (SvOK(phs->sv)) {
+        phs->progv = SvPV(phs->sv, value_len);
+        phs->indp  = 0;
+    }
+    else {        /* it's null but point to buffer in case it's an out var */
+        phs->progv = SvPVX(phs->sv);
+        phs->indp  = -1;
+        value_len  = 0;
+    }
+    phs->sv_type = SvTYPE(phs->sv);        /* part of mutation check    */
+    phs->maxlen  = SvLEN(phs->sv)-1;       /* avail buffer space        */
+    if (phs->maxlen < 0) {                 /* can happen with nulls     */
+        phs->maxlen = 0;
+    }
+
+    phs->alen = value_len + phs->alen_incnull;
+
+    imp_sth->all_params_len += SvOK(phs->sv) ? phs->alen : 4; /* NULL */
+
+    if (dbis->debug >= 3) {
+        PerlIO_printf(DBILOGFP, "       bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d)\n",
+            phs->name,
+            (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen),
+            (phs->progv) ? phs->progv : "",
+            (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp);
+    }
+
+    return 1;
+}
+
+
+void dereference(value)
+SV** value;
+{
+       AV* buf;
+       SV* val;
+          char *src;
+       int is_ref;
+          STRLEN len;
+
+       if (SvTYPE(SvRV(*value)) != SVt_PVAV)
+               croak("Not an array reference (%s)", neatsvpv(*value,0));
+
+       buf = (AV *) SvRV(*value);
+       sv_setpv(*value, "{");
+               while ( SvOK(val = av_shift(buf)) ) {
+                       is_ref = SvROK(val);
+                       if (is_ref)
+                               dereference(&val);
+                       else
+                               sv_catpv(*value, "\"");
+                       /* Quote */
+                       src = SvPV(val, len);
+                       while (len--) {
+                               if (!is_ref && *src == '\"')
+                                       sv_catpv(*value, "\\");
+                               sv_catpvn(*value, src++, 1);
+                       }
+                       /* End of quote */
+                       if (!is_ref)
+                               sv_catpv(*value, "\"");
+                       if (av_len(buf) > -1)
+                                       sv_catpv(*value, array_delimiter);
+               }
+       sv_catpv(*value, "}");
+       av_clear(buf);
+}
+
+int
+dbd_bind_ph (sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    SV *ph_namesv;
+    SV *newvalue;
+    IV sql_type;
+    SV *attribs;
+    int is_inout;
+    IV maxlen;
+{
+    SV **phs_svp;
+    STRLEN name_len;
+    char *name;
+    char namebuf[30];
+    phs_t *phs;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_bind_ph\n"); }
+
+    /* check if placeholder was passed as a number        */
+
+    if (SvGMAGICAL(ph_namesv)) { /* eg if from tainted expression */
+        mg_get(ph_namesv);
+    }
+    if (!SvNIOKp(ph_namesv)) {
+        name = SvPV(ph_namesv, name_len);
+    }
+    if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
+        sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
+        name = namebuf;
+        name_len = strlen(name);
+    }
+    assert(name != Nullch);
+
+    if (SvTYPE(newvalue) > SVt_PVLV) { /* hook for later array logic   */
+        croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
+    }
+    if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) {
+        /* dbi handle allowed for cursor variables */
+               dereference(&newvalue);
+    }
+    if (SvTYPE(newvalue) == SVt_PVLV && is_inout) {    /* may allow later */
+        croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
+    }
+
+   if (dbis->debug >= 2) {
+        PerlIO_printf(DBILOGFP, "         bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type);
+        if (is_inout) {
+            PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen);
+        }
+        if (attribs) {
+            PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0));
+        }
+        PerlIO_printf(DBILOGFP, ")\n");
+    }
+
+    phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
+    if (phs_svp == NULL) {
+        croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
+    }
+    phs = (phs_t*)(void*)SvPVX(*phs_svp);      /* placeholder struct   */
+
+    if (phs->sv == &sv_undef) { /* first bind for this placeholder     */
+        phs->ftype    = 1043;           /* our default type VARCHAR    */
+        phs->is_inout = is_inout;
+        if (is_inout) {
+            /* phs->sv assigned in the code below */
+            ++imp_sth->has_inout_params;
+            /* build array of phs's so we can deal with out vars fast  */
+            if (!imp_sth->out_params_av) {
+                imp_sth->out_params_av = newAV();
+            }
+            av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
+        } 
+
+        if (attribs) { /* only look for pg_type on first bind of var   */
+            SV **svp;
+            /* Setup / Clear attributes as defined by attribs.         */
+            /* XXX If attribs is EMPTY then reset attribs to default?  */
+            if ( (svp = hv_fetch((HV*)SvRV(attribs), "pg_type", 7,  0)) != NULL) {
+                int pg_type = SvIV(*svp);
+                if (!pgtype_bind_ok(pg_type)) {
+                    croak("Can't bind %s, pg_type %d not supported by DBD::Pg", phs->name, pg_type);
+                }
+                if (sql_type) {
+                    croak("Can't specify both TYPE (%d) and pg_type (%d) for %s", sql_type, pg_type, phs->name);
+                }
+                phs->ftype = pg_type;
+            }
+        }
+        if (sql_type) {
+            /* SQL_BINARY (-2) is deprecated. */
+            if (sql_type == -2 && DBIc_WARN(imp_sth)) {
+                warn("Use of SQL type SQL_BINARY (%d) is deprecated. Use { pg_type => DBD::Pg::PG_BYTEA } instead.", sql_type);
+            }
+            phs->ftype = pg_sql_type(imp_sth, phs->name, sql_type);
+        }
+    }   /* was first bind for this placeholder  */
+
+        /* check later rebinds for any changes */
+    else if (is_inout || phs->is_inout) {
+        croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)", phs->name, phs->is_inout , is_inout);
+    }
+    else if (sql_type && phs->ftype != pg_sql_type(imp_sth, phs->name, sql_type)) {
+        croak("Can't change TYPE of param %s to %d after initial bind", phs->name, sql_type);
+    }
+
+    phs->maxlen = maxlen;              /* 0 if not inout               */
+
+    if (!is_inout) {   /* normal bind to take a (new) copy of current value    */
+        if (phs->sv == &sv_undef) {     /* (first time bind) */
+            phs->sv = newSV(0);
+        }
+        sv_setsv(phs->sv, newvalue);
+    } else if (newvalue != phs->sv) {
+        if (phs->sv) {
+            SvREFCNT_dec(phs->sv);
+        }
+        phs->sv = SvREFCNT_inc(newvalue);      /* point to live var    */
+    }
+
+    return dbd_rebind_ph(sth, imp_sth, phs);
+}
+
+
+int
+dbd_st_execute (sth, imp_sth)   /* <= -2:error, >=0:ok row count, (-1=unknown count) */
+    SV *sth;
+    imp_sth_t *imp_sth;
+{
+    dTHR;
+
+    D_imp_dbh_from_sth;
+    ExecStatusType status = -1;
+    char *cmdStatus;
+    char *cmdTuples;
+    char *statement;
+    int ret = -2;
+    int num_fields;
+    int i;
+    STRLEN len;
+    bool in_literal = FALSE;
+    char in_comment = '\0';
+    char *src;
+    char *dest;
+    char *val;
+    char namebuf[30];
+    phs_t *phs;
+    SV **svp;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_execute\n"); }
+
+    /*
+    here we get the statement from the statement handle where
+    it has been stored when creating a blank sth during prepare
+    svp = hv_fetch((HV *)SvRV(sth), "Statement", 9, FALSE);
+    statement = SvPV(*svp, na);
+    */
+
+    if (NULL == imp_dbh->conn) {
+        pg_error(sth, -1, "execute on disconnected handle");        
+        return -2;
+    }   
+    
+    statement = imp_sth->statement;
+    if (! statement) {
+        /* are we prepared ? */
+        pg_error(sth, -1, "statement not prepared\n");
+        return -2;
+    }
+
+    /* do we have input parameters ? */
+    if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
+       /*
+       we have to allocate some additional memory for possible escaping
+       quotes and backslashes:
+          max_len = length of statement
+          + total length of all params allowing for worst case all
+            characters binary-escaped (\\xxx)
+          + null terminator
+       Note: parameters look like :p1 at this point, so there's no
+       need to explicitly allow for surrounding quotes because '' is
+       shorter than :p1
+       */
+        int max_len = strlen(imp_sth->statement) + imp_sth->all_params_len * 5 + 1;
+        statement = (char*)safemalloc( max_len );
+        dest = statement;
+        src  = imp_sth->statement;
+        /* scan statement for ':p1' style placeholders */
+        while(*src) {
+
+            if (in_comment) {
+                /* SQL-style and C++-style */ 
+                if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
+                    in_comment = '\0';
+                }
+                /* C-style */
+                else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
+                    *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
+                    in_comment = '\0';
+                }
+                *dest++ = *src++;
+                continue;
+            }
+
+            if (in_literal) {
+                /* check if literal ends but keep quotes in literal */
+                if (*src == in_literal) {
+                    int bs=0;
+                    char *str;
+                    str = src-1;
+                    while (*(str-bs) == '\\')
+                    bs++;
+                    if (!(bs & 1))
+                        in_literal = 0;
+                }
+                *dest++ = *src++;
+                continue;
+            }
+
+            /* Look for comments: SQL-style or C++-style or C-style    */
+            if ((*src == '-' && *(src+1) == '-') ||
+                (*src == '/' && *(src+1) == '/') ||
+                (*src == '/' && *(src+1) == '*'))
+            {
+                in_comment = *(src+1);
+                /* We know *src & the next char are to be copied, so do */
+                /* it. In the case of C-style comments, it happens to */
+                /* help us avoid slash-asterisk-slash oddities. */
+                *dest++ = *src++;
+                *dest++ = *src++;
+                continue;
+            }
+
+            /* check if no placeholders */
+            if (*src != ':' && *src != '?') {
+                if (*src == '\'' || *src == '"') {
+                    in_literal = *src;
+                }
+                *dest++ = *src++;
+                continue;
+            }
+
+            /* check for cast operator */
+            if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
+                *dest++ = *src++;
+                continue;
+            }
+
+
+            i = 0;
+            namebuf[i++] = *src++; /* ':' */
+            namebuf[i++] = *src++; /* 'p' */
+
+            while (isDIGIT(*src) && i < (sizeof(namebuf)-1) ) {
+                namebuf[i++] = *src++;
+            }
+            if ( i == (sizeof(namebuf) - 1)) {
+                pg_error(sth, -1, "namebuf buffer overrun\n");
+                return -2;
+            }
+            namebuf[i] = '\0';
+            svp = hv_fetch(imp_sth->all_params_hv, namebuf, i, 0);
+            if (svp == NULL) {
+                pg_error(sth, -1, "parameter unknown\n");
+                return -2;
+            }
+            /* get attribute */
+            phs = (phs_t*)(void*)SvPVX(*svp);
+            /* replace undef with NULL */
+            if(!SvOK(phs->sv)) {
+                val = "NULL";
+                len = 4;
+            } else {
+                val = SvPV(phs->sv, len);
+            }
+            /* quote string attribute */
+            if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric  */
+                *dest++ = '\''; 
+            }
+            while (len--) {
+                if (imp_dbh->pg_auto_escape) {
+                    /* if the parameter was bound as PG_BYTEA, escape nonprintables */
+                    if (phs->ftype == 17 && !isPRINT(*val)) { /* escape null character */
+                        dest+=snprintf(dest, (statement + max_len) - dest, "\\\\%03o", *((unsigned char *)val));
+                       if (dest > statement + max_len) {
+                           pg_error(sth, -1, "statement buffer overrun\n");
+                           return -2;
+                       }
+                        val++;
+                        continue; /* do not copy the null */
+                    }
+                    /* escape quote */
+                    if (*val == '\'') {
+                            *dest++ = '\'';
+                    }
+                    /* escape backslash */
+                    if (*val == '\\') {
+                        if (phs->ftype == 17) { /* four backslashes. really. */
+                            *dest++ = '\\'; 
+                            *dest++ = '\\'; 
+                            *dest++ = '\\'; 
+                        } else {
+                            *dest++ = '\\';
+                       }
+                    }
+                }
+                /* copy attribute to statement */
+                *dest++ = *val++;
+            }
+            /* quote string attribute */
+            if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric  */
+                *dest++ = '\''; 
+            }
+        }
+        *dest = '\0';
+    }
+
+    if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_st_execute: statement = >%s<\n", statement); }
+
+    /* clear old result (if any) */
+    if (imp_sth->result) {
+        PQclear(imp_sth->result);
+    }
+
+    /* execute statement */
+    imp_sth->result = PQexec(imp_dbh->conn, statement);
+
+    /* free statement string in case of input parameters */
+    if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
+        Safefree(statement);
+    }
+
+    /* check status */
+    status    = imp_sth->result ? PQresultStatus(imp_sth->result)      : -1;
+    cmdStatus = imp_sth->result ? (char *)PQcmdStatus(imp_sth->result) : "";
+    cmdTuples = imp_sth->result ? (char *)PQcmdTuples(imp_sth->result) : "";
+
+    if (PGRES_TUPLES_OK == status) {
+        /* select statement */
+        num_fields = PQnfields(imp_sth->result);
+        imp_sth->cur_tuple = 0;
+        DBIc_NUM_FIELDS(imp_sth) = num_fields;
+        DBIc_ACTIVE_on(imp_sth);
+        ret = PQntuples(imp_sth->result);
+    } else if (PGRES_COMMAND_OK == status) {
+        /* non-select statement */
+        if (! strncmp(cmdStatus, "DELETE", 6) || ! strncmp(cmdStatus, "INSERT", 6) || ! strncmp(cmdStatus, "UPDATE", 6)) {
+            ret = atoi(cmdTuples);
+        } else {
+            ret = -1;
+        }
+    } else if (PGRES_COPY_OUT == status || PGRES_COPY_IN == status) {
+      /* Copy Out/In data transfer in progress */
+        ret = -1;
+    } else {
+        pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+        ret = -2;
+    }
+
+    /* store the number of affected rows */
+    imp_sth->rows = ret;
+
+    return ret;
+}
+
+
+int
+is_high_bit_set(val)
+    char *val;
+{
+    while (*val++)
+       if (*val & 0x80) return 1;
+    return 0;
+}
+
+AV *
+dbd_st_fetch (sth, imp_sth)
+    SV *sth;
+    imp_sth_t *imp_sth;
+{
+    D_imp_dbh_from_sth;
+    int num_fields;
+    int i;
+    AV *av;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_fetch\n"); }
+
+    /* Check that execute() was executed sucessfully */
+    if ( !DBIc_ACTIVE(imp_sth) ) {
+        pg_error(sth, 1, "no statement executing\n");
+        
+        return Nullav;
+    }
+
+    if ( imp_sth->cur_tuple == PQntuples(imp_sth->result) ) {
+        imp_sth->cur_tuple = 0;
+        DBIc_ACTIVE_off(imp_sth);
+        return Nullav; /* we reached the last tuple */
+    }
+
+    av = DBIS->get_fbav(imp_sth);
+    num_fields = AvFILL(av)+1;
+
+    for(i = 0; i < num_fields; ++i) {
+
+        SV *sv  = AvARRAY(av)[i];
+        if (PQgetisnull(imp_sth->result, imp_sth->cur_tuple, i)) {
+            sv_setsv(sv, &sv_undef);
+        } else {
+            char *val   = (char*)PQgetvalue(imp_sth->result, imp_sth->cur_tuple, i);
+            int val_len = strlen(val);
+            int  type   = PQftype(imp_sth->result, i); /* hopefully these hard coded values will not change */
+            if (16 == type && ! imp_dbh->pg_bool_tf) {
+               *val = (*val == 'f') ? '0' : '1'; /* bool: translate postgres into perl */
+            }
+            if (17 == type) {  /* decode \001 -> chr(1), etc, in-place */
+                char *p = val; /* points to next available pos */
+                char *s = val; /* points to current scanning pos */
+                int c1,c2,c3;
+                while (*s) {
+                    if (*s == '\\') {
+                        if (*(s+1) == '\\') { /* double backslash */ 
+                            *p++ = '\\';
+                            s += 2;
+                            continue;
+                        }
+                        else if ( isdigit(c1=(*(s+1))) &&
+                                 isdigit(c2=(*(s+2))) &&
+                                 isdigit(c3=(*(s+3))) ) {
+                            *p++ = (c1 - '0') * 64 + (c2 - '0') * 8 + (c3 - '0');
+                            s += 4;
+                            continue;
+                        }
+                    }
+                    *p++ = *s++;
+                }
+                val_len = (p - val);
+            }
+            else if (1042 == type && DBIc_has(imp_sth,DBIcf_ChopBlanks)) {
+                char *str = val;
+                while((val_len > 0) && (str[val_len-1] == ' ')) {
+                    val_len--;
+                }
+                val[val_len] = '\0';
+            }
+            sv_setpvn(sv, val, val_len);
+#ifdef SvUTF8_off
+           if (imp_dbh->pg_enable_utf8) {
+               SvUTF8_off(sv);
+               /* XXX Is this all the character data types? */
+               if (18 == type || 25 == type || 1042 ==type || 1043 == type) {
+                   if (is_high_bit_set(val) && is_utf8_string(val, val_len))
+                       SvUTF8_on(sv);
+               }
+           }
+#endif
+        }
+    }
+
+    imp_sth->cur_tuple += 1;
+
+    return av;
+}
+
+
+int
+dbd_st_blob_read (sth, imp_sth, lobjId, offset, len, destrv, destoffset)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    int lobjId;
+    long offset;
+    long len;
+    SV *destrv;
+    long destoffset;
+{
+    D_imp_dbh_from_sth;
+    int ret, lobj_fd, nbytes, nread;
+    PGresult* result;
+    ExecStatusType status;
+    SV *bufsv;
+    char *tmp;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_blob_read\n"); }
+    /* safety check */
+    if (lobjId <= 0) {
+        pg_error(sth, -1, "dbd_st_blob_read: lobjId <= 0");
+        return 0;
+    }
+    if (offset < 0) {
+        pg_error(sth, -1, "dbd_st_blob_read: offset < 0");
+        return 0;
+    }
+    if (len < 0) {
+        pg_error(sth, -1, "dbd_st_blob_read: len < 0");
+        return 0;
+    }
+    if (! SvROK(destrv)) {
+        pg_error(sth, -1, "dbd_st_blob_read: destrv not a reference");
+        return 0;
+    }
+    if (destoffset < 0) {
+        pg_error(sth, -1, "dbd_st_blob_read: destoffset < 0");
+        return 0;
+    }
+
+    /* dereference destination and ensure it's writable string */
+    bufsv = SvRV(destrv);
+    if (! destoffset) {
+        sv_setpvn(bufsv, "", 0);
+    }
+
+    /* execute begin
+    result = PQexec(imp_dbh->conn, "begin");
+    status = result ? PQresultStatus(result) : -1;
+    PQclear(result);
+    if (status != PGRES_COMMAND_OK) {
+        pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+        return 0;
+    }
+    */
+
+    /* open large object */
+    lobj_fd = lo_open(imp_dbh->conn, lobjId, INV_READ);
+    if (lobj_fd < 0) {
+        pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+        return 0;
+    }
+
+    /* seek on large object */
+    if (offset > 0) {
+        ret = lo_lseek(imp_dbh->conn, lobj_fd, offset, SEEK_SET);
+        if (ret < 0) {
+            pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+            return 0;
+        }
+    }
+
+    /* read from large object */
+    nread = 0;
+    SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
+    tmp = (SvPVX(bufsv)) + destoffset + nread;
+    while ((nbytes = lo_read(imp_dbh->conn, lobj_fd, tmp, BUFSIZ)) > 0) {
+        nread += nbytes;
+        /* break if user wants only a specified chunk */
+        if (len > 0 && nread > len) {
+            nread = len;
+            break;
+        }
+        SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
+        tmp = (SvPVX(bufsv)) + destoffset + nread;
+    }
+
+    /* terminate string */
+    SvCUR_set(bufsv, destoffset + nread);
+    *SvEND(bufsv) = '\0';
+
+    /* close large object */
+    ret = lo_close(imp_dbh->conn, lobj_fd);
+    if (ret < 0) {
+        pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+        return 0;
+    }
+
+    /* execute end 
+    result = PQexec(imp_dbh->conn, "end");
+    status = result ? PQresultStatus(result) : -1;
+    PQclear(result);
+    if (status != PGRES_COMMAND_OK) {
+        pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+        return 0;
+    }
+    */
+
+    return nread;
+}
+
+
+int
+dbd_st_rows (sth, imp_sth)
+    SV *sth;
+    imp_sth_t *imp_sth;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_rows\n"); }
+
+    return imp_sth->rows;
+}
+
+
+int
+dbd_st_finish (sth, imp_sth)
+    SV *sth;
+    imp_sth_t *imp_sth;
+{
+    dTHR;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_finish\n"); }
+
+    if (DBIc_ACTIVE(imp_sth) && imp_sth->result) {
+        PQclear(imp_sth->result);
+        imp_sth->result = 0;
+        imp_sth->rows   = 0;
+    }
+
+    DBIc_ACTIVE_off(imp_sth);
+    return 1;
+}
+
+
+void
+dbd_st_destroy (sth, imp_sth)
+    SV *sth;
+    imp_sth_t *imp_sth;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_destroy\n"); }
+
+    /* Free off contents of imp_sth */
+
+    Safefree(imp_sth->statement);
+    if (imp_sth->result) {
+        PQclear(imp_sth->result);
+        imp_sth->result = 0;
+    }
+
+    if (imp_sth->out_params_av)
+        sv_free((SV*)imp_sth->out_params_av);
+
+    if (imp_sth->all_params_hv) {
+        HV *hv = imp_sth->all_params_hv;
+        SV *sv;
+        char *key;
+        I32 retlen;
+        hv_iterinit(hv);
+        while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
+            if (sv != &sv_undef) {
+                phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv);
+                sv_free(phs_tpl->sv);
+            }
+        }
+        sv_free((SV*)imp_sth->all_params_hv);
+    }
+
+    DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
+}
+
+
+int
+dbd_st_STORE_attrib (sth, imp_sth, keysv, valuesv)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    SV *keysv;
+    SV *valuesv;
+{
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_STORE\n"); }
+
+    return FALSE;
+}
+
+
+SV *
+dbd_st_FETCH_attrib (sth, imp_sth, keysv)
+    SV *sth;
+    imp_sth_t *imp_sth;
+    SV *keysv;
+{
+    STRLEN kl;
+    char *key = SvPV(keysv,kl);
+    int i, sz;
+    SV *retsv = Nullsv;
+
+    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_FETCH\n"); }
+
+    if (! imp_sth->result) {
+        return Nullsv;
+    }
+
+    i = DBIc_NUM_FIELDS(imp_sth);
+
+    if (kl == 4 && strEQ(key, "NAME")) {
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            av_store(av, i, newSVpv(PQfname(imp_sth->result, i),0));
+        }
+    } else if ( kl== 4 && strEQ(key, "TYPE")) {
+               /* Need to convert the Pg type to ANSI/SQL type. */
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            av_store(av, i, newSViv(sql_pg_type( imp_sth,
+                                                       PQfname(imp_sth->result, i),
+                                                               PQftype(imp_sth->result, i))));
+               }
+    } else if (kl==9 && strEQ(key, "PRECISION")) {
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            sz = PQfsize(imp_sth->result, i);
+            av_store(av, i, sz > 0 ? newSViv(sz) : &sv_undef);
+        }
+    } else if (kl==5 && strEQ(key, "SCALE")) {
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            av_store(av, i, &sv_undef);
+        }
+    } else if (kl==8 && strEQ(key, "NULLABLE")) {
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            av_store(av, i, newSViv(2));
+        }
+    } else if (kl==10 && strEQ(key, "CursorName")) {
+        retsv = &sv_undef;
+    } else if (kl==11 && strEQ(key, "RowsInCache")) {
+        retsv = &sv_undef;
+    } else if (kl==7 && strEQ(key, "pg_size")) {
+        AV *av = newAV();
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            av_store(av, i, newSViv(PQfsize(imp_sth->result, i)));
+        }
+    } else if (kl==7 && strEQ(key, "pg_type")) {
+        AV *av = newAV();
+        char *type_nam;
+        retsv = newRV(sv_2mortal((SV*)av));
+        while(--i >= 0) {
+            switch (PQftype(imp_sth->result, i)) {
+            case 16:
+                type_nam = "bool";
+                break;
+            case 17:
+                type_nam = "bytea";
+                break;
+            case 18:
+                type_nam = "char";
+                break;
+            case 19:
+                type_nam = "name";
+                break;
+            case 20:
+                type_nam = "int8";
+                break;
+            case 21:
+                type_nam = "int2";
+                break;
+            case 22:
+                type_nam = "int28";
+                break;
+            case 23:
+                type_nam = "int4";
+                break;
+            case 24:
+                type_nam = "regproc";
+                break;
+            case 25:
+                type_nam = "text";
+                break;
+            case 26:
+                type_nam = "oid";
+                break;
+            case 27:
+                type_nam = "tid";
+                break;
+            case 28:
+                type_nam = "xid";
+                break;
+            case 29:
+                type_nam = "cid";
+                break;
+            case 30:
+                type_nam = "oid8";
+                break;
+            case 32:
+                type_nam = "SET";
+                break;
+            case 210:
+                type_nam = "smgr";
+                break;
+            case 600:
+                type_nam = "point";
+                break;
+            case 601:
+                type_nam = "lseg";
+                break;
+            case 602:
+                type_nam = "path";
+                break;
+            case 603:
+                type_nam = "box";
+                break;
+            case 604:
+                type_nam = "polygon";
+                break;
+            case 605:
+                type_nam = "filename";
+                break;
+            case 628:
+                type_nam = "line";
+                break;
+            case 629:
+                type_nam = "_line";
+                break;
+            case 700:
+                type_nam = "float4";
+                break;
+            case 701:
+                type_nam = "float8";
+                break;
+            case 702:
+                type_nam = "abstime";
+                break;
+            case 703:
+                type_nam = "reltime";
+                break;
+            case 704:
+                type_nam = "tinterval";
+                break;
+            case 705:
+                type_nam = "unknown";
+                break;
+            case 718:
+                type_nam = "circle";
+                break;
+            case 719:
+                type_nam = "_circle";
+                break;
+            case 790:
+                type_nam = "money";
+                break;
+            case 791:
+                type_nam = "_money";
+                break;
+            case 810:
+                type_nam = "oidint2";
+                break;
+            case 910:
+                type_nam = "oidint4";
+                break;
+            case 911:
+                type_nam = "oidname";
+                break;
+            case 1000:
+                type_nam = "_bool";
+                break;
+            case 1001:
+                type_nam = "_bytea";
+                break;
+            case 1002:
+                type_nam = "_char";
+                break;
+            case 1003:
+                type_nam = "_name";
+                break;
+            case 1005:
+                type_nam = "_int2";
+                break;
+            case 1006:
+                type_nam = "_int28";
+                break;
+            case 1007:
+                type_nam = "_int4";
+                break;
+            case 1008:
+                type_nam = "_regproc";
+                break;
+            case 1009:
+                type_nam = "_text";
+                break;
+            case 1028:
+                type_nam = "_oid";
+                break;
+            case 1010:
+                type_nam = "_tid";
+                break;
+            case 1011:
+                type_nam = "_xid";
+                break;
+            case 1012:
+                type_nam = "_cid";
+                break;
+            case 1013:
+                type_nam = "_oid8";
+                break;
+            case 1014:
+                type_nam = "_lock";
+                break;
+            case 1015:
+                type_nam = "_stub";
+                break;
+            case 1016:
+                type_nam = "_ref";
+                break;
+            case 1017:
+                type_nam = "_point";
+                break;
+            case 1018:
+                type_nam = "_lseg";
+                break;
+            case 1019:
+                type_nam = "_path";
+                break;
+            case 1020:
+                type_nam = "_box";
+                break;
+            case 1021:
+                type_nam = "_float4";
+                break;
+            case 1022:
+                type_nam = "_float8";
+                break;
+            case 1023:
+                type_nam = "_abstime";
+                break;
+            case 1024:
+                type_nam = "_reltime";
+                break;
+            case 1025:
+                type_nam = "_tinterval";
+                break;
+            case 1026:
+                type_nam = "_filename";
+                break;
+            case 1027:
+                type_nam = "_polygon";
+                break;
+            case 1033:
+                type_nam = "aclitem";
+                break;
+            case 1034:
+                type_nam = "_aclitem";
+                break;
+            case 1042:
+                type_nam = "bpchar";
+                break;
+            case 1043:
+                type_nam = "varchar";
+                break;
+            case 1082:
+                type_nam = "date";
+                break;
+            case 1083:
+                type_nam = "time";
+                break;
+            case 1182:
+                type_nam = "_date";
+                break;
+            case 1183:
+                type_nam = "_time";
+                break;
+            case 1184:
+                type_nam = "datetime";
+                break;
+            case 1185:
+                type_nam = "_datetime";
+                break;
+            case 1186:
+                type_nam = "timespan";
+                break;
+            case 1187:
+                type_nam = "_timespan";
+                break;
+            case 1231:
+                type_nam = "_numeric";
+                break;
+            case 1296:
+                type_nam = "timestamp";
+                break;
+            case 1700:
+                type_nam = "numeric";
+                break;
+                
+            default:
+                type_nam = "unknown";
+                
+            }
+            av_store(av, i, newSVpv(type_nam, 0));
+        }
+    } else if (kl==13 && strEQ(key, "pg_oid_status")) {
+        retsv = newSVpv((char *)PQoidStatus(imp_sth->result), 0);
+    } else if (kl==13 && strEQ(key, "pg_cmd_status")) {
+        retsv = newSVpv((char *)PQcmdStatus(imp_sth->result), 0);
+    } else {
+        return Nullsv;
+    }
+
+    return sv_2mortal(retsv);
+}
+
+
+/* end of dbdimp.c */
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.h b/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.h
new file mode 100644 (file)
index 0000000..58c105b
--- /dev/null
@@ -0,0 +1,81 @@
+/*
+   $Id: dbdimp.h,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+   Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+   Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+   You may distribute under the terms of either the GNU General Public
+   License or the Artistic License, as specified in the Perl README file.
+*/
+
+#ifdef WIN32
+#define snprintf _snprintf
+#endif
+
+/* Define drh implementor data structure */
+struct imp_drh_st {
+    dbih_drc_t com;            /* MUST be first element in structure   */
+};
+
+/* Define dbh implementor data structure */
+struct imp_dbh_st {
+    dbih_dbc_t com;            /* MUST be first element in structure   */
+
+    PGconn    * conn;          /* connection structure */
+    int         init_commit;   /* initialize AutoCommit */
+    int         pg_auto_escape;        /* initialize AutoEscape */
+    int         pg_bool_tf;     /* do bools return 't'/'f' */
+#ifdef SvUTF8_off
+    int         pg_enable_utf8;        /* should we attempt to make utf8 strings? */
+#endif
+};
+
+/* Define sth implementor data structure */
+struct imp_sth_st {
+    dbih_stc_t com;            /* MUST be first element in structure   */
+
+    PGresult* result;          /* result structure */
+    int cur_tuple;             /* current tuple */
+    int rows;                  /* number of affected rows */
+
+    /* Input Details   */
+    char      *statement;      /* sql (see sth_scan)           */
+    HV        *all_params_hv;  /* all params, keyed by name    */
+    AV        *out_params_av;  /* quick access to inout params */
+    int        pg_pad_empty;   /* convert ""->" " when binding */
+    int        all_params_len;  /* length-sum of all params     */
+
+    /* (In/)Out Parameter Details */
+    bool  has_inout_params;
+};
+
+
+#define sword  signed int
+#define sb2    signed short
+#define ub2    unsigned short
+
+typedef struct phs_st phs_t;    /* scalar placeholder   */
+
+struct phs_st {        /* scalar placeholder EXPERIMENTAL      */
+    sword ftype;        /* external OCI field type             */
+
+    SV *sv;            /* the scalar holding the value         */
+    int sv_type;       /* original sv type at time of bind     */
+    bool is_inout;
+
+    IV  maxlen;                /* max possible len (=allocated buffer) */
+
+    /* these will become an array */
+    sb2 indp;          /* null indicator                       */
+    char *progv;
+    ub2 arcode;
+    IV alen;           /* effective length ( <= maxlen )       */
+
+    int alen_incnull;  /* 0 or 1 if alen should include null   */
+    char name[1];      /* struct is malloc'd bigger as needed  */
+};
+
+
+SV * dbd_db_pg_notifies (SV *dbh, imp_dbh_t *imp_dbh);
+
+/* end of dbdimp.h */
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl
new file mode 100755 (executable)
index 0000000..b084f70
--- /dev/null
@@ -0,0 +1,70 @@
+#!/usr/local/bin/perl
+
+# $Id: ApacheDBI.pl,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+# don't forget to create in postgres the user who is running 
+# the httpd, eg 'createuser nobody' !
+#
+# demo script, tested with:
+#  - PostgreSQL-7.1.1
+#  - apache_1.3.12
+#  - mod_perl-1.23
+#  - perl5.6.0
+#  - DBI-1.14
+
+use CGI;
+use DBI;
+use strict;
+
+my $query = new CGI;
+
+print  $query->header,
+       $query->start_html(-title=>'A Simple Example'),
+       $query->startform,
+       "<CENTER><H3>Testing Module DBI</H3></CENTER>",
+       "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
+       "<TR><TD>Enter the data source: </TD>",
+           "<TD>", $query->textfield(-name=>'data_source', -size=>40, -default=>'dbi:Pg:dbname=template1'), "</TD>",
+       "</TR>",
+       "<TR><TD>Enter the user name: </TD>",
+           "<TD>", $query->textfield(-name=>'username'), "</TD>",
+       "</TR>",
+       "<TR><TD>Enter the password: </TD>",
+           "<TD>", $query->textfield(-name=>'auth'), "</TD>",
+       "</TR>",
+       "<TR><TD>Enter the 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 $data_source = $query->param('data_source');
+    my $username    = $query->param('username');
+    my $auth        = $query->param('auth');
+    my $cmd         = $query->param('cmd');
+    my $dbh         = DBI->connect($data_source, $username, $auth);
+    if ($dbh) {
+        my $sth = $dbh->prepare($cmd);
+        my $ret = $sth->execute;
+        if ($ret) {
+            my($i, $ary_ref);
+            print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
+            while ($ary_ref = $sth->fetchrow_arrayref) {
+                print "<TR><TD>", join("</TD><TD>", @$ary_ref), "</TD></TR>\n";
+            }
+            print "</TABLE></CENTER><P>\n";
+            $sth->finish;
+        } else {
+            print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
+        }
+        $dbh->disconnect;
+    } else {
+        print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
+    }
+}
+
+print $query->end_html;
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl
new file mode 100644 (file)
index 0000000..6192c49
--- /dev/null
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use DBI;
+use DBD::Pg;
+
+my $dsn = "dbname=p1";
+my $dbh = DBI->connect('dbi:Pg:dbname=p1', undef, undef, { AutoCommit => 1 });
+
+my $buf = 'abcdefghijklmnopqrstuvwxyz' x 400;
+
+my $id = write_blob($dbh, undef, $buf);
+
+my $dat = read_blob($dbh, $id);
+
+print "Done\n";
+
+sub write_blob {
+    my ($dbh, $lobj_id, $data) = @_;
+    
+    # begin transaction
+    $dbh->{AutoCommit} = 0;
+    
+    # Create a new lo if we are not passed an lo object ID.
+    unless ($lobj_id) {
+       # Create the object.
+       $lobj_id = $dbh->func($dbh->{'pg_INV_WRITE'}, 'lo_creat');
+    }    
+
+    # Open it to get a file descriptor.
+    my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_WRITE'}, 'lo_open');
+
+    $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
+    
+    # Write some data to it.
+    my $len = $dbh->func($lobj_fd, $data, length($data), 'lo_write');
+    
+    die "Errors writing lo\n" if $len != length($data);
+
+    # Close 'er up.
+    $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
+    # end transaction
+    $dbh->{AutoCommit} = 1;
+    
+    return $lobj_id;
+}
+
+sub read_blob {
+    my ($dbh, $lobj_id) = @_;
+    my $data = '';
+    my $read_len = 256;
+    my $chunk = '';
+
+    # begin transaction
+    $dbh->{AutoCommit} = 0;
+
+    my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_READ'}, 'lo_open');
+    
+    $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
+
+    # Pull out all the data.
+    while ($dbh->func($lobj_fd, $chunk, $read_len, 'lo_read')) {
+       $data .= $chunk;
+    }
+
+    $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
+
+    # end transaction
+    $dbh->{AutoCommit} = 1;
+       
+    return $data;
+}
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch
new file mode 100644 (file)
index 0000000..6f8acf8
--- /dev/null
@@ -0,0 +1,82 @@
+diff -r --unified DBD-Pg-1.00/test.pl DBD-Pg-1.00.alex/test.pl
+--- DBD-Pg-1.00/test.pl        Sun May 27 10:10:13 2001
++++ DBD-Pg-1.00.alex/test.pl   Sun Jun 10 15:38:09 2001
+@@ -40,7 +40,7 @@
+ my $dsn_main = "dbi:Pg:dbname=$dbmain";
+ my $dsn_test = "dbi:Pg:dbname=$dbtest";
+-my ($dbh0, $dbh, $sth);
++my ($dbh0, $dbh, $dbh1, $sth);
+ #DBI->trace(3); # make your choice
+@@ -445,16 +445,56 @@
+ # end transaction
+ $dbh->{AutoCommit} = 1;
++# compare large objects
++
+ ( $dbh->func($lobjId, 'lo_unlink') )
+     and print "\$dbh->func(lo_unlink) ...... ok\n"
+     or  print "\$dbh->func(lo_unlink) ...... not ok\n";
+-# compare large objects
+-
+ ( $pgin cmp $buf and $pgin cmp $blob )
+     and print "compare blobs .............. not ok\n"
+     or  print "compare blobs .............. ok\n";
++my $fd;
++( $fd=$dbh->func( 'getfd') )
++    and print "\$dbh->func(getfd) .......... ok\n"
++    or  print "\$dbh->func(getfd) .......... not ok\n";
++
++( $dbh->do( 'LISTEN test ') )
++    and print "\$dbh->do('LISTEN test') .... ok\n"
++    or  print "\$dbh->do('LISTEN test') .... not ok\n";
++
++( $dbh1 = DBI->connect("$dsn_test", '', '', { AutoCommit => 1 }) )
++    and print "DBI->connect (for notify)... ok\n"
++    or  die   "DBI->connect (for notify)... not ok: ", $DBI::errstr;
++
++# there should be no data for read on $fd , until we send a notify
++   
++    my $rout;
++    my $rin = '';
++    vec($rin,$fd,1) = 1;
++    my $nfound = select( $rout=$rin, undef, undef, 0);
++
++( $nfound==0 ) 
++    and print "select(\$fd) returns no data. ok\n"
++    or  die   "select(\$fd) returns no data. not ok\n";
++
++( $dbh1->do( 'NOTIFY test ') )
++    and print "\$dbh1->do('NOTIFY test') ... ok\n"
++    or  print "\$dbh1->do('NOTIFY test') ... not ok\n";
++
++    my $nfound = select( $rout=$rin, undef, undef, 1);
++
++( $nfound==1 ) 
++    and print "select(\$fd) returns data.... ok\n"
++    or  die   "select(\$fd) returns data.... not ok\n";
++
++my $notify_r;
++
++( $notify_r = $dbh->func('notifies') ) 
++    and print "\$dbh->func('notifies')...... ok\n"
++    or  die   "\$dbh->func('notifies')...... not ok\n";
++
+ ######################### disconnect and drop test database
+ # disconnect
+@@ -462,6 +502,10 @@
+ ( $dbh->disconnect )
+     and print "\$dbh->disconnect ........... ok\n"
+     or  die   "\$dbh->disconnect ........... not ok: ", $DBI::errstr;
++
++( $dbh1->disconnect )
++    and print "\$dbh1->disconnect .......... ok\n"
++    or  die   "\$dbh1->disconnect .......... not ok: ", $DBI::errstr;
+ $dbh0->do("DROP DATABASE $dbtest");
+ $dbh0->disconnect;
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/00basic.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/00basic.t
new file mode 100644 (file)
index 0000000..1c0cb28
--- /dev/null
@@ -0,0 +1,10 @@
+print "1..1\n";
+
+use DBI;
+use DBD::Pg;
+
+if ($DBD::Pg::VERSION) {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/01connect.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01connect.t
new file mode 100644 (file)
index 0000000..be17b50
--- /dev/null
@@ -0,0 +1,26 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 2;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+
+ok((defined $dbh and $dbh->disconnect()),
+   'connect with transaction'
+  );
+
+undef $dbh;
+$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                   {RaiseError => 1, AutoCommit => 1});
+
+ok((defined $dbh and $dbh->disconnect()),
+   'connect without transaction'
+  );
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/01constants.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01constants.t
new file mode 100644 (file)
index 0000000..09907e9
--- /dev/null
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 20;
+
+use DBD::Pg qw(:pg_types);
+
+ok(PG_BOOL      == 16,   'PG_BOOL');
+ok(PG_BYTEA     == 17,   'PG_BYTEA');
+ok(PG_CHAR      == 18,   'PG_CHAR');
+ok(PG_INT8      == 20,   'PG_INT8');
+ok(PG_INT2      == 21,   'PG_INT2');
+ok(PG_INT4      == 23,   'PG_INT4');
+ok(PG_TEXT      == 25,   'PG_TEXT');
+ok(PG_OID       == 26,   'PG_OID');
+ok(PG_FLOAT4    == 700,  'PG_FLOAT4');
+ok(PG_FLOAT8    == 701,  'PG_FLOAT8');
+ok(PG_ABSTIME   == 702,  'PG_ABSTIME');
+ok(PG_RELTIME   == 703,  'PG_RELTIME');
+ok(PG_TINTERVAL == 704,  'PG_TINTERVAL');
+ok(PG_BPCHAR    == 1042, 'PG_BPCHAR');
+ok(PG_VARCHAR   == 1043, 'PG_VARCHAR');
+ok(PG_DATE      == 1082, 'PG_DATE');
+ok(PG_TIME      == 1083, 'PG_TIME');
+ok(PG_DATETIME  == 1184, 'PG_DATETIME');
+ok(PG_TIMESPAN  == 1186, 'PG_TIMESPAN');
+ok(PG_TIMESTAMP == 1296, 'PG_TIMESTAMP');
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/01setup.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01setup.t
new file mode 100644 (file)
index 0000000..d0b57a3
--- /dev/null
@@ -0,0 +1,38 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                   {RaiseError => 1, AutoCommit => 1});
+ok(defined $dbh,'connect without transaction');
+{
+  local $dbh->{PrintError} = 0;
+  local $dbh->{RaiseError} = 0;
+  $dbh->do(q{DROP TABLE test});
+}
+
+my $sql = <<SQL;
+CREATE TABLE test (
+  id int,
+  name text,
+  val text,
+  score float,
+  date timestamp default 'now()',
+  array text[][]
+)
+SQL
+
+ok($dbh->do($sql),
+   'create table'
+  );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/02prepare.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/02prepare.t
new file mode 100644 (file)
index 0000000..373aca2
--- /dev/null
@@ -0,0 +1,84 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 8;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my $sql = <<SQL;
+        SELECT *
+          FROM test
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+$sql = <<SQL;
+        SELECT id
+          FROM test
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+$sql = <<SQL;
+        SELECT id
+             , name
+          FROM test
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+$sql = <<SQL;
+        SELECT id
+             , name
+          FROM test
+         WHERE id = 1
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+$sql = <<SQL;
+        SELECT id
+             , name
+          FROM test
+         WHERE id = ?
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+$sql = <<SQL;
+        SELECT *
+           FROM test
+         WHERE id = ?
+           AND name = ?
+           AND value = ?
+           AND score = ?
+           and data = ?
+SQL
+
+ok($dbh->prepare($sql),
+   "prepare: $sql"
+  );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/03bind.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/03bind.t
new file mode 100644 (file)
index 0000000..df7c884
--- /dev/null
@@ -0,0 +1,85 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 11;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my $sql = <<SQL;
+  SELECT id
+  , name
+  FROM test
+  WHERE id = ?
+SQL
+my $sth = $dbh->prepare($sql);
+ok(defined $sth,
+   "prepare: $sql"
+  );
+
+ok($sth->bind_param(1, 'foo'),
+   'bind int column with string'
+   );
+
+ok($sth->bind_param(1, 1),
+   'rebind int column with int'
+   );
+
+$sql = <<SQL;
+   SELECT id
+   , name
+   FROM test
+   WHERE id = ?
+   AND name = ?
+SQL
+$sth = $dbh->prepare($sql);
+ok(defined $sth,
+   "prepare: $sql"
+  );
+
+ok($sth->bind_param(1, 'foo'),
+   'bind int column with string',
+  );
+ok($sth->bind_param(2, 'bar'),
+   'bind string column with text'
+   );
+ok($sth->bind_param(2, 'baz'),
+   'rebind string column with text'
+  );
+
+ok($sth->finish(),
+   'finish'
+   );
+
+# Make sure that we get warnings when we try to use SQL_BINARY.
+{
+  local $SIG{__WARN__} =
+    sub { ok($_[0] =~ /^Use of SQL type SQL_BINARY/,
+            'warning with SQL_BINARY'
+           );
+       };
+
+  $sql = <<SQL;
+        SELECT id
+        , name
+        FROM test
+        WHERE id = ?
+        AND name = ?
+SQL
+  $sth = $dbh->prepare($sql);
+
+  $sth->bind_param(1, 'foo', DBI::SQL_BINARY);
+}
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/04execute.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/04execute.t
new file mode 100644 (file)
index 0000000..9643878
--- /dev/null
@@ -0,0 +1,113 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 13;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my $sql = <<SQL;
+  SELECT id
+  , name
+  FROM test
+  WHERE id = ?
+SQL
+my $sth = $dbh->prepare($sql);
+ok(defined $sth,
+   "prepare: $sql"
+  );
+
+$sth->bind_param(1, 1);
+ok($sth->execute(),
+   'exectute with one bind param'
+  );
+
+$sth->bind_param(1, 2);
+ok($sth->execute(),
+   'exectute with rebinding one param'
+  );
+
+$sql = <<SQL;
+       SELECT id
+       , name
+       FROM test
+       WHERE id = ?
+       AND name = ?
+SQL
+$sth = $dbh->prepare($sql);
+ok(defined $sth,
+   "prepare: $sql"
+  );
+
+$sth->bind_param(1, 2);
+$sth->bind_param(2, 'foo');
+ok($sth->execute(),
+   'exectute with two bind params'
+  );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth = $dbh->prepare($sql);
+  $sth->bind_param(1, 2);
+  $sth->execute();
+};
+ok(!$@,
+  'execute with only first of two params bound'
+  );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth = $dbh->prepare($sql);
+  $sth->bind_param(2, 'foo');
+  $sth->execute();
+};
+ok(!$@,
+  'execute with only second of two params bound'
+  );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth = $dbh->prepare($sql);
+  $sth->execute();
+};
+ok(!$@,
+  'execute with neither of two params bound'
+  );
+
+$sth = $dbh->prepare($sql);
+ok($sth->execute(1, 'foo'),
+   'execute with both params bound in execute'
+   );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth = $dbh->prepare(q{
+                        SELECT id
+                        , name
+                        FROM test
+                        WHERE id = ?
+                        AND name = ?
+                       });
+  $sth->execute(1);
+};
+ok($@,
+  'execute with only one of two params bound in execute'
+  );
+
+
+ok($sth->finish(),
+   'finish'
+   );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/05fetch.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/05fetch.t
new file mode 100644 (file)
index 0000000..b6f8f66
--- /dev/null
@@ -0,0 +1,131 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 10;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
+ok($dbh->commit(),
+   'commit'
+   );
+
+my $sql = <<SQL;
+  SELECT id
+  , name
+  FROM test
+SQL
+my $sth = $dbh->prepare($sql);
+$sth->execute();
+
+my $rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+  if (defined($id) && defined($name)) {
+    $rows++;
+  }
+}
+$sth->finish();
+ok($rows == 3,
+   'fetch three rows'
+  );
+
+$sql = <<SQL;
+       SELECT id
+       , name
+       FROM test
+       WHERE 1 = 0
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute();
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+  $rows++;
+}
+$sth->finish();
+
+ok($rows == 0,
+   'fetch zero rows'
+   );
+
+$sql = <<SQL;
+       SELECT id
+       , name
+       FROM test
+       WHERE id = ?
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute(1);
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+  if (defined($id) && defined($name)) {
+    $rows++;
+  }
+}
+$sth->finish();
+
+ok($rows == 1,
+   'fetch one row on id'
+  );
+
+# Attempt to test whether or not we can get unicode out of the database
+# correctly.  Reuse the previous sth.
+SKIP: {
+  eval "use Encode";
+  skip "need Encode module for unicode tests", 3 if $@;
+  local $dbh->{pg_enable_utf8} = 1;
+  $dbh->do("INSERT INTO test (id, name, val) VALUES (4, '\001\000dam', 'cow')");
+  $sth->execute(4);
+  my ($id, $name) = $sth->fetchrow_array();
+  ok(Encode::is_utf8($name),
+     'returned data has utf8 bit set'
+    );
+  is(length($name), 4,
+     'returned utf8 data is not corrupted'
+    );
+  $sth->finish();
+  $sth->execute(1);
+  my ($id2, $name2) = $sth->fetchrow_array();
+  ok(! Encode::is_utf8($name2),
+     'returned ASCII data has not got utf8 bit set'
+    );
+  $sth->finish();
+}
+
+$sql = <<SQL;
+       SELECT id
+       , name
+       FROM test
+       WHERE name = ?
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute('foo');
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+  if (defined($id) && defined($name)) {
+    $rows++;
+  }
+}
+$sth->finish();
+
+ok($rows == 1,
+   'fetch one row on name'
+   );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/06disconnect.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/06disconnect.t
new file mode 100644 (file)
index 0000000..5d76bc0
--- /dev/null
@@ -0,0 +1,31 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
+
+$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+
+$dbh->disconnect();
+$dbh->disconnect();
+$dbh->disconnect();
+ok($dbh->disconnect(),
+   'disconnect on already disconnected dbh'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/07reuse.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/07reuse.t
new file mode 100644 (file)
index 0000000..d09dfc0
--- /dev/null
@@ -0,0 +1,28 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, PrintError => 0, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my $sth = $dbh->prepare(q{SELECT * FROM test});
+ok($dbh->disconnect(),
+   'disconnect with un-finished statement'
+  );
+
+eval {
+  $sth->execute();
+};
+ok($@,
+   'execute on disconnected statement'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/08txn.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/08txn.t
new file mode 100644 (file)
index 0000000..467aa31
--- /dev/null
@@ -0,0 +1,102 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 18;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                       {RaiseError => 1, AutoCommit => 0}
+                      );
+ok(defined $dbh1,
+   'connect first dbh'
+  );
+
+my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                       {RaiseError => 1, AutoCommit => 0}
+                      );
+ok(defined $dbh2,
+   'connect second dbh'
+  );
+
+$dbh1->do(q{DELETE FROM test});
+ok($dbh1->commit(),
+   'delete'
+   );
+
+my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on empty table from dbh1'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on empty table from dbh2'
+  );
+
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch three rows on dbh1'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on dbh2 before commit'
+  );
+
+ok($dbh1->commit(),
+   'commit work'
+  );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch on dbh1 after commit'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch on dbh2 after commit'
+  );
+
+ok($dbh1->do(q{DELETE FROM test}),
+   'delete'
+  );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on empty table from dbh1'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch on from dbh2 without commit'
+  );
+
+ok($dbh1->rollback(),
+   'rollback'
+  );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch on from dbh1 after rollback'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+   'fetch on from dbh2 after rollback'
+  );
+
+ok($dbh1->disconnect(),
+   'disconnect on dbh1'
+);
+
+ok($dbh2->disconnect(),
+   'disconnect on dbh2'
+);
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/09autocommit.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/09autocommit.t
new file mode 100644 (file)
index 0000000..9b1b69f
--- /dev/null
@@ -0,0 +1,68 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 12;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                       {RaiseError => 1, AutoCommit => 1}
+                      );
+ok(defined $dbh1,
+   'connect first dbh'
+  );
+
+my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                       {RaiseError => 1, AutoCommit => 1}
+                      );
+ok(defined $dbh2,
+   'connect second dbh'
+  );
+
+ok($dbh1->do(q{DELETE FROM test}),
+   'delete'
+  );
+
+my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on empty table from dbh1'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+   'fetch on empty table from dbh2'
+  );
+
+ok($dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')}),
+   'insert'
+  );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 1,
+   'fetch one row from dbh1'
+  );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 1,
+   'fetch one row from dbh1'
+  );
+
+local $SIG{__WARN__} = sub {};
+ok(!$dbh1->commit(),
+   'commit'
+  );
+
+ok(!$dbh1->rollback(),
+   'rollback'
+  );
+
+ok($dbh1->disconnect(),
+   'disconnect on dbh1'
+);
+
+ok($dbh2->disconnect(),
+   'disconnect on dbh2'
+);
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/11quoting.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/11quoting.t
new file mode 100644 (file)
index 0000000..afec963
--- /dev/null
@@ -0,0 +1,50 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 8;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my %tests = (
+            one=>["'", "'\\" . sprintf("%03o", ord("'")) . "'"],
+            two=>["''", "'" . ("\\" . sprintf("%03o", ord("'")))x2 . "'"],
+            three=>["\\", "'\\" . sprintf("%03o", ord("\\")) . "'"],
+            four=>["\\'", sprintf("'\\%03o\\%03o'", ord("\\"), ord("'"))],
+            five=>["\\'?:", sprintf("'\\%03o\\%03o?:'", ord("\\"), ord("'"))],
+           );
+
+foreach my $test (keys %tests) {
+  my ($unq, $quo, $ref);
+
+  $unq = $tests{$test}->[0];
+  $ref = $tests{$test}->[1];
+  $quo = $dbh->quote($unq);
+
+  ok($quo eq $ref,
+     "$test: $unq -> expected $quo got $ref"
+    );
+}
+
+# Make sure that SQL_BINARY doesn't work.
+#    eval { $dbh->quote('foo', { TYPE => DBI::SQL_BINARY })};
+eval {
+  local $dbh->{PrintError} = 0;
+  $dbh->quote('foo', DBI::SQL_BINARY);
+};
+ok($@ && $@ =~ /Use of SQL_BINARY invalid in quote/,
+   'SQL_BINARY'
+);
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/12placeholders.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/12placeholders.t
new file mode 100644 (file)
index 0000000..bd79ea7
--- /dev/null
@@ -0,0 +1,125 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 9;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+my $quo = $dbh->quote("\\'?:");
+my $sth = $dbh->prepare(qq{
+                       INSERT INTO test (name) VALUES ($quo)
+                      });
+$sth->execute();
+
+my $sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = $quo;
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute();
+
+my ($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+   'fetch'
+  );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth->execute('foo');
+};
+ok($@,
+   'execute with one bind param where none expected'
+  );
+
+$sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = ?
+SQL
+$sth = $dbh->prepare($sql);
+
+$sth->execute("\\'?:");
+
+($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+   'execute with ? placeholder'
+  );
+
+$sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = :1
+SQL
+$sth = $dbh->prepare($sql);
+
+$sth->execute("\\'?:");
+
+($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+   'execute with :1 placeholder'
+  );
+
+$sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = '?'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth->execute('foo');
+};
+ok($@,
+   'execute with quoted ?'
+  );
+
+$sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = ':1'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $sth->execute('foo');
+};
+ok($@,
+   'execute with quoted :1'
+  );
+
+$sql = <<SQL;
+       SELECT name
+       FROM test
+       WHERE name = '\\\\'
+       AND name = '?'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+  local $dbh->{PrintError} = 0;
+  local $sth->{PrintError} = 0;
+  $sth->execute('foo');
+};
+ok($@,
+   'execute with quoted ?'
+  );
+
+$sth->finish();
+$dbh->rollback();
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/13pgtype.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/13pgtype.t
new file mode 100644 (file)
index 0000000..8db819e
--- /dev/null
@@ -0,0 +1,43 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+eval {
+  local $dbh->{PrintError} = 0;
+  $dbh->do(q{DROP TABLE tt});
+  $dbh->commit();
+};
+$dbh->rollback();
+
+$dbh->do(q{CREATE TABLE tt (blah numeric(5,2), foo text)});
+my $sth = $dbh->prepare(qq{
+                          SELECT * FROM tt WHERE FALSE
+                         });
+$sth->execute();
+
+my @types = @{$sth->{pg_type}};
+
+ok($types[0] eq 'numeric',
+   'type numeric'
+  );
+
+ok($types[1] eq 'text',
+   'type text'
+  );
+
+$sth->finish();
+$dbh->rollback();
+$dbh->disconnect();
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t
new file mode 100644 (file)
index 0000000..1bc2cf9
--- /dev/null
@@ -0,0 +1,353 @@
+#!/usr/bin/perl -w -I./t
+$| = 1;
+
+# vim:ts=2:sw=2:ai:aw:nu:
+use DBI qw(:sql_types);
+use Data::Dumper;
+use strict;
+use Test::More;
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 59;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+#
+# Test the different methods, so are expected to fail.
+#
+
+my $sth;
+
+# foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
+#      no strict 'refs';
+#      printf "%s=%d\n", $_, &{"DBI::$_"};
+# }
+
+my $get_info = {
+         SQL_DBMS_NAME => 17
+       , SQL_DBMS_VER  => 18
+       , SQL_IDENTIFIER_QUOTE_CHAR     => 29
+       , SQL_CATALOG_NAME_SEPARATOR    => 41
+       , SQL_CATALOG_LOCATION  => 114
+};
+
+# Ping
+ eval {
+        ok( $dbh->ping(), "Testing Ping" );
+ };
+ok ( !$@, "Ping Tested" );
+
+# Get Info
+ eval {
+        $sth = $dbh->get_info();
+ };
+ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+# Table Info
+ eval {
+        $sth = $dbh->table_info();
+ };
+ok ((!$@ and defined $sth), "table_info tested" );
+$sth = undef;
+
+# Column Info
+ eval {
+        $sth = $dbh->column_info();
+ };
+ok ((!$@ and defined $sth), "column_info tested" );
+#ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+
+# Tables
+ eval {
+        $sth = $dbh->tables();
+ };
+ok ((!$@ and defined $sth), "tables tested" );
+$sth = undef;
+
+# Type Info All
+ eval {
+        $sth = $dbh->type_info_all();
+ };
+ok ((!$@ and defined $sth), "type_info_all tested" );
+$sth = undef;
+
+# Type Info
+ eval {
+       my @types = $dbh->type_info();
+       die unless @types;
+ };
+ok (!$@, "type_info(undef)");
+$sth = undef;
+
+# Quote
+ eval {
+       my $val = $dbh->quote();
+       die unless $val;
+ };
+ok ($@, "quote error expected: $@");
+
+$sth = undef;
+# Tests for quote:
+my @qt_vals = (1, 2, undef, 'NULL', "ThisIsAString", "This is Another String");
+my @expt_vals = (q{'1'}, q{'2'}, "NULL", q{'NULL'}, q{'ThisIsAString'}, q{'This is Another String'});
+for (my $x = 0; $x <= $#qt_vals; $x++) {
+       local $^W = 0;
+       my $val = $dbh->quote( $qt_vals[$x] );  
+       is( $val, $expt_vals[$x], "$x: quote on $qt_vals[$x] returned $val" );
+}
+
+is( $dbh->quote( 1, SQL_INTEGER() ), 1, "quote(1, SQL_INTEGER)" );
+
+
+# Quote Identifier
+ eval {
+       my $val = $dbh->quote_identifier();
+       die unless $val;
+ };
+
+ok ($@, "quote_identifier error expected: $@");
+$sth = undef;
+
+SKIP: {
+    skip("get_info() not yet implemented", 1);
+    #  , SQL_IDENTIFIER_QUOTE_CHAR     => 29
+    #  , SQL_CATALOG_NAME_SEPARATOR    => 41
+    my $qt  = $dbh->get_info( $get_info->{SQL_IDENTIFIER_QUOTE_CHAR} );
+    my $sep = $dbh->get_info( $get_info->{SQL_CATALOG_NAME_SEPARATOR} );
+
+    # Uncomment this line and remove the next line when get_info() is implemented.
+#    my $cmp_str = qq{${qt}link${qt}${sep}${qt}schema${qt}${sep}${qt}table${qt}};
+    my $cmp_str = '';
+    is( $dbh->quote_identifier( "link", "schema", "table" )
+       , $cmp_str
+       , q{quote_identifier( "link", "schema", "table" )}
+      );
+}
+
+# Test ping
+
+ok ($dbh->ping, "Ping the current connection ..." );
+
+# Test Get Info.
+
+#      SQL_KEYWORDS
+#      SQL_CATALOG_TERM
+#      SQL_DATA_SOURCE_NAME
+#      SQL_DBMS_NAME
+#      SQL_DBMS_VERSION
+#      SQL_DRIVER_NAME
+#      SQL_DRIVER_VER
+#      SQL_PROCEDURE_TERM
+#      SQL_SCHEMA_TERM
+#      SQL_TABLE_TERM
+#      SQL_USER_NAME
+
+SKIP: {
+    skip("get_info() not yet implemented", 5);
+    foreach my $info (sort keys %$get_info) {
+       my $type =  $dbh->get_info($get_info->{$info});
+       ok( defined $type,  "get_info($info) ($get_info->{$info}) " .
+            ($type || '') );
+    }
+}
+
+# Test Table Info
+$sth = $dbh->table_info( undef, undef, undef );
+ok( defined $sth, "table_info(undef, undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->table_info( undef, undef, undef, "VIEW" );
+ok( defined $sth, "table_info(undef, undef, undef, \"VIEW\") tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19a
+$sth = $dbh->table_info( '%', '', '');
+ok( defined $sth, "table_info('%', '', '',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19b
+$sth = $dbh->table_info( '', '%', '');
+ok( defined $sth, "table_info('', '%', '',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19c
+$sth = $dbh->table_info( '', '', '', '%');
+ok( defined $sth, "table_info('', '', '', '%',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test to see if this database contains any of the defined table types.
+$sth = $dbh->table_info( '', '', '', '%');
+ok( defined $sth, "table_info('', '', '', '%',) tested" );
+if ($sth) {
+       my $ref = $sth->fetchall_hashref( 'TABLE_TYPE' );
+       foreach my $type ( sort keys %$ref ) {
+               my $tsth = $dbh->table_info( undef, undef, undef, $type );
+               ok( defined $tsth, "table_info(undef, undef, undef, $type) tested" );
+               DBI::dump_results($tsth) if defined $tsth;
+               $tsth->finish;
+       }
+       $sth->finish;
+}
+$sth = undef;
+
+# Test Column Info
+$sth = $dbh->column_info( undef, undef, undef, undef );
+ok( defined $sth, "column_info(undef, undef, undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'ause%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser','replicator'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser','replicator', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser','repl%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser','repl%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'fred','repl%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'fred','repl%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'fred','jim'", undef, undef );
+ok( defined $sth, "column_info(undef, 'fred','jim', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", undef );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", undef );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_%', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", undef );
+ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schemaname'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schemaname') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_%', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test call to primary_key_info
+local ($dbh->{Warn}, $dbh->{PrintError});
+$dbh->{PrintError} = $dbh->{Warn} = 0;
+
+# Primary Key Info
+eval {
+    $sth = $dbh->primary_key_info();
+    die unless $sth;
+};
+ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+# Primary Key
+eval {
+    $sth = $dbh->primary_key();
+    die unless $sth;
+};
+ok ($@, "Call to primary_key with 0 arguements, error expected: $@" );
+$sth = undef;
+
+$sth = $dbh->primary_key_info(undef, undef, undef );
+
+ok( defined $sth, "Statement handle defined for primary_key_info()" );
+
+if ( defined $sth ) {
+    while( my $row = $sth->fetchrow_arrayref ) {
+        local $^W = 0;
+        # print join( ", ", @$row, "\n" );
+    }
+
+    undef $sth;
+
+}
+
+$sth = $dbh->primary_key_info(undef, undef, undef );
+ok( defined $sth, "Statement handle defined for primary_key_info()" );
+
+my ( %catalogs, %schemas, %tables);
+
+my $cnt = 0;
+while( my ($catalog, $schema, $table) = $sth->fetchrow_array ) {
+    local $^W = 0;
+    $catalogs{$catalog}++      if $catalog;
+    $schemas{$schema}++                if $schema;
+    $tables{$table}++                  if $table;
+    $cnt++;
+}
+ok( $cnt > 0, "At least one table has a primary key." );
+
+$sth = $dbh->primary_key_info(undef, qq{'$ENV{DBI_USER}'}, undef );
+ok(
+   defined $sth
+   , "Getting primary keys for tables owned by $ENV{DBI_USER}");
+DBI::dump_results($sth) if defined $sth;
+
+undef $sth;
+
+SKIP: {
+       # foreign_key_info
+       local ($dbh->{Warn}, $dbh->{PrintError});
+       $dbh->{PrintError} = $dbh->{Warn} = 0;
+       eval {
+       $sth = $dbh->foreign_key_info();
+               die unless $sth;
+       };
+       skip "foreign_key_info not supported by driver", 1 if $@;
+       ok( defined $sth, "Statement handle defined for foreign_key_info()" );
+       DBI::dump_results($sth) if defined $sth;
+       $sth = undef;
+}
+
+ok( $dbh->disconnect, "Disconnect from database" );
+
+exit(0);
+
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/99cleanup.t b/install/5.005/DBD-Pg-1.22-fixvercmp/t/99cleanup.t
new file mode 100644 (file)
index 0000000..e7563ab
--- /dev/null
@@ -0,0 +1,24 @@
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+                      {RaiseError => 1, AutoCommit => 0}
+                     );
+ok(defined $dbh,
+   'connect with transaction'
+  );
+
+ok($dbh->do(q{DROP TABLE test}),
+   'drop'
+  );
+
+ok($dbh->disconnect(),
+   'disconnect'
+  );
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm
new file mode 100644 (file)
index 0000000..417247f
--- /dev/null
@@ -0,0 +1,1167 @@
+package App::Info;
+
+# $Id: Info.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+App::Info - Information about software packages on a system
+
+=head1 SYNOPSIS
+
+  use App::Info::Category::FooApp;
+
+  my $app = App::Info::Category::FooApp->new;
+
+  if ($app->installed) {
+      print "App name: ", $app->name, "\n";
+      print "Version:  ", $app->version, "\n";
+      print "Bin dir:  ", $app->bin_dir, "\n";
+  } else {
+      print "App not installed on your system. :-(\n";
+  }
+
+=head1 DESCRIPTION
+
+App::Info is an abstract base class designed to provide a generalized
+interface for subclasses that provide metadata about software packages
+installed on a system. The idea is that these classes can be used in Perl
+application installers in order to determine whether software dependencies
+have been fulfilled, and to get necessary metadata about those software
+packages.
+
+App::Info provides an event model for handling events triggered by App::Info
+subclasses. The events are classified as "info", "error", "unknown", and
+"confirm" events, and multiple handlers may be specified to handle any or all
+of these event types. This allows App::Info clients to flexibly handle events
+in any way they deem necessary. Implementing new event handlers is
+straight-forward, and use the triggering of events by App::Info subclasses is
+likewise kept easy-to-use.
+
+A few L<sample subclasses|"SEE ALSO"> are provided with the distribution, but
+others are invited to write their own subclasses and contribute them to the
+CPAN. Contributors are welcome to extend their subclasses to provide more
+information relevant to the application for which data is to be provided (see
+L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache> for an example), but are
+encouraged to, at a minimum, implement the abstract methods defined here and
+in the category abstract base classes (e.g.,
+L<App::Info::HTTPD|App::Info::HTTPD> and L<App::Info::Lib|App::Info::Lib>).
+See L<Subclassing|"SUBCLASSING"> for more information on implementing new
+subclasses.
+
+=cut
+
+use strict;
+use Carp ();
+use App::Info::Handler;
+use App::Info::Request;
+use vars qw($VERSION);
+
+$VERSION = '0.23';
+
+##############################################################################
+##############################################################################
+# This code ref is used by the abstract methods to throw an exception when
+# they're called directly.
+my $croak = sub {
+    my ($caller, $meth) = @_;
+    $caller = ref $caller || $caller;
+    if ($caller eq __PACKAGE__) {
+        $meth = __PACKAGE__ . '::' . $meth;
+        Carp::croak(__PACKAGE__ . " is an abstract base class. Attempt to " .
+                    " call non-existent method $meth");
+    } else {
+        Carp::croak("Class $caller inherited from the abstract base class " .
+                    __PACKAGE__ . ", but failed to redefine the $meth() " .
+                    "method. Attempt to call non-existent method " .
+                    "${caller}::$meth");
+    }
+};
+
+##############################################################################
+# This code reference is used by new() and the on_* error handler methods to
+# set the error handlers.
+my $set_handlers = sub {
+    my $on_key = shift;
+    # Default is to do nothing.
+    return [] unless $on_key;
+    my $ref = ref $on_key;
+    if ($ref) {
+        $on_key = [$on_key] unless $ref eq 'ARRAY';
+        # Make sure they're all handlers.
+        foreach my $h (@$on_key) {
+            if (my $r = ref $h) {
+                Carp::croak("$r object is not an App::Info::Handler")
+                  unless UNIVERSAL::isa($h, 'App::Info::Handler');
+            } else {
+                # Look up the handler.
+                $h = App::Info::Handler->new( key => $h);
+            }
+        }
+        # Return 'em!
+        return $on_key;
+    } else {
+        # Look up the handler.
+        return [ App::Info::Handler->new( key => $on_key) ];
+    }
+};
+
+##############################################################################
+##############################################################################
+
+=head1 INTERFACE
+
+This section documents the public interface of App::Info.
+
+=head2 Constructor
+
+=head3 new
+
+  my $app = App::Info::Category::FooApp->new(@params);
+
+Constructs an App::Info object and returns it. The @params arguments define
+how the App::Info object will respond to certain events, and correspond to
+their like-named methods. See the L<"Event Handler Object Methods"> section
+for more information on App::Info events and how to handle them. The
+parameters to C<new()> for the different types of App::Info events are:
+
+=over 4
+
+=item on_info
+
+=item on_error
+
+=item on_unknown
+
+=item on_confirm
+
+=back
+
+When passing event handlers to C<new()>, the list of handlers for each type
+should be an anonymous array, for example:
+
+  my $app = App::Info::Category::FooApp->new( on_info => \@handlers );
+
+=cut
+
+sub new {
+    my ($pkg, %p) = @_;
+    my $class = ref $pkg || $pkg;
+    # Fail if the method isn't overridden.
+    $croak->($pkg, 'new') if $class eq __PACKAGE__;
+
+    # Set up handlers.
+    for (qw(on_error on_unknown on_info on_confirm)) {
+        $p{$_} = $set_handlers->($p{$_});
+    }
+
+    # Do it!
+    return bless \%p, $class;
+}
+
+##############################################################################
+##############################################################################
+
+=head2 Metadata Object Methods
+
+These are abstract methods in App::Info and must be provided by its
+subclasses. They provide the essential metadata of the software package
+supported by the App::Info subclass.
+
+=head3 key_name
+
+  my $key_name = $app->key_name;
+
+Returns a string that uniquely identifies the software for which the App::Info
+subclass provides data. This value should be unique across all App::Info
+classes. Typically, it's simply the name of the software.
+
+=cut
+
+sub key_name { $croak->(shift, 'key_name') }
+
+=head3 installed
+
+  if ($app->installed) {
+      print "App is installed.\n"
+  } else {
+      print "App is not installed.\n"
+  }
+
+Returns a true value if the application is installed, and a false value if it
+is not.
+
+=cut
+
+sub installed { $croak->(shift, 'installed') }
+
+##############################################################################
+
+=head3 name
+
+  my $name = $app->name;
+
+Returns the name of the application.
+
+=cut
+
+sub name { $croak->(shift, 'name') }
+
+##############################################################################
+
+=head3 version
+
+  my $version = $app->version;
+
+Returns the full version number of the application.
+
+=cut
+
+##############################################################################
+
+sub version { $croak->(shift, 'version') }
+
+=head3 major_version
+
+  my $major_version = $app->major_version;
+
+Returns the major version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "7".
+
+=cut
+
+sub major_version { $croak->(shift, 'major_version') }
+
+##############################################################################
+
+=head3 minor_version
+
+  my $minor_version = $app->minor_version;
+
+Returns the minor version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "1".
+
+=cut
+
+sub minor_version { $croak->(shift, 'minor_version') }
+
+##############################################################################
+
+=head3 patch_version
+
+  my $patch_version = $app->patch_version;
+
+Returns the patch version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "2".
+
+=cut
+
+sub patch_version { $croak->(shift, 'patch_version') }
+
+##############################################################################
+
+=head3 bin_dir
+
+  my $bin_dir = $app->bin_dir;
+
+Returns the full path the application's bin directory, if it exists.
+
+=cut
+
+sub bin_dir { $croak->(shift, 'bin_dir') }
+
+##############################################################################
+
+=head3 inc_dir
+
+  my $inc_dir = $app->inc_dir;
+
+Returns the full path the application's include directory, if it exists.
+
+=cut
+
+sub inc_dir { $croak->(shift, 'inc_dir') }
+
+##############################################################################
+
+=head3 lib_dir
+
+  my $lib_dir = $app->lib_dir;
+
+Returns the full path the application's lib directory, if it exists.
+
+=cut
+
+sub lib_dir { $croak->(shift, 'lib_dir') }
+
+##############################################################################
+
+=head3 so_lib_dir
+
+  my $so_lib_dir = $app->so_lib_dir;
+
+Returns the full path the application's shared library directory, if it
+exists.
+
+=cut
+
+sub so_lib_dir { $croak->(shift, 'so_lib_dir') }
+
+##############################################################################
+
+=head3 home_url
+
+  my $home_url = $app->home_url;
+
+The URL for the software's home page.
+
+=cut
+
+sub home_url  { $croak->(shift, 'home_url') }
+
+##############################################################################
+
+=head3 download_url
+
+  my $download_url = $app->download_url;
+
+The URL for the software's download page.
+
+=cut
+
+sub download_url  { $croak->(shift, 'download_url') }
+
+##############################################################################
+##############################################################################
+
+=head2 Event Handler Object Methods
+
+These methods provide control over App::Info event handling. Events can be
+handled by one or more objects of subclasses of App::Info::Handler. The first
+to return a true value will be the last to execute. This approach allows
+handlers to be stacked, and makes it relatively easy to create new handlers.
+L<App::Info::Handler|App::Info::Handler> for information on writing event
+handlers.
+
+Each of the event handler methods takes a list of event handlers as its
+arguments. If none are passed, the existing list of handlers for the relevant
+event type will be returned. If new handlers are passed in, they will be
+returned.
+
+The event handlers may be specified as one or more objects of the
+App::Info::Handler class or subclasses, as one or more strings that tell
+App::Info construct such handlers itself, or a combination of the two. The
+strings can only be used if the relevant App::Info::Handler subclasses have
+registered strings with App::Info. For example, the App::Info::Handler::Print
+class included in the App::Info distribution registers the strings "stderr"
+and "stdout" when it starts up. These strings may then be used to tell
+App::Info to construct App::Info::Handler::Print objects that print to STDERR
+or to STDOUT, respectively. See the App::Info::Handler subclasses for what
+strings they register with App::Info.
+
+=head3 on_info
+
+  my @handlers = $app->on_info;
+  $app->on_info(@handlers);
+
+Info events are triggered when the App::Info subclass wants to send an
+informational status message. By default, these events are ignored, but a
+common need is for such messages to simply print to STDOUT. Use the
+L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the
+App::Info distribution to have info messages print to STDOUT:
+
+  use App::Info::Handler::Print;
+  $app->on_info('stdout');
+  # Or:
+  my $stdout_handler = App::Info::Handler::Print->new('stdout');
+  $app->on_info($stdout_handler);
+
+=cut
+
+sub on_info {
+    my $self = shift;
+    $self->{on_info} = $set_handlers->(\@_) if @_;
+    return @{ $self->{on_info} };
+}
+
+=head3 on_error
+
+  my @handlers = $app->on_error;
+  $app->on_error(@handlers);
+
+Error events are triggered when the App::Info subclass runs into an unexpected
+but not fatal problem. (Note that fatal problems will likely throw an
+exception.) By default, these events are ignored. A common way of handling
+these events is to print them to STDERR, once again using the
+L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the
+App::Info distribution:
+
+  use App::Info::Handler::Print;
+  my $app->on_error('stderr');
+  # Or:
+  my $stderr_handler = App::Info::Handler::Print->new('stderr');
+  $app->on_error($stderr_handler);
+
+Another approach might be to turn such events into fatal exceptions. Use the
+included L<App::Info::Handler::Carp|App::Info::Handler::Carp> class for this
+purpose:
+
+  use App::Info::Handler::Carp;
+  my $app->on_error('croak');
+  # Or:
+  my $croaker = App::Info::Handler::Carp->new('croak');
+  $app->on_error($croaker);
+
+=cut
+
+sub on_error {
+    my $self = shift;
+    $self->{on_error} = $set_handlers->(\@_) if @_;
+    return @{ $self->{on_error} };
+}
+
+=head3 on_unknown
+
+  my @handlers = $app->on_unknown;
+  $app->on_uknown(@handlers);
+
+Unknown events are trigged when the App::Info subclass cannot find the value
+to be returned by a method call. By default, these events are ignored. A
+common way of handling them is to have the application prompt the user for the
+relevant data. The App::Info::Handler::Prompt class included with the
+App::Info distribution can do just that:
+
+  use App::Info::Handler::Prompt;
+  my $app->on_unknown('prompt');
+  # Or:
+  my $prompter = App::Info::Handler::Prompt;
+  $app->on_unknown($prompter);
+
+See L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> for information
+on how it works.
+
+=cut
+
+sub on_unknown {
+    my $self = shift;
+    $self->{on_unknown} = $set_handlers->(\@_) if @_;
+    return @{ $self->{on_unknown} };
+}
+
+=head3 on_confirm
+
+  my @handlers = $app->on_confirm;
+  $app->on_confirm(@handlers);
+
+Confirm events are triggered when the App::Info subclass has found an
+important piece of information (such as the location of the executable it'll
+use to collect information for the rest of its methods) and wants to confirm
+that the information is correct. These events will most often be triggered
+during the App::Info subclass object construction. Here, too, the
+App::Info::Handler::Prompt class included with the App::Info distribution can
+help out:
+
+  use App::Info::Handler::Prompt;
+  my $app->on_confirm('prompt');
+  # Or:
+  my $prompter = App::Info::Handler::Prompt;
+  $app->on_confirm($prompter);
+
+=cut
+
+sub on_confirm {
+    my $self = shift;
+    $self->{on_confirm} = $set_handlers->(\@_) if @_;
+    return @{ $self->{on_confirm} };
+}
+
+##############################################################################
+##############################################################################
+
+=head1 SUBCLASSING
+
+As an abstract base class, App::Info is not intended to be used directly.
+Instead, you'll use concrete subclasses that implement the interface it
+defines. These subclasses each provide the metadata necessary for a given
+software package, via the interface outlined above (plus any additional
+methods the class author deems sensible for a given application).
+
+This section describes the facilities App::Info provides for subclassing. The
+goal of the App::Info design has been to make subclassing straight-forward, so
+that developers can focus on gathering the data they need for their
+application and minimize the work necessary to handle unknown values or to
+confirm values. As a result, there are essentially three concepts that
+developers need to understand when subclassing App::Info: organization,
+utility methods, and events.
+
+=head2 Organization
+
+The organizational idea behind App::Info is to name subclasses by broad
+software categories. This approach allows the categories themselves to
+function as abstract base classes that extend App::Info, so that they can
+specify more methods for all of their base classes to implement. For example,
+App::Info::HTTPD has specified the C<httpd_root()> abstract method that its
+subclasses must implement. So as you get ready to implement your own subclass,
+think about what category of software you're gathering information about.
+New categories can be added as necessary.
+
+=head2 Utility Methods
+
+Once you've decided on the proper category, you can start implementing your
+App::Info concrete subclass. As you do so, take advantage of App::Info::Util,
+wherein I've tried to encapsulate common functionality to make subclassing
+easier. I found that most of what I was doing repetitively was looking for
+files and directories, and searching through files. Thus, App::Info::Util
+subclasses L<File::Spec|File::Spec> in order to offer easy access to
+commonly-used methods from that class, e.g., C<path()>. Plus, it has several
+of its own methods to assist you in finding files and directories in lists of
+files and directories, as well as methods for searching through files and
+returning the values found in those files. See
+L<App::Info::Util|App::Info::Util> for more information, and the App::Info
+subclasses in this distribution for usage examples.
+
+I recommend the use of a package-scoped lexical App::Info::Util object. That
+way it's nice and handy when you need to carry out common tasks. If you find
+you're doing something over and over that's not already addressed by an
+App::Info::Util method, consider submitting a patch to App::Info::Util to add
+the functionality you need.
+
+=head2 Events
+
+Use the methods described below to trigger events. Events are designed to
+provide a simple way for App::Info subclass developers to send status messages
+and errors, to confirm data values, and to request a value when the class
+caonnot determine a value itself. Events may optionally be handled by module
+users who assign App::Info::Handler subclass objects to your App::Info
+subclass object using the event handling methods described in the L<"Event
+Handler Object Methods"> section.
+
+=cut
+
+##############################################################################
+# This code reference is used by the event methods to manage the stack of
+# event handlers that may be available to handle each of the events.
+my $handler = sub {
+    my ($self, $meth, $params) = @_;
+
+    # Sanity check. We really want to keep control over this.
+    Carp::croak("Cannot call protected method $meth()")
+      unless UNIVERSAL::isa($self, scalar caller(1));
+
+    # Create the request object.
+    $params->{type} ||= $meth;
+    my $req = App::Info::Request->new(%$params);
+
+    # Do the deed. The ultimate handling handler may die.
+    foreach my $eh (@{$self->{"on_$meth"}}) {
+        last if $eh->handler($req);
+    }
+
+    # Return the requst.
+    return $req;
+};
+
+##############################################################################
+
+=head3 info
+
+  $self->info(@message);
+
+Use this method to display status messages for the user. You may wish to use
+it to inform users that you're searching for a particular file, or attempting
+to parse a file or some other resource for the data you need. For example, a
+common use might be in the object constructor: generally, when an App::Info
+object is created, some important initial piece of information is being
+sought, such as an executable file. That file may be in one of many locations,
+so it makes sense to let the user know that you're looking for it:
+
+  $self->info("Searching for executable");
+
+Note that, due to the nature of App::Info event handlers, your informational
+message may be used or displayed any number of ways, or indeed not at all (as
+is the default behavior).
+
+The C<@message> will be joined into a single string and stored in the
+C<message> attribute of the App::Info::Request object passed to info event
+handlers.
+
+=cut
+
+sub info {
+    my $self = shift;
+    # Execute the handler sequence.
+    my $req = $handler->($self, 'info', { message => join '', @_ });
+}
+
+##############################################################################
+
+=head3 error
+
+  $self->error(@error);
+
+Use this method to inform the user that something unexpected has happened. An
+example might be when you invoke another program to parse its output, but it's
+output isn't what you expected:
+
+  $self->error("Unable to parse version from `/bin/myapp -c`");
+
+As with all events, keep in mind that error events may be handled in any
+number of ways, or not at all.
+
+The C<@erorr> will be joined into a single string and stored in the C<message>
+attribute of the App::Info::Request object passed to error event handlers. If
+that seems confusing, think of it as an "error message" rather than an "error
+error." :-)
+
+=cut
+
+sub error {
+    my $self = shift;
+    # Execute the handler sequence.
+    my $req = $handler->($self, 'error', { message => join '', @_ });
+}
+
+##############################################################################
+
+=head3 unknown
+
+  my $val = $self->unknown(@params);
+
+Use this method when a value is unknown. This will give the user the option --
+assuming the appropriate handler handles the event -- to provide the needed
+data. The value entered will be returned by C<unknown()>. The parameters are
+as follows:
+
+=over 4
+
+=item key
+
+The C<key> parameter uniquely identifies the data point in your class, and is
+used by App::Info to ensure that an unknown event is handled only once, no
+matter how many times the method is called. The same value will be returned by
+subsequent calls to C<unknown()> as was returned by the first call, and no
+handlers will be activated. Typical values are "version" and "lib_dir".
+
+=item prompt
+
+The C<prompt> parameter is the prompt to be displayed should an event handler
+decide to prompt for the appropriate value. Such a prompt might be something
+like "Path to your httpd executable?". If this parameter is not provided,
+App::Info will construct one for you using your class' C<key_name()> method
+and the C<key> parameter. The result would be something like "Enter a valid
+FooApp version". The C<prompt> parameter value will be stored in the
+C<message> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item callback
+
+Assuming a handler has collected a value for your unknown data point, it might
+make sense to validate the value. For example, if you prompt the user for a
+directory location, and the user enters one, it makes sense to ensure that the
+directory actually exists. The C<callback> parameter allows you to do this. It
+is a code reference that takes the new value or values as its arguments, and
+returns true if the value is valid, and false if it is not. For the sake of
+convenience, the first argument to the callback code reference is also stored
+in C<$_> .This makes it easy to validate using functions or operators that,
+er, operate on C<$_> by default, but still allows you to get more information
+from C<@_> if necessary. For the directory example, a good callback might be
+C<sub { -d }>. The C<callback> parameter code reference will be stored in the
+C<callback> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item error
+
+The error parameter is the error message to display in the event that the
+C<callback> code reference returns false. This message may then be used by the
+event handler to let the user know what went wrong with the data she entered.
+For example, if the unknown value was a directory, and the user entered a
+value that the C<callback> identified as invalid, a message to display might
+be something like "Invalid directory path". Note that if the C<error>
+parameter is not provided, App::Info will supply the generic error message
+"Invalid value". This value will be stored in the C<error> attribute of the
+App::Info::Request object passed to event handlers.
+
+=back
+
+This may be the event method you use most, as it should be called in every
+metadata method if you cannot provide the data needed by that method. It will
+typically be the last part of the method. Here's an example demonstrating each
+of the above arguments:
+
+  my $dir = $self->unknown( key      => 'lib_dir',
+                            prompt   => "Enter lib directory path",
+                            callback => sub { -d },
+                            error    => "Not a directory");
+
+=cut
+
+sub unknown {
+    my ($self, %params) = @_;
+    my $key = delete $params{key}
+      or Carp::croak("No key parameter passed to unknown()");
+    # Just return the value if we've already handled this value. Ideally this
+    # shouldn't happen.
+    return $self->{__unknown__}{$key} if exists $self->{__unknown__}{$key};
+
+    # Create a prompt and error message, if necessary.
+    $params{message} = delete $params{prompt} ||
+      "Enter a valid " . $self->key_name . " $key";
+    $params{error} ||= 'Invalid value';
+
+    # Execute the handler sequence.
+    my $req = $handler->($self, "unknown", \%params);
+
+    # Mark that we've provided this value and then return it.
+    $self->{__unknown__}{$key} = $req->value;
+    return $self->{__unknown__}{$key};
+}
+
+##############################################################################
+
+=head3 confirm
+
+  my $val = $self->confirm(@params);
+
+This method is very similar to C<unknown()>, but serves a different purpose.
+Use this method for significant data points where you've found an appropriate
+value, but want to ensure it's really the correct value. A "significant data
+point" is usually a value essential for your class to collect metadata values.
+For example, you might need to locate an executable that you can then call to
+collect other data. In general, this will only happen once for an object --
+during object construction -- but there may be cases in which it is needed
+more than that. But hopefully, once you've confirmed in the constructor that
+you've found what you need, you can use that information to collect the data
+needed by all of the metadata methods and can assume that they'll be right
+because that first, significant data point has been confirmed.
+
+Other than where and how often to call C<confirm()>, its use is quite similar
+to that of C<unknown()>. Its parameters are as follows:
+
+=over
+
+=item key
+
+Same as for C<unknown()>, a string that uniquely identifies the data point in
+your class, and ensures that the event is handled only once for a given key.
+The same value will be returned by subsequent calls to C<confirm()> as was
+returned by the first call for a given key.
+
+=item prompt
+
+Same as for C<unknown()>. Although C<confirm()> is called to confirm a value,
+typically the prompt should request the relevant value, just as for
+C<unknown()>. The difference is that the handler I<should> use the C<value>
+parameter as the default should the user not provide a value. The C<prompt>
+parameter will be stored in the C<message> attribute of the App::Info::Request
+object passed to event handlers.
+
+=item value
+
+The value to be confirmed. This is the value you've found, and it will be
+provided to the user as the default option when they're prompted for a new
+value. This value will be stored in the C<value> attribute of the
+App::Info::Request object passed to event handlers.
+
+=item callback
+
+Same as for C<unknown()>. Because the user can enter data to replace the
+default value provided via the C<value> parameter, you might want to validate
+it. Use this code reference to do so. The callback will be stored in the
+C<callback> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item error
+
+Same as for C<unknown()>: an error message to display in the event that a
+value entered by the user isn't validated by the C<callback> code reference.
+This value will be stored in the C<error> attribute of the App::Info::Request
+object passed to event handlers.
+
+=back
+
+Here's an example usage demonstrating all of the above arguments:
+
+  my $exe = $self->confirm( key      => 'shell',
+                            prompt   => 'Path to your shell?',
+                            value    => '/bin/sh',
+                            callback => sub { -x },
+                            error    => 'Not an executable');
+
+
+=cut
+
+sub confirm {
+    my ($self, %params) = @_;
+    my $key = delete $params{key}
+      or Carp::croak("No key parameter passed to confirm()");
+    return $self->{__confirm__}{$key} if exists $self->{__confirm__}{$key};
+
+    # Create a prompt and error message, if necessary.
+    $params{message} = delete $params{prompt} ||
+      "Enter a valid " . $self->key_name . " $key";
+    $params{error} ||= 'Invalid value';
+
+    # Execute the handler sequence.
+    my $req = $handler->($self, "confirm", \%params);
+
+    # Mark that we've confirmed this value.
+    $self->{__confirm__}{$key} = $req->value;
+
+    return $self->{__confirm__}{$key}
+}
+
+1;
+__END__
+
+=head2 Event Examples
+
+Below I provide some examples demonstrating the use of the event methods.
+These are meant to emphasize the contexts in which it's appropriate to use
+them.
+
+Let's start with the simplest, first. Let's say that to find the version
+number for an application, you need to search a file for the relevant data.
+Your App::Info concrete subclass might have a private method that handles this
+work, and this method is the appropriate place to use the C<info()> and, if
+necessary, C<error()> methods.
+
+  sub _find_version {
+      my $self = shift;
+
+      # Try to find the revelant file. We cover this method below.
+      # Just return if we cant' find it.
+      my $file = $self->_find_file('version.conf') or return;
+
+      # Send a status message.
+      $self->info("Searching '$file' file for version");
+
+      # Search the file. $util is an App::Info::Util object.
+      my $ver = $util->search_file($file, qr/^Version\s+(.*)$/);
+
+      # Trigger an error message, if necessary. We really think we'll have the
+      # value, but we have to cover our butts in the unlikely event that we're
+      # wrong.
+      $self->error("Unable to find version in file '$file'") unless $ver;
+
+      # Return the version number.
+      return $ver;
+  }
+
+Here we've used the C<info()> method to display a status message to let the
+user know what we're doing. Then we used the C<error()> method when something
+unexpected happened, which in this case was that we weren't able to find the
+version number in the file.
+
+Note the C<_find_file()> method we've thrown in. This might be a method that
+we call whenever we need to find a file that might be in one of a list of
+directories. This method, too, will be an appropriate place for an C<info()>
+method call. But rather than call the C<error()> method when the file can't be
+found, you might want to give an event handler a chance to supply that value
+for you. Use the C<unknown()> method for a case such as this:
+
+  sub _find_file {
+      my ($self, $file) = @_;
+
+      # Send a status message.
+      $self->info("Searching for '$file' file");
+
+      # Look for the file. See App::Info:Utility for its interface.
+      my @paths = qw(/usr/conf /etc/conf /foo/conf);
+      my $found = $util->first_cat_path($file, @paths);
+
+      # If we didn't find it, trigger an unknown event to
+      # give a handler a chance to get the value.
+      $found ||= $self->unknown( key      => "file_$file",
+                                 prompt   => "Location of '$file' file?",
+                                 callback => sub { -f },
+                                 error    => "Not a file");
+
+      # Now return the file name, regardless of whether we found it or not.
+      return $found;
+  }
+
+Note how in this method, we've tried to locate the file ourselves, but if we
+can't find it, we trigger an unknown event. This allows clients of our
+App::Info subclass to try to establish the value themselves by having an
+App::Info::Handler subclass handle the event. If a value is found by an
+App::Info::Handler subclass, it will be returned by C<unknown()> and we can
+continue. But we can't assume that the unknown event will even be handled, and
+thus must expect that an unknown value may remain unknown. This is why the
+C<_find_version()> method above simply returns if C<_find_file()> doesn't
+return a file name; there's no point in searching through a file that doesn't
+exist.
+
+Attentive readers may be left to wonder how to decide when to use C<error()>
+and when to use C<unknown()>. To a large extent, this decision must be based
+on one's own understanding of what's most appropriate. Nevertheless, I offer
+the following simple guidelines: Use C<error()> when you expect something to
+work and then it just doesn't (as when a file exists and should contain the
+information you seek, but then doesn't). Use C<unknown()> when you're less
+sure of your processes for finding the value, and also for any of the values
+that should be returned by any of the L<metadata object methods|"Metadata
+Object Methods">. And of course, C<error()> would be more appropriate when you
+encounter an unexpected condition and don't think that it could be handled in
+any other way.
+
+Now, more than likely, a method such C<_find_version()> would be called by the
+C<version()> method, which is a metadata method mandated by the App::Info
+abstract base class. This is an appropriate place to handle an unknown version
+value. Indeed, every one of your metadata methods should make use of the
+C<unknown()> method. The C<version()> method then should look something like
+this:
+
+  sub version {
+      my $self = shift;
+
+      unless (exists $self->{version}) {
+          # Try to find the version number.
+          $self->{version} = $self->_find_version ||
+            $self->unknown( key    => 'version',
+                            prompt => "Enter the version number");
+      }
+
+      # Now return the version number.
+      return $self->{version};
+  }
+
+Note how this method only tries to find the version number once. Any
+subsequent calls to C<version()> will return the same value that was returned
+the first time it was called. Of course, thanks to the C<key> parameter in the
+call to C<unknown()>, we could have have tried to enumerate the version number
+every time, as C<unknown()> will return the same value every time it is called
+(as, indeed, should C<_find_version()>. But by checking for the C<version> key
+in C<$self> ourselves, we save some of the overhead.
+
+But as I said before, every metadata method should make use of the
+C<unknown()> method. Thus, the C<major()> method might looks something like
+this:
+
+  sub major {
+      my $self = shift;
+
+      unless (exists $self->{major}) {
+          # Try to get the major version from the full version number.
+          ($self->{major}) = $self->version =~ /^(\d+)\./;
+          # Handle an unknown value.
+          $self->{major} = $self->unknown( key      => 'major',
+                                           prompt   => "Enter major version",
+                                           callback => sub { /^\d+$/ },
+                                           error    => "Not a number")
+            unless defined $self->{major};
+      }
+
+      return $self->{version};
+  }
+
+Finally, the C<confirm()> method should be used to verify core pieces of data
+that significant numbers of other methods rely on. Typically such data are
+executables or configuration files from which will be drawn other metadata.
+Most often, such major data points will be sought in the object constructor.
+Here's an example:
+
+  sub new {
+      # Construct the object so that handlers will work properly.
+      my $self = shift->SUPER::new(@_);
+
+      # Try to find the executable.
+      $self->info("Searching for executable");
+      if (my $exe = $util->first_exe('/bin/myapp', '/usr/bin/myapp')) {
+          # Confirm it.
+          $self->{exe} =
+            $self->confirm( key      => 'binary',
+                            prompt   => 'Path to your executable?',
+                            value    => $exe,
+                            callback => sub { -x },
+                            error    => 'Not an executable');
+      } else {
+          # Handle an unknown value.
+          $self->{exe} =
+            $self->unknown( key      => 'binary',
+                            prompt   => 'Path to your executable?',
+                            callback => sub { -x },
+                            error    => 'Not an executable');
+      }
+
+      # We're done.
+      return $self;
+  }
+
+By now, most of what's going on here should be quite familiar. The use of the
+C<confirm()> method is quite similar to that of C<unknown()>. Really the only
+difference is that the value is known, but we need verification or a new value
+supplied if the value we found isn't correct. Such may be the case when
+multiple copies of the executable have been installed on the system, we found
+F</bin/myapp>, but the user may really be interested in F</usr/bin/myapp>.
+Thus the C<confirm()> event gives the user the chance to change the value if
+the confirm event is handled.
+
+The final thing to note about this constructor is the first line:
+
+  my $self = shift->SUPER::new(@_);
+
+The first thing an App::Info subclass should do is execute this line to allow
+the super class to construct the object first. Doing so allows any event
+handling arguments to set up the event handlers, so that when we call
+C<confirm()> or C<unknown()> the event will be handled as the client expects.
+
+If we needed our subclass constructor to take its own parameter argumente, the
+approach is to specify the same C<key => $arg> syntax as is used by
+App::Info's C<new()> method. Say we wanted to allow clients of our App::Info
+subclass to pass in a list of alternate executable locations for us to search.
+Such an argument would most make sense as an array reference. So we specify
+that the key be C<alt_paths> and allow the user to construct an object like
+this:
+
+  my $app = App::Info::Category::FooApp->new( alt_paths => \@paths );
+
+This approach allows the super class constructor arguments to pass unmolested
+(as long as we use unique keys!):
+
+  my $app = App::Info::Category::FooApp->new( on_error  => \@handlers,
+                                              alt_paths => \@paths );
+
+Then, to retrieve these paths inside our C<new()> constructor, all we need do
+is access them directly from the object:
+
+  my $self = shift->SUPER::new(@_);
+  my $alt_paths = $self->{alt_paths};
+
+=head2 Subclassing Guidelines
+
+To summarize, here are some guidelines for subclassing App::Info.
+
+=over 4
+
+=item *
+
+Always subclass an App::Info category subclass. This will help to keep the
+App::Info namespace well-organized. New categories can be added as needed.
+
+=item *
+
+When you create the C<new()> constructor, always call C<SUPER::new(@_)>. This
+ensures that the event handling methods methods defined by the App::Info base
+classes (e.g., C<error()>) will work properly.
+
+=item *
+
+Use a package-scoped lexical App::Info::Util object to carry out common tasks.
+If you find you're doing something over and over that's not already addressed
+by an App::Info::Util method, and you think that others might find your
+solution useful, consider submitting a patch to App::Info::Util to add the
+functionality you need. See L<App::Info::Util|App::Info::Util> for complete
+documentation of its interface.
+
+=item *
+
+Use the C<info()> event triggering method to send messages to users of your
+subclass.
+
+=item *
+
+Use the C<error()> event triggering method to alert users of unexpected
+conditions. Fatal errors should still be fatal; use C<Carp::croak()> to throw
+exceptions for fatal errors.
+
+=item *
+
+Use the C<unknown()> event triggering method when a metadata or other
+important value is unknown and you want to give any event handlers the chance
+to provide the data.
+
+=item *
+
+Use the C<confirm()> event triggering method when a core piece of data is
+known (such as the location of an executable in the C<new()> constructor) and
+you need to make sure that you have the I<correct> information.
+
+=item *
+
+Be sure to implement B<all> of the abstract methods defined by App::Info and
+by your category abstract base class -- even if they don't do anything. Doing
+so ensures that all App::Info subclasses share a common interface, and can, if
+necessary, be used without regard to subclass. Any method not implemented but
+called on an object will generate a fatal exception.
+
+=back
+
+Otherwise, have fun! There are a lot of software packages for which relevant
+information might be collected and aggregated into an App::Info concrete
+subclass (witness all of the Automake macros in the world!), and folks who are
+knowledgeable about particular software packages or categories of software are
+warmly invited to contribute. As more subclasses are implemented, it will make
+sense, I think, to create separate distributions based on category -- or even,
+when necessary, on a single software package. Broader categories can then be
+aggregated in Bundle distributions.
+
+But I get ahead of myself...
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+The following classes define a few software package categories in which
+App::Info subclasses can be placed. Check them out for ideas on how to
+create new category subclasses.
+
+=over 4
+
+=item L<App::Info::HTTP|App::Info::HTTPD>
+
+=item L<App::Info::RDBMS|App::Info::RDBMS>
+
+=item L<App::Info::Lib|App::Info::Lib>
+
+=back
+
+The following classes implement the App::Info interface for various software
+packages. Check them out for examples of how to implement new App::Info
+concrete subclasses.
+
+=over
+
+=item L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache>
+
+=item L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=item L<App::Info::Lib::Expat|App::Info::Lib::Expat>
+
+=item L<App::Info::Lib::Iconv|App::Info::Lib::Iconv>
+
+=back
+
+L<App::Info::Util|App::Info::Util> provides utility methods for App::Info
+subclasses.
+
+L<App::Info::Handler|App::Info::Handler> defines an interface for event
+handlers to subclass. Consult its documentation for information on creating
+custom event handlers.
+
+The following classes implement the App::Info::Handler interface to offer some
+simple event handling. Check them out for examples of how to implement new
+App::Info::Handler subclasses.
+
+=over 4
+
+=item L<App::Info::Handler::Print|App::Info::Handler::Print>
+
+=item L<App::Info::Handler::Carp|App::Info::Handler::Carp>
+
+=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm
new file mode 100644 (file)
index 0000000..65416a8
--- /dev/null
@@ -0,0 +1,305 @@
+package App::Info::Handler;
+
+# $Id: Handler.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+App::Info::Handler - App::Info event handler base class
+
+=head1 SYNOPSIS
+
+  use App::Info::Category::FooApp;
+  use App::Info::Handler;
+
+  my $app = App::Info::Category::FooApp->new( on_info => ['default'] );
+
+=head1 DESCRIPTION
+
+This class defines the interface for subclasses that wish to handle events
+triggered by App::Info concrete subclasses. The different types of events
+triggered by App::Info can all be handled by App::Info::Handler (indeed, by
+default they're all handled by a single App::Info::Handler object), and
+App::Info::Handler subclasses may be designed to handle whatever events they
+wish.
+
+If you're interested in I<using> an App::Info event handler, this is probably
+not the class you should look at, since all it does is define a simple handler
+that does nothing with an event. Look to the L<App::Info::Handler
+subclasses|"SEE ALSO"> included in this distribution to do more interesting
+things with App::Info events.
+
+If, on the other hand, you're interested in implementing your own event
+handlers, read on!
+
+=cut
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.22';
+
+my %handlers;
+
+=head1 INTERFACE
+
+This section documents the public interface of App::Info::Handler.
+
+=head2 Class Method
+
+=head3 register_handler
+
+  App::Info::Handler->register_handler( $key => $code_ref );
+
+This class method may be used by App::Info::Handler subclasses to register
+themselves with App::Info::Handler. Multiple registrations are supported. The
+idea is that a subclass can define different functionality by specifying
+different strings that represent different modes of constructing an
+App::Info::Handler subclass object. The keys are case-sensitve, and should be
+unique across App::Info::Handler subclasses so that many subclasses can be
+loaded and used separately. If the C<$key> is already registered,
+C<register_handler()> will throw an exception. The values are code references
+that, when executed, return the appropriate App::Info::Handler subclass
+object.
+
+=cut
+
+sub register_handler {
+    my ($pkg, $key, $code) = @_;
+    Carp::croak("Handler '$key' already exists")
+      if $handlers{$key};
+    $handlers{$key} = $code;
+}
+
+# Register ourself.
+__PACKAGE__->register_handler('default', sub { __PACKAGE__->new } );
+
+##############################################################################
+
+=head2 Constructor
+
+=head3 new
+
+  my $handler = App::Info::Handler->new;
+  $handler =  App::Info::Handler->new( key => $key);
+
+Constructs an App::Info::Handler object and returns it. If the key parameter
+is provided and has been registered by an App::Info::Handler subclass via the
+C<register_handler()> class method, then the relevant code reference will be
+executed and the resulting App::Info::Handler subclass object returned. This
+approach provides a handy shortcut for having C<new()> behave as an abstract
+factory method, returning an object of the subclass appropriate to the key
+parameter.
+
+=cut
+
+sub new {
+    my ($pkg, %p) = @_;
+    my $class = ref $pkg || $pkg;
+    $p{key} ||= 'default';
+    if ($class eq __PACKAGE__ && $p{key} ne 'default') {
+        # We were called directly! Handle it.
+        Carp::croak("No such handler '$p{key}'") unless $handlers{$p{key}};
+        return $handlers{$p{key}}->();
+    } else {
+        # A subclass called us -- just instantiate and return.
+        return bless \%p, $class;
+    }
+}
+
+=head2 Instance Method
+
+=head3 handler
+
+  $handler->handler($req);
+
+App::Info::Handler defines a single instance method that must be defined by
+its subclasses, C<handler()>. This is the method that will be executed by an
+event triggered by an App::Info concrete subclass. It takes as its single
+argument an App::Info::Request object, and returns a true value if it has
+handled the event request. Returning a false value declines the request, and
+App::Info will then move on to the next handler in the chain.
+
+The C<handler()> method implemented in App::Info::Handler itself does nothing
+more than return a true value. It thus acts as a very simple default event
+handler. See the App::Info::Handler subclasses for more interesting handling
+of events, or create your own!
+
+=cut
+
+sub handler { 1 }
+
+1;
+__END__
+
+=head1 SUBCLASSING
+
+I hatched the idea of the App::Info event model with its subclassable handlers
+as a way of separating the aggregation of application metadata from writing a
+user interface for handling certain conditions. I felt it a better idea to
+allow people to create their own user interfaces, and instead to provide only
+a few examples. The App::Info::Handler class defines the API interface for
+handling these conditions, which App::Info refers to as "events".
+
+There are various types of events defined by App::Info ("info", "error",
+"unknown", and "confirm"), but the App::Info::Handler interface is designed to
+be flexible enough to handle any and all of them. If you're interested in
+creating your own App::Info event handler, this is the place to learn how.
+
+=head2 The Interface
+
+To create an App::Info event handler, all one need do is subclass
+App::Info::Handler and then implement the C<new()> constructor and the
+C<handler()> method. The C<new()> constructor can do anything you like, and
+take any arguments you like. However, I do recommend that the first thing
+you do in your implementation is to call the super constructor:
+
+  sub new {
+      my $pkg = shift;
+      my $self = $pkg->SUPER::new(@_);
+      # ... other stuff.
+      return $self;
+  }
+
+Although the default C<new()> constructor currently doesn't do much, that may
+change in the future, so this call will keep you covered. What it does do is
+take the parameterized arguments and assign them to the App::Info::Handler
+object. Thus if you've specified a "mode" argument, where clients can
+construct objects of you class like this:
+
+  my $handler = FooHandler->new( mode => 'foo' );
+
+You can access the mode parameter directly from the object, like so:
+
+  sub new {
+      my $pkg = shift;
+      my $self = $pkg->SUPER::new(@_);
+      if ($self->{mode} eq 'foo') {
+          # ...
+      }
+      return $self;
+  }
+
+Just be sure not to use a parameter key name required by App::Info::Handler
+itself. At the moment, the only parameter accepted by App::Info::Handler is
+"key", so in general you'll be pretty safe.
+
+Next, I recommend that you take advantage of the C<register_handler()> method
+to create some shortcuts for creating handlers of your class. For example, say
+we're creating a handler subclass FooHandler. It has two modes, a default
+"foo" mode and an advanced "bar" mode. To allow both to be constructed by
+stringified shortcuts, the FooHandler class implementation might start like
+this:
+
+  package FooHandler;
+
+  use strict;
+  use App::Info::Handler;
+  use vars qw(@ISA);
+  @ISA = qw(App::Info::Handler);
+
+  foreach my $c (qw(foo bar)) {
+      App::Info::Handler->register_handler
+        ( $c => sub { __PACKAGE__->new( mode => $c) } );
+  }
+
+The strings "foo" and "bar" can then be used by clients as shortcuts to have
+App::Info objects automatically create and use handlers for certain events.
+For example, if a client wanted to use a "bar" event handler for its info
+events, it might do this:
+
+  use App::Info::Category::FooApp;
+  use FooHandler;
+
+  my $app = App::Info::Category::FooApp->new(on_info => ['bar']);
+
+Take a look at App::Info::Handler::Print and App::Info::Handler::Carp to see
+concrete examples of C<register_handler()> usage.
+
+The final step in creating a new App::Info event handler is to implement the
+C<handler()> method itself. This method takes a single argument, an
+App::Info::Request object, and is expected to return true if it handled the
+request, and false if it did not. The App::Info::Request object contains all
+the metadata relevant to a request, including the type of event that triggered
+it; see L<App::Info::Request|App::Info::Request> for its documentation.
+
+Use the App::Info::Request object however you like to handle the request
+however you like. You are, however, expected to abide by a a few guidelines:
+
+=over 4
+
+=item *
+
+For error and info events, you are expected (but not required) to somehow
+display the info or error message for the user. How your handler chooses to do
+so is up to you and the handler.
+
+=item *
+
+For unknown and confirm events, you are expected to prompt the user for a
+value. If it's a confirm event, offer the known value (found in
+C<$req-E<gt>value>) as a default.
+
+=item *
+
+For unknown and confirm events, you are expected to call C<$req-E<gt>callback>
+and pass in the new value. If C<$req-E<gt>callback> returns a false value, you
+are expected to display the error message in C<$req-E<gt>error> and prompt the
+user again. Note that C<$req-E<gt>value> calls C<$req-E<gt>callback>
+internally, and thus assigns the value and returns true if
+C<$req-E<gt>callback> returns true, and does not assign the value and returns
+false if C<$req-E<gt>callback> returns false.
+
+=item *
+
+For unknown and confirm events, if you've collected a new value and
+C<$req-E<gt>callback> returns true for that value, you are expected to assign
+the value by passing it to C<$req-E<gt>value>. This allows App::Info to give
+the value back to the calling App::Info concrete subclass.
+
+=back
+
+Probably the easiest way to get started creating new App::Info event handlers
+is to check out the simple handlers provided with the distribution and follow
+their logical examples. Consult the App::Info documentation of the L<event
+methods|App::Info/"Events"> for details on how App::Info constructs the
+App::Info::Request object for each event type.
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> thoroughly documents the client interface for setting
+event handlers, as well as the event triggering interface for App::Info
+concrete subclasses.
+
+L<App::Info::Request|App::Info::Request> documents the interface for the
+request objects passed to App::Info::Handler C<handler()> methods.
+
+The following App::Info::Handler subclasses offer examples for event handler
+authors, and, of course, provide actual event handling functionality for
+App::Info clients.
+
+=over 4
+
+=item L<App::Info::Handler::Carp|App::Info::Handler::Carp>
+
+=item L<App::Info::Handler::Print|App::Info::Handler::Print>
+
+=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm
new file mode 100644 (file)
index 0000000..47edd78
--- /dev/null
@@ -0,0 +1,170 @@
+package App::Info::Handler::Prompt;
+
+# $Id: Prompt.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $
+
+=head1 NAME
+
+App::Info::Handler::Prompt - Prompting App::Info event handler
+
+=head1 SYNOPSIS
+
+  use App::Info::Category::FooApp;
+  use App::Info::Handler::Print;
+
+  my $prompter = App::Info::Handler::Print->new;
+  my $app = App::Info::Category::FooApp->new( on_unknown => $prompter );
+
+  # Or...
+  my $app = App::Info::Category::FooApp->new( on_confirm => 'prompt' );
+
+=head1 DESCRIPTION
+
+App::Info::Handler::Prompt objects handle App::Info events by printing their
+messages to C<STDOUT> and then accepting a new value from C<STDIN>. The new
+value is validated by any callback supplied by the App::Info concrete subclass
+that triggered the event. If the value is valid, App::Info::Handler::Prompt
+assigns the new value to the event request. If it isn't it prints the error
+message associated with the event request, and then prompts for the data
+again.
+
+Although designed with unknown and confirm events in mind,
+App::Info::Handler::Prompt handles info and error events as well. It will
+simply print info event messages to C<STDOUT> and print error event messages
+to C<STDERR>. For more interesting info and error event handling, see
+L<App::Info::Handler::Print|App::Info::Handler::Print> and
+L<App::Info::Handler::Carp|App::Info::Handler::Carp>.
+
+Upon loading, App::Info::Handler::Print registers itself with
+App::Info::Handler, setting up a single string, "prompt", that can be passed
+to an App::Info concrete subclass constructor. This string is a shortcut that
+tells App::Info how to create an App::Info::Handler::Print object for handling
+events.
+
+=cut
+
+use strict;
+use App::Info::Handler;
+use vars qw($VERSION @ISA);
+$VERSION = '0.22';
+@ISA = qw(App::Info::Handler);
+
+# Register ourselves.
+App::Info::Handler->register_handler
+  ('prompt' => sub { __PACKAGE__->new('prompt') } );
+
+=head1 INTERFACE
+
+=head2 Constructor
+
+=head3 new
+
+  my $prompter = App::Info::Handler::Prompt->new;
+
+Constructs a new App::Info::Handler::Prompt object and returns it. No special
+arguments are required.
+
+=cut
+
+sub new {
+    my $pkg = shift;
+    my $self = $pkg->SUPER::new(@_);
+    $self->{tty} = -t STDIN && ( -t STDOUT || !( -f STDOUT || -c STDOUT ) );
+    # We're done!
+    return $self;
+}
+
+my $get_ans = sub {
+    my ($prompt, $tty, $def) = @_;
+    # Print the message.
+    local $| = 1;
+    local $\;
+    print $prompt;
+
+    # Collect the answer.
+    my $ans;
+    if ($tty) {
+        $ans = <STDIN>;
+        if (defined $ans ) {
+            chomp $ans;
+        } else { # user hit ctrl-D
+            print "\n";
+        }
+    } else {
+        print "$def\n" if defined $def;
+    }
+    return $ans;
+};
+
+sub handler {
+    my ($self, $req) = @_;
+    my $ans;
+    my $type = $req->type;
+    if ($type eq 'unknown' || $type eq 'confirm') {
+        # We'll want to prompt for a new value.
+        my $val = $req->value;
+        my ($def, $dispdef) = defined $val ? ($val, " [$val] ") : ('', ' ');
+        my $msg = $req->message or Carp::croak("No message in request");
+        $msg .= $dispdef;
+
+        # Get the answer.
+        $ans = $get_ans->($msg, $self->{tty}, $def);
+        # Just return if they entered an empty string or we couldnt' get an
+        # answer.
+        return 1 unless defined $ans && $ans ne '';
+
+        # Validate the answer.
+        my $err = $req->error;
+        while (!$req->value($ans)) {
+            print "$err: '$ans'\n";
+            $ans = $get_ans->($msg, $self->{tty}, $def);
+            return 1 unless defined $ans && $ans ne '';
+        }
+
+    } elsif ($type eq 'info') {
+        # Just print the message.
+        print STDOUT $req->message, "\n";
+    } elsif ($type eq 'error') {
+        # Just print the message.
+        print STDERR $req->message, "\n";
+    } else {
+        # This shouldn't happen.
+        Carp::croak("Invalid request type '$type'");
+    }
+
+    # Return true to indicate that we've handled the request.
+    return 1;
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event handling interface.
+
+L<App::Info::Handler::Carp|App::Info::Handler::Carp> handles events by
+passing their messages Carp module functions.
+
+L<App::Info::Handler::Print|App::Info::Handler::Print> handles events by
+printing their messages to a file handle.
+
+L<App::Info::Handler|App::Info::Handler> describes how to implement custom
+App::Info event handlers.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm
new file mode 100644 (file)
index 0000000..504d570
--- /dev/null
@@ -0,0 +1,55 @@
+package App::Info::RDBMS;
+
+# $Id: RDBMS.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+use strict;
+use App::Info;
+use vars qw(@ISA $VERSION);
+@ISA = qw(App::Info);
+$VERSION = '0.22';
+
+1;
+__END__
+
+=head1 NAME
+
+App::Info::RDBMS - Information&