summaryrefslogtreecommitdiff
path: root/install/5.005
diff options
context:
space:
mode:
Diffstat (limited to 'install/5.005')
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/Changes352
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/MANIFEST38
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/Makefile.PL83
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/Pg.h46
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/Pg.pm1913
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs644
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/README166
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/README.win3263
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/dbd-pg.pod411
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c2024
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.h81
-rwxr-xr-xinstall/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl70
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl74
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch82
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/00basic.t10
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/01connect.t26
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/01constants.t25
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/01setup.t38
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/02prepare.t84
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/03bind.t85
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/04execute.t113
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/05fetch.t131
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/06disconnect.t31
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/07reuse.t28
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/08txn.t102
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/09autocommit.t68
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/11quoting.t50
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/12placeholders.t125
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/13pgtype.t43
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t353
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/99cleanup.t24
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm1167
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm305
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm170
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm55
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm730
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm287
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm456
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes62
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm367
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm141
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm37
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm38
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm300
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm113
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm175
-rwxr-xr-xinstall/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm141
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm126
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm471
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST19
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP1
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL11
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/README42
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO6
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t5
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t12
-rw-r--r--install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t5
57 files changed, 12625 insertions, 0 deletions
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
index 000000000..c3456283e
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Changes
@@ -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
index 000000000..7d1b7000f
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/MANIFEST
@@ -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
index 000000000..0633280c7
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Makefile.PL
@@ -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
index 000000000..b77a9f8b2
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.h
@@ -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
index 000000000..284e56346
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.pm
@@ -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
index 000000000..e5e4362ef
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs
@@ -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
index 000000000..7edebde9a
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/README
@@ -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
index 000000000..3cbe6734a
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/README.win32
@@ -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
index 000000000..ccbbc6394
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/dbd-pg.pod
@@ -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
index 000000000..55f4ee726
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.c
@@ -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
index 000000000..58c105bfc
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/dbdimp.h
@@ -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
index 000000000..b084f70f5
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl
@@ -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
index 000000000..6192c4926
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl
@@ -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
index 000000000..6f8acf800
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch
@@ -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
index 000000000..1c0cb2862
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/00basic.t
@@ -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
index 000000000..be17b5087
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01connect.t
@@ -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
index 000000000..09907e9d4
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01constants.t
@@ -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
index 000000000..d0b57a345
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/01setup.t
@@ -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
index 000000000..373aca27d
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/02prepare.t
@@ -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
index 000000000..df7c8843e
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/03bind.t
@@ -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
index 000000000..964387802
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/04execute.t
@@ -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
index 000000000..b6f8f66d0
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/05fetch.t
@@ -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
index 000000000..5d76bc0a8
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/06disconnect.t
@@ -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
index 000000000..d09dfc010
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/07reuse.t
@@ -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
index 000000000..467aa3153
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/08txn.t
@@ -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
index 000000000..9b1b69fc6
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/09autocommit.t
@@ -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
index 000000000..afec9632a
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/11quoting.t
@@ -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
index 000000000..bd79ea72b
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/12placeholders.t
@@ -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
index 000000000..8db819ee9
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/13pgtype.t
@@ -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
index 000000000..1bc2cf961
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t
@@ -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
index 000000000..e7563abaa
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/99cleanup.t
@@ -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
index 000000000..417247fe7
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info.pm
@@ -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
index 000000000..65416a84a
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler.pm
@@ -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
index 000000000..47edd7802
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Handler/Prompt.pm
@@ -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
index 000000000..504d5700d
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS.pm
@@ -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 about databases on a system
+
+=head1 DESCRIPTION
+
+This class is an abstract base class for App::Info subclasses that provide
+information about relational databases. Its subclasses are required to
+implement its interface. See L<App::Info|App::Info> for a complete description
+and L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL> for an example
+implementation.
+
+=head1 INTERFACE
+
+Currently, App::Info::RDBMS adds no more methods than those from its parent
+class, App::Info.
+
+=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>,
+L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=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/PostgreSQL.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm
new file mode 100644
index 000000000..aef326cca
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm
@@ -0,0 +1,730 @@
+package App::Info::RDBMS::PostgreSQL;
+
+# $Id: PostgreSQL.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $
+
+=head1 NAME
+
+App::Info::RDBMS::PostgreSQL - Information about PostgreSQL
+
+=head1 SYNOPSIS
+
+ use App::Info::RDBMS::PostgreSQL;
+
+ my $pg = App::Info::RDBMS::PostgreSQL->new;
+
+ if ($pg->installed) {
+ print "App name: ", $pg->name, "\n";
+ print "Version: ", $pg->version, "\n";
+ print "Bin dir: ", $pg->bin_dir, "\n";
+ } else {
+ print "PostgreSQL is not installed. :-(\n";
+ }
+
+=head1 DESCRIPTION
+
+App::Info::RDBMS::PostgreSQL supplies information about the PostgreSQL
+database server installed on the local system. It implements all of the
+methods defined by App::Info::RDBMS. Methods that trigger events will trigger
+them only the first time they're called (See L<App::Info|App::Info> for
+documentation on handling events). To start over (after, say, someone has
+installed PostgreSQL) construct a new App::Info::RDBMS::PostgreSQL object to
+aggregate new metadata.
+
+Some of the methods trigger the same events. This is due to cross-calling of
+shared subroutines. However, any one event should be triggered no more than
+once. For example, although the info event "Executing `pg_config --version`"
+is documented for the methods C<name()>, C<version()>, C<major_version()>,
+C<minor_version()>, and C<patch_version()>, rest assured that it will only be
+triggered once, by whichever of those four methods is called first.
+
+=cut
+
+use strict;
+use App::Info::RDBMS;
+use App::Info::Util;
+use vars qw(@ISA $VERSION);
+@ISA = qw(App::Info::RDBMS);
+$VERSION = '0.22';
+
+my $u = App::Info::Util->new;
+
+=head1 INTERFACE
+
+=head2 Constructor
+
+=head3 new
+
+ my $pg = App::Info::RDBMS::PostgreSQL->new(@params);
+
+Returns an App::Info::RDBMS::PostgreSQL object. See L<App::Info|App::Info> for
+a complete description of argument parameters.
+
+When it called, C<new()> searches the file system for the F<pg_config>
+application. If found, F<pg_config> will be called by the object methods below
+to gather the data necessary for each. If F<pg_config> cannot be found, then
+PostgreSQL is assumed not to be installed, and each of the object methods will
+return C<undef>.
+
+App::Info::RDBMS::PostgreSQL searches for F<pg_config> along your path, as
+defined by C<File::Spec-E<gt>path>. Failing that, it searches the following
+directories:
+
+=over 4
+
+=item /usr/local/pgsql/bin
+
+=item /usr/local/postgres/bin
+
+=item /opt/pgsql/bin
+
+=item /usr/local/bin
+
+=item /usr/local/sbin
+
+=item /usr/bin
+
+=item /usr/sbin
+
+=item /bin
+
+=back
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Looking for pg_config
+
+=item confirm
+
+Path to pg_config?
+
+=item unknown
+
+Path to pg_config?
+
+=back
+
+=cut
+
+sub new {
+ # Construct the object.
+ my $self = shift->SUPER::new(@_);
+
+ # Find pg_config.
+ $self->info("Looking for pg_config");
+ my @paths = ($u->path,
+ qw(/usr/local/pgsql/bin
+ /usr/local/postgres/bin
+ /opt/pgsql/bin
+ /usr/local/bin
+ /usr/local/sbin
+ /usr/bin
+ /usr/sbin
+ /bin));
+
+ if (my $cfg = $u->first_cat_exe('pg_config', @paths)) {
+ # We found it. Confirm.
+ $self->{pg_config} = $self->confirm( key => 'pg_config',
+ prompt => 'Path to pg_config?',
+ value => $cfg,
+ callback => sub { -x },
+ error => 'Not an executable');
+ } else {
+ # Handle an unknown value.
+ $self->{pg_config} = $self->unknown( key => 'pg_config',
+ prompt => 'Path to pg_config?',
+ callback => sub { -x },
+ error => 'Not an executable');
+ }
+
+ return $self;
+}
+
+# We'll use this code reference as a common way of collecting data.
+my $get_data = sub {
+ return unless $_[0]->{pg_config};
+ $_[0]->info("Executing `$_[0]->{pg_config} $_[1]`");
+ my $info = `$_[0]->{pg_config} $_[1]`;
+ chomp $info;
+ return $info;
+};
+
+##############################################################################
+
+=head2 Class Method
+
+=head3 key_name
+
+ my $key_name = App::Info::RDBMS::PostgreSQL->key_name;
+
+Returns the unique key name that describes this class. The value returned is
+the string "PostgreSQL".
+
+=cut
+
+sub key_name { 'PostgreSQL' }
+
+##############################################################################
+
+=head2 Object Methods
+
+=head3 installed
+
+ print "PostgreSQL is ", ($pg->installed ? '' : 'not '), "installed.\n";
+
+Returns true if PostgreSQL is installed, and false if it is not.
+App::Info::RDBMS::PostgreSQL determines whether PostgreSQL is installed based
+on the presence or absence of the F<pg_config> application on the file system
+as found when C<new()> constructed the object. If PostgreSQL does not appear
+to be installed, then all of the other object methods will return empty
+values.
+
+=cut
+
+sub installed { return $_[0]->{pg_config} ? 1 : undef }
+
+##############################################################################
+
+=head3 name
+
+ my $name = $pg->name;
+
+Returns the name of the application. App::Info::RDBMS::PostgreSQL parses the
+name from the system call C<`pg_config --version`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL name
+
+=back
+
+=cut
+
+# This code reference is used by name(), version(), major_version(),
+# minor_version(), and patch_version() to aggregate the data they need.
+my $get_version = sub {
+ my $self = shift;
+ $self->{'--version'} = 1;
+ my $data = $get_data->($self, '--version');
+ unless ($data) {
+ $self->error("Failed to find PostgreSQL version with ".
+ "`$self->{pg_config} --version");
+ return;
+ }
+
+ chomp $data;
+ my ($name, $version) = split /\s+/, $data, 2;
+
+ # Check for and assign the name.
+ $name ?
+ $self->{name} = $name :
+ $self->error("Unable to parse name from string '$data'");
+
+ # Parse the version number.
+ if ($version) {
+ my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/;
+ if (defined $x and defined $y and defined $z) {
+ @{$self}{qw(version major minor patch)} =
+ ($version, $x, $y, $z);
+ } else {
+ $self->error("Failed to parse PostgreSQL version parts from " .
+ "string '$version'");
+ }
+ } else {
+ $self->error("Unable to parse version from string '$data'");
+ }
+};
+
+sub name {
+ my $self = shift;
+ return unless $self->{pg_config};
+
+ # Load data.
+ $get_version->($self) unless $self->{'--version'};
+
+ # Handle an unknown name.
+ $self->{name} ||= $self->unknown( key => 'name' );
+
+ # Return the name.
+ return $self->{name};
+}
+
+##############################################################################
+
+=head3 version
+
+ my $version = $pg->version;
+
+Returns the PostgreSQL version number. App::Info::RDBMS::PostgreSQL parses the
+version number from the system call C<`pg_config --version`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL version number
+
+=back
+
+=cut
+
+sub version {
+ my $self = shift;
+ return unless $self->{pg_config};
+
+ # Load data.
+ $get_version->($self) unless $self->{'--version'};
+
+ # Handle an unknown value.
+ unless ($self->{version}) {
+ # Create a validation code reference.
+ my $chk_version = sub {
+ # Try to get the version number parts.
+ my ($x, $y, $z) = /^(\d+)\.(\d+).(\d+)$/;
+ # Return false if we didn't get all three.
+ return unless $x and defined $y and defined $z;
+ # Save all three parts.
+ @{$self}{qw(major minor patch)} = ($x, $y, $z);
+ # Return true.
+ return 1;
+ };
+ $self->{version} = $self->unknown( key => 'version number',
+ callback => $chk_version);
+ }
+
+ return $self->{version};
+}
+
+##############################################################################
+
+=head3 major version
+
+ my $major_version = $pg->major_version;
+
+Returns the PostgreSQL major version number. App::Info::RDBMS::PostgreSQL
+parses the major version number from the system call C<`pg_config --version`>.
+For example, C<version()> returns "7.1.2", then this method returns "7".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL major version number
+
+=back
+
+=cut
+
+# This code reference is used by major_version(), minor_version(), and
+# patch_version() to validate a version number entered by a user.
+my $is_int = sub { /^\d+$/ };
+
+sub major_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{major} = $self->unknown( key => 'major version number',
+ callback => $is_int)
+ unless $self->{major};
+ return $self->{major};
+}
+
+##############################################################################
+
+=head3 minor version
+
+ my $minor_version = $pg->minor_version;
+
+Returns the PostgreSQL minor version number. App::Info::RDBMS::PostgreSQL
+parses the minor version number from the system call C<`pg_config --version`>.
+For example, if C<version()> returns "7.1.2", then this method returns "2".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL minor version number
+
+=back
+
+=cut
+
+sub minor_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{minor} = $self->unknown( key => 'minor version number',
+ callback => $is_int)
+ unless defined $self->{minor};
+ return $self->{minor};
+}
+
+##############################################################################
+
+=head3 patch version
+
+ my $patch_version = $pg->patch_version;
+
+Returns the PostgreSQL patch version number. App::Info::RDBMS::PostgreSQL
+parses the patch version number from the system call C<`pg_config --version`>.
+For example, if C<version()> returns "7.1.2", then this method returns "1".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL minor version number
+
+=back
+
+=cut
+
+sub patch_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{patch} = $self->unknown( key => 'patch version number',
+ callback => $is_int)
+ unless defined $self->{patch};
+ return $self->{patch};
+}
+
+##############################################################################
+
+=head3 bin_dir
+
+ my $bin_dir = $pg->bin_dir;
+
+Returns the PostgreSQL binary directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --bindir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --bindir`
+
+=item error
+
+Cannot find bin directory
+
+=item unknown
+
+Enter a valid PostgreSQL bin directory
+
+=back
+
+=cut
+
+# This code reference is used by bin_dir(), lib_dir(), and so_lib_dir() to
+# validate a directory entered by the user.
+my $is_dir = sub { -d };
+
+sub bin_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{bin_dir} ) {
+ if (my $dir = $get_data->($self, '--bindir')) {
+ $self->{bin_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find bin directory");
+ $self->{bin_dir} = $self->unknown( key => 'bin directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{bin_dir};
+}
+
+##############################################################################
+
+=head3 inc_dir
+
+ my $inc_dir = $pg->inc_dir;
+
+Returns the PostgreSQL include directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --includedir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --includedir`
+
+=item error
+
+Cannot find include directory
+
+=item unknown
+
+Enter a valid PostgreSQL include directory
+
+=back
+
+=cut
+
+sub inc_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{inc_dir} ) {
+ if (my $dir = $get_data->($self, '--includedir')) {
+ $self->{inc_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find include directory");
+ $self->{inc_dir} = $self->unknown( key => 'include directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{inc_dir};
+}
+
+##############################################################################
+
+=head3 lib_dir
+
+ my $lib_dir = $pg->lib_dir;
+
+Returns the PostgreSQL library directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --libdir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --libdir`
+
+=item error
+
+Cannot find library directory
+
+=item unknown
+
+Enter a valid PostgreSQL library directory
+
+=back
+
+=cut
+
+sub lib_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{lib_dir} ) {
+ if (my $dir = $get_data->($self, '--libdir')) {
+ $self->{lib_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find library directory");
+ $self->{lib_dir} = $self->unknown( key => 'library directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{lib_dir};
+}
+
+##############################################################################
+
+=head3 so_lib_dir
+
+ my $so_lib_dir = $pg->so_lib_dir;
+
+Returns the PostgreSQL shared object library directory path.
+App::Info::RDBMS::PostgreSQL gathers the path from the system call
+C<`pg_config --pkglibdir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --pkglibdir`
+
+=item error
+
+Cannot find shared object library directory
+
+=item unknown
+
+Enter a valid PostgreSQL shared object library directory
+
+=back
+
+=cut
+
+# Location of dynamically loadable modules.
+sub so_lib_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{so_lib_dir} ) {
+ if (my $dir = $get_data->($self, '--pkglibdir')) {
+ $self->{so_lib_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find shared object library directory");
+ $self->{so_lib_dir} =
+ $self->unknown( key => 'shared object library directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{so_lib_dir};
+}
+
+##############################################################################
+
+=head3 home_url
+
+ my $home_url = $pg->home_url;
+
+Returns the PostgreSQL home page URL.
+
+=cut
+
+sub home_url { "http://www.postgresql.org/" }
+
+##############################################################################
+
+=head3 download_url
+
+ my $download_url = $pg->download_url;
+
+Returns the PostgreSQL download URL.
+
+=cut
+
+sub download_url { "http://www.ca.postgresql.org/sitess.html" }
+
+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">> based on code by Sam
+Tregar <L<sam@tregar.com|"sam@tregar.com">>.
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event handling interface.
+
+L<App::Info::RDBMS|App::Info::RDBMS> is the App::Info::RDBMS::PostgreSQL
+parent class.
+
+L<DBD::Pg|DBD::Pg> is the L<DBI|DBI> driver for connecting to PostgreSQL
+databases.
+
+L<http://www.postgresql.org/> is the PostgreSQL home page.
+
+=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/Request.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm
new file mode 100644
index 000000000..c02c97ba2
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Request.pm
@@ -0,0 +1,287 @@
+package App::Info::Request;
+
+# $Id: Request.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+App::Info::Request - App::Info event handler request object
+
+=head1 SYNOPSIS
+
+ # In an App::Info::Handler subclass:
+ sub handler {
+ my ($self, $req) = @_;
+ print "Event Type: ", $req->type;
+ print "Message: ", $req->message;
+ print "Error: ", $req->error;
+ print "Value: ", $req->value;
+ }
+
+=head1 DESCRIPTION
+
+Objects of this class are passed to the C<handler()> method of App::Info event
+handlers. Generally, this class will be of most interest to App::Info::Handler
+subclass implementers.
+
+The L<event triggering methods|App::Info/"Events"> in App::Info each construct
+a new App::Info::Request object and initialize it with their arguments. The
+App::Info::Request object is then the sole argument passed to the C<handler()>
+method of any and all App::Info::Handler objects in the event handling chain.
+Thus, if you'd like to create your own App::Info event handler, this is the
+object you need to be familiar with. Consult the
+L<App::Info::Handler|App::Info::Handler> documentation for details on creating
+custom event handlers.
+
+Each of the App::Info event triggering methods constructs an
+App::Info::Request object with different attribute values. Be sure to consult
+the documentation for the L<event triggering methods|App::Info/"Events"> in
+App::Info, where the values assigned to the App::Info::Request object are
+documented. Then, in your event handler subclass, check the value returned by
+the C<type()> method to determine what type of event request you're handling
+to handle the request appropriately.
+
+=cut
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.23';
+
+##############################################################################
+
+=head1 INTERFACE
+
+The following sections document the App::Info::Request interface.
+
+=head2 Constructor
+
+=head3 new
+
+ my $req = App::Info::Request->new(%params);
+
+This method is used internally by App::Info to construct new
+App::Info::Request objects to pass to event handler objects. Generally, you
+won't need to use it, other than perhaps for testing custom App::Info::Handler
+classes.
+
+The parameters to C<new()> are passed as a hash of named parameters that
+correspond to their like-named methods. The supported parameters are:
+
+=over 4
+
+=item type
+
+=item message
+
+=item error
+
+=item value
+
+=item callback
+
+=back
+
+See the object methods documentation below for details on these object
+attributes.
+
+=cut
+
+sub new {
+ my $pkg = shift;
+
+ # Make sure we've got a hash of arguments.
+ Carp::croak("Odd number of parameters in call to " . __PACKAGE__ .
+ "->new() when named parameters expected" ) if @_ % 2;
+ my %params = @_;
+
+ # Validate the callback.
+ if ($params{callback}) {
+ Carp::croak("Callback parameter '$params{callback}' is not a code ",
+ "reference")
+ unless UNIVERSAL::isa($params{callback}, 'CODE');
+ } else {
+ # Otherwise just assign a default approve callback.
+ $params{callback} = sub { 1 };
+ }
+
+ # Validate type parameter.
+ if (my $t = $params{type}) {
+ Carp::croak("Invalid handler type '$t'")
+ unless $t eq 'error' or $t eq 'info' or $t eq 'unknown'
+ or $t eq 'confirm';
+ } else {
+ $params{type} = 'info';
+ }
+
+ # Return the request object.
+ bless \%params, ref $pkg || $pkg;
+}
+
+##############################################################################
+
+=head2 Object Methods
+
+=head3 message
+
+ my $message = $req->message;
+
+Returns the message stored in the App::Info::Request object. The message is
+typically informational, or an error message, or a prompt message.
+
+=cut
+
+sub message { $_[0]->{message} }
+
+##############################################################################
+
+=head3 error
+
+ my $error = $req->error;
+
+Returns any error message associated with the App::Info::Request object. The
+error message is typically there to display for users when C<callback()>
+returns false.
+
+=cut
+
+sub error { $_[0]->{error} }
+
+##############################################################################
+
+=head3 type
+
+ my $type = $req->type;
+
+Returns a string representing the type of event that triggered this request.
+The types are the same as the event triggering methods defined in App::Info.
+As of this writing, the supported types are:
+
+=over
+
+=item info
+
+=item error
+
+=item unknown
+
+=item confirm
+
+=back
+
+Be sure to consult the App::Info documentation for more details on the event
+types.
+
+=cut
+
+sub type { $_[0]->{type} }
+
+##############################################################################
+
+=head3 callback
+
+ if ($req->callback($value)) {
+ print "Value '$value' is valid.\n";
+ } else {
+ print "Value '$value' is not valid.\n";
+ }
+
+Executes the callback anonymous subroutine supplied by the App::Info concrete
+base class that triggered the event. If the callback returns false, then
+C<$value> is invalid. If the callback returns true, then C<$value> is valid
+and can be assigned via the C<value()> method.
+
+Note that the C<value()> method itself calls C<callback()> if it was passed a
+value to assign. See its documentation below for more information.
+
+=cut
+
+sub callback {
+ my $self = shift;
+ my $code = $self->{callback};
+ local $_ = $_[0];
+ $code->(@_);
+}
+
+##############################################################################
+
+=head3 value
+
+ my $value = $req->value;
+ if ($req->value($value)) {
+ print "Value '$value' successfully assigned.\n";
+ } else {
+ print "Value '$value' not successfully assigned.\n";
+ }
+
+When called without an argument, C<value()> simply returns the value currently
+stored by the App::Info::Request object. Typically, the value is the default
+value for a confirm event, or a value assigned to an unknown event.
+
+When passed an argument, C<value()> attempts to store the the argument as a
+new value. However, C<value()> calls C<callback()> on the new value, and if
+C<callback()> returns false, then C<value()> returns false and does not store
+the new value. If C<callback()> returns true, on the other hand, then
+C<value()> goes ahead and stores the new value and returns true.
+
+=cut
+
+sub value {
+ my $self = shift;
+ if ($#_ >= 0) {
+ # grab the value.
+ my $value = shift;
+ # Validate the value.
+ if ($self->callback($value)) {
+ # The value is good. Assign it and return true.
+ $self->{value} = $value;
+ return 1;
+ } else {
+ # Invalid value. Return false.
+ return;
+ }
+ }
+ # Just return the value.
+ return $self->{value};
+}
+
+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 triggering methods and how they
+construct App::Info::Request objects to pass to event handlers.
+
+L<App::Info::Handler:|App::Info::Handler> documents how to create custom event
+handlers, which must make use of the App::Info::Request object passed to their
+C<handler()> object methods.
+
+The following classes subclass App::Info::Handler, and thus offer good
+exemplars for using App::Info::Request objects when handling events.
+
+=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/Util.pm b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm
new file mode 100644
index 000000000..55bb333cd
--- /dev/null
+++ b/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/Util.pm
@@ -0,0 +1,456 @@
+package App::Info::Util;
+
+# $Id: Util.pm,v 1.1 2004-04-29 09:21:28 ivan Exp $
+
+=head1 NAME
+
+App::Info::Util - Utility class for App::Info subclasses
+
+=head1 SYNOPSIS
+
+ use App::Info::Util;
+
+ my $util = App::Info::Util->new;
+
+ # Subclasses File::Spec.
+ my @paths = $util->paths;
+
+ # First directory that exists in a list.
+ my $dir = $util->first_dir(@paths);
+
+ # First directory that exists in a path.
+ $dir = $util->first_path($ENV{PATH});
+
+ # First file that exists in a list.
+ my $file = $util->first_file('this.txt', '/that.txt', 'C:\\foo.txt');
+
+ # First file found among file base names and directories.
+ my $files = ['this.txt', 'that.txt'];
+ $file = $util->first_cat_file($files, @paths);
+
+=head1 DESCRIPTION
+
+This class subclasses L<File::Spec|File::Spec> and adds its own methods in
+order to offer utility methods to L<App::Info|App::Info> classes. Although
+intended to be used by App::Info subclasses, in truth App::Info::Util's
+utility may be considered more general, so feel free to use it elsewhere.
+
+The methods added in addition to the usual File::Spec suspects are designed to
+facilitate locating files and directories on the file system, as well as
+searching those files. The assumption is that, in order to provide useful
+metadata about a given software package, an App::Info subclass must find
+relevant files and directories and parse them with regular expressions. This
+class offers methods that simplify those tasks.
+
+=cut
+
+use strict;
+use File::Spec ();
+use vars qw(@ISA $VERSION);
+@ISA = qw(File::Spec);
+$VERSION = '0.22';
+
+my %path_dems = (MacOS => qr',',
+ MSWin32 => qr';',
+ os2 => qr';',
+ VMS => undef,
+ epoc => undef);
+
+my $path_dem = exists $path_dems{$^O} ? $path_dems{$^O} : qr':';
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+ my $util = App::Info::Util->new;
+
+This is a very simple constructor that merely returns an App::Info::Util
+object. Since, like its File::Spec super class, App::Info::Util manages no
+internal data itself, all methods may be used as class methods, if one prefers
+to. The constructor here is provided merely as a convenience.
+
+=cut
+
+sub new { bless {}, ref $_[0] || $_[0] }
+
+=head1 OBJECT METHODS
+
+In addition to all of the methods offered by its super class,
+L<File::Spec|File::Spec>, App::Info::Util offers the following methods.
+
+=head2 first_dir
+
+ my @paths = $util->paths;
+ my $dir = $util->first_dir(@dirs);
+
+Returns the first file system directory in @paths that exists on the local
+file system. Only the first item in @paths that exists as a directory will be
+returned; any other paths leading to non-directories will be ignored.
+
+=cut
+
+sub first_dir {
+ shift;
+ foreach (@_) { return $_ if -d }
+ return;
+}
+
+=head2 first_path
+
+ my $path = $ENV{PATH};
+ $dir = $util->first_path($path);
+
+Takes the $path string and splits it into a list of directory paths, based on
+the path demarcator on the local file system. Then calls C<first_dir()> to
+return the first directoy in the path list that exists on the local file
+system. The path demarcator is specified for the following file systems:
+
+=over 4
+
+=item MacOS: ","
+
+=item MSWin32: ";"
+
+=item os2: ";"
+
+=item VMS: undef
+
+This method always returns undef on VMS. Patches welcome.
+
+=item epoc: undef
+
+This method always returns undef on epoch. Patches welcome.
+
+=item Unix: ":"
+
+All other operating systems are assumed to be Unix-based.
+
+=back
+
+=cut
+
+sub first_path {
+ return unless $path_dem;
+ shift->first_dir(split /$path_dem/, shift)
+}
+
+=head2 first_file
+
+ my $file = $util->first_file(@filelist);
+
+Examines each of the files in @filelist and returns the first one that exists
+on the file system. The file must be a regular file -- directories will be
+ignored.
+
+=cut
+
+sub first_file {
+ shift;
+ foreach (@_) { return $_ if -f }
+ return;
+}
+
+=head2 first_exe
+
+ my $exe = $util->first_exe(@exelist);
+
+Examines each of the files in @exelist and returns the first one that exists
+on the file system as an executable file. Directories will be ignored.
+
+=cut
+
+sub first_exe {
+ shift;
+ foreach (@_) { return $_ if -f && -x }
+ return;
+}
+
+=head2 first_cat_path
+
+ my $file = $util->first_cat_path('ick.txt', @paths);
+ $file = $util->first_cat_path(['this.txt', 'that.txt'], @paths);
+
+The first argument to this method may be either a file or directory base name
+(that is, a file or directory name without a full path specification), or a
+reference to an array of file or directory base names. The remaining arguments
+constitute a list of directory paths. C<first_cat_path()> processes each of
+these directory paths, concatenates (by the method native to the local
+operating system) each of the file or directory base names, and returns the
+first one that exists on the file system.
+
+For example, let us say that we were looking for a file called either F<httpd>
+or F<apache>, and it could be in any of the following paths:
+F</usr/local/bin>, F</usr/bin/>, F</bin>. The method call looks like this:
+
+ my $httpd = $util->first_cat_path(['httpd', 'apache'], '/usr/local/bin',
+ '/usr/bin/', '/bin');
+
+If the OS is a Unix variant, C<first_cat_path()> will then look for the first
+file that exists in this order:
+
+=over 4
+
+=item /usr/local/bin/httpd
+
+=item /usr/local/bin/apache
+
+=item /usr/bin/httpd
+
+=item /usr/bin/apache
+
+=item /bin/httpd
+
+=item /bin/apache
+
+=back
+
+The first of these complete paths to be found will be returned. If none are
+found, then undef will be returned.
+
+=cut
+
+sub first_cat_path {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_dir
+
+ my $dir = $util->first_cat_dir('ick.txt', @paths);
+ $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the
+directory path in which the first file was found, rather than the full
+concatenated path. Thus, in the above example, if the file found was
+F</usr/bin/httpd>, while C<first_cat_path()> would return that value,
+C<first_cat_dir()> would return F</usr/bin> instead.
+
+=cut
+
+sub first_cat_dir {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $p if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_exe
+
+ my $exe = $util->first_cat_exe('ick.txt', @paths);
+ $exe = $util->first_cat_exe(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the full
+path to the first executable file found, rather than simply the first file
+found.
+
+=cut
+
+sub first_cat_exe {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -f $path && -x $path;
+ }
+ }
+ return;
+}
+
+=head2 search_file
+
+ my $file = 'foo.txt';
+ my $regex = qr/(text\s+to\s+find)/;
+ my $value = $util->search_file($file, $regex);
+
+Opens C<$file> and executes the C<$regex> regular expression against each line
+in the file. Once the line matches and one or more values is returned by the
+match, the file is closed and the value or values returned.
+
+For example, say F<foo.txt> contains the line "Version 6.5, patch level 8",
+and you need to grab each of the three version parts. All three parts can
+be grabbed like this:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my @nums = $util->search_file($file, $regex);
+
+Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar
+context, the above search would yeild an array reference:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my $nums = $util->search_file($file, $regex);
+
+So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the
+match returns only one value, however. Say F<foo.txt> contains the line
+"king of the who?", and you wish to know who the king is king of. Either
+of the following two calls would get you the data you need:
+
+ my $minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+ my @minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+
+In the first case, because the regular expression contains only one set of
+parentheses, C<search_file()> will simply return that value: C<$minions>
+contains the string "the who?". In the latter case, C<@minions> of course
+contains a single element: C<("the who?")>.
+
+Note that a regular expression without parentheses -- that is, one that
+doesn't grab values and put them into $1, $2, etc., will never successfully
+match a line in this method. You must include something to parentetically
+match. If you just want to know the value of what was matched, parenthesize
+the whole thing and if the value returns, you have a match. Also, if you need
+to match patterns across lines, try using multiple regular expressions with
+C<multi_search_file()>, instead.
+
+=cut
+
+sub search_file {
+ my ($self, $file, $regex) = @_;
+ return unless $file && $regex;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my @ret;
+ while (<F>) {
+ # If we find a match, we're done.
+ (@ret) = /$regex/ and last;
+ }
+ close F;
+ # If the match returned an more than one value, always return the full
+ # array. Otherwise, return just the first value in a scalar context.
+ return unless @ret;
+ return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret;
+}
+
+=head2 multi_search_file
+
+ my @regexen = (qr/(one)/, qr/(two)\s+(three)/);
+ my @matches = $util->multi_search_file($file, @regexen);
+
+Like C<search_file()>, this mehod opens C<$file> and parses it for regular
+expresion matches. This method, however, can take a list of regular
+expressions to look for, and will return the values found for all of them.
+Regular expressions that match and return multiple values will be returned as
+array referernces, while those that match and return a single value will
+return just that single value.
+
+For example, say you are parsing a file with lines like the following:
+
+ #define XML_MAJOR_VERSION 1
+ #define XML_MINOR_VERSION 95
+ #define XML_MICRO_VERSION 2
+
+You need to get each of these numbers, but calling C<search_file()> for each
+of them would be wasteful, as each call to C<search_file()> opens the file and
+parses it. With C<multi_search_file()>, on the other hand, the file will be
+opened only once, and, once all of the regular expressions have returned
+matches, the file will be closed and the matches returned.
+
+Thus the above values can be collected like this:
+
+ my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/,
+ qr/XML_MINOR_VERSION\s+(\d+)$/,
+ qr/XML_MICRO_VERSION\s+(\d+)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+The result will be that C<@nums> contains C<(1, 95, 2)>. Note that
+C<multi_file_search()> tries to do the right thing by only parsing the file
+until all of the regular expressions have been matched. Thus, a large file
+with the values you need near the top can be parsed very quickly.
+
+As with C<search_file()>, C<multi_search_file()> can take regular expressions
+that match multiple values. These will be returned as array references. For
+example, say the file you're parsing has files like this:
+
+ FooApp Version 4
+ Subversion 2, Microversion 6
+
+To get all of the version numbers, you can either use three regular
+expressions, as in the previous example:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),/,
+ qr/Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, 2, 6)>. Or, you can use just two
+regular expressions:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),\s+Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, [2, 6])>. Note that the two
+parentheses that return values in the second regular expression cause the
+matches to be returned as an array reference.
+
+=cut
+
+sub multi_search_file {
+ my ($self, $file, @regexen) = @_;
+ return unless $file && @regexen;
+ my @each = @regexen;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my %ret;
+ while (my $line = <F>) {
+ my @splice;
+ # Process each of the regular expresssions.
+ for (my $i = 0; $i < @each; $i++) {
+ if ((my @ret) = $line =~ /$each[$i]/) {
+ # We have a match! If there's one match returned, just grab
+ # it. If there's more than one, keep it as an array ref.
+ $ret{$each[$i]} = $#ret > 0 ? \@ret : $ret[0];
+ # We got values for this regex, so not its place in the @each
+ # array.
+ push @splice, $i;
+ }
+ }
+ # Remove any regexen that have already found a match.
+ for (@splice) { splice @each, $_, 1 }
+ # If there are no more regexes, we're done -- no need to keep
+ # processing lines in the file!
+ last unless @each;
+ }
+ close F;
+ return unless %ret;
+ return wantarray ? @ret{@regexen} : \@ret{@regexen};
+}
+
+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>, L<File::Spec|File::Spec>,
+L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache>
+L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=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/DBIx-DBSchema-0.23-5.005kludge/Changes b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes
new file mode 100644
index 000000000..f413bd959
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes
@@ -0,0 +1,62 @@
+Revision history for Perl extension DBIx::DBSchema.
+
+0.23 Mon Feb 16 17:35:54 PST 2004
+ - Update Pg dependancy to 1.32
+ - Update the simple load test so it skips DBIx::DBSchema::DBD::Pg if
+ DBD::Pg 1.32 is not installed.
+
+0.22 Thu Oct 23 15:18:21 PDT 2003
+ - Pg reverse-engineering fix: varchar with no limit
+ - Pg needs (unreleased) DBD::Pg 1.30 (or deb 1.22-2... interesting)
+
+0.21 Thu Sep 19 05:04:18 PDT 2002
+ - Pg reverse-engineering fix: now sets default
+
+0.20 Mon Mar 4 04:58:34 2002
+ - documentation updates
+ - fix Column->new when using named params
+ - fix Pg driver reverse-engineering length of numeric columns:
+ translate 655362 to 10,2, etc.
+ - fix Pg driver reverse-engineering of text columns (don't have a
+ length)
+
+0.19 Tue Oct 23 08:49:12 2001
+ - documentation for %typemap
+ - preliminary Sybase driver from Charles Shapiro
+ <charles.shapiro@numethods.com> and Mitchell J. Friedman
+ <mitchell.friedman@numethods.com>.
+ - Fix Column::line to return a scalar as documented, not a list.
+ - Should finally eliminate the Use of uninitialized value at
+ ... DBIx/DBSchema/Column.pm line 251
+
+0.18 Fri Aug 10 17:07:28 2001
+ - Added Table::delcolumn
+ - patch from Charles Shapiro <cshapiro@numethods.com> to add
+ `ORDER BY a.attnum' to the SQL in DBIx::DBSchema::DBD::Pg::columns
+
+0.17 Sat Jul 7 17:55:33 2001
+ - Rework Table->new interface for named params
+ - Fixes for Pg blobs, yay!
+ - MySQL doesn't need non-standard index syntax anymore (since 3.22).
+ - patch from Mark Ethan Trostler <mark@zzo.com> for generating
+ tables without indices.
+
+0.16 Fri Jan 5 15:55:50 2001
+ - Don't overflow index names.
+
+0.15 Fri Nov 24 23:39:16 2000
+ - MySQL handling of BOOL type (change to TINYINT)
+
+0.14 Tue Oct 24 14:43:16 2000
+ - MySQL handling of SERIAL type (change to INTEGER AUTO_INCREMENT)
+
+0.13 Wed Oct 11 10:47:13 2000
+ - fixed up type mapping foo, added default values, added named
+ parameters to Column->new, fixed quoting of default values
+
+0.11 Sun Sep 28 02:16:25 2000
+ - oops, original verison got 0.10, so this one will get 0.11
+
+0.01 Sun Sep 17 07:57:35 2000
+ - original version; created by h2xs 1.19
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm
new file mode 100644
index 000000000..fc4916df1
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm
@@ -0,0 +1,367 @@
+package DBIx::DBSchema;
+
+use strict;
+use vars qw(@ISA $VERSION);
+#use Exporter;
+use Carp qw(confess);
+use DBI;
+use FreezeThaw qw(freeze thaw cmpStr);
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+
+#@ISA = qw(Exporter);
+@ISA = ();
+
+$VERSION = "0.23";
+
+=head1 NAME
+
+DBIx::DBSchema - Database-independent schema objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema;
+
+ $schema = new DBIx::DBSchema @dbix_dbschema_table_objects;
+ $schema = new_odbc DBIx::DBSchema $dbh;
+ $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass;
+ $schema = new_native DBIx::DBSchema $dbh;
+ $schema = new_native DBIx::DBSchema $dsn, $user, $pass;
+
+ $schema->save("filename");
+ $schema = load DBIx::DBSchema "filename";
+
+ $schema->addtable($dbix_dbschema_table_object);
+
+ @table_names = $schema->tables;
+
+ $DBIx_DBSchema_table_object = $schema->table("table_name");
+
+ @sql = $schema->sql($dbh);
+ @sql = $schema->sql($dsn, $username, $password);
+ @sql = $schema->sql($dsn); #doesn't connect to database - less reliable
+
+ $perl_code = $schema->pretty_print;
+ %hash = eval $perl_code;
+ use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and
+represent a database schema.
+
+This module implements an OO-interface to database schemas. Using this module,
+you can create a database schema with an OO Perl interface. You can read the
+schema from an existing database. You can save the schema to disk and restore
+it a different process. Most importantly, DBIx::DBSchema can write SQL
+CREATE statements statements for different databases from a single source.
+
+Currently supported databases are MySQL and PostgreSQL. Sybase support is
+partially implemented. DBIx::DBSchema will attempt to use generic SQL syntax
+for other databases. Assistance adding support for other databases is
+welcomed. See L<DBIx::DBSchema::DBD>, "Driver Writer's Guide and Base Class".
+
+=head1 METHODS
+
+=over 4
+
+=item new TABLE_OBJECT, TABLE_OBJECT, ...
+
+Creates a new DBIx::DBSchema object.
+
+=cut
+
+sub new {
+ my($proto, @tables) = @_;
+ my %tables = map { $_->name, $_ } @tables; #check for duplicates?
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'tables' => \%tables,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
+
+Creates a new DBIx::DBSchema object from an existing data source, which can be
+specified by passing an open DBI database handle, or by passing the DBI data
+source name, username, and password. This uses the experimental DBI type_info
+method to create a schema with standard (ODBC) SQL column types that most
+closely correspond to any non-portable column types. Use this to import a
+schema that you wish to use with many different database engines. Although
+primary key and (unique) index information will only be read from databases
+with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
+column names and attributes *should* work for any database. Note that this
+method only uses "ODBC" column types; it does not require or use an ODBC
+driver.
+
+=cut
+
+sub new_odbc {
+ my($proto, $dbh) = (shift, shift);
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+ $proto->new(
+ map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh)
+ );
+}
+
+=item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
+
+Creates a new DBIx::DBSchema object from an existing data source, which can be
+specified by passing an open DBI database handle, or by passing the DBI data
+source name, username and password. This uses database-native methods to read
+the schema, and will preserve any non-portable column types. The method is
+only available if there is a DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and PostgreSQL).
+
+=cut
+
+sub new_native {
+ my($proto, $dbh) = (shift, shift);
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+ $proto->new(
+ map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh)
+ );
+}
+
+=item load FILENAME
+
+Loads a DBIx::DBSchema object from a file.
+
+=cut
+
+sub load {
+ my($proto,$file)=@_; #use $proto ?
+ open(FILE,"<$file") or die "Can't open $file: $!";
+ my($string)=join('',<FILE>); #can $string have newlines? pry not?
+ close FILE or die "Can't close $file: $!";
+ my($self)=thaw $string;
+ #no bless needed?
+ $self;
+}
+
+=item save FILENAME
+
+Saves a DBIx::DBSchema object to a file.
+
+=cut
+
+sub save {
+ my($self,$file)=@_;
+ my($string)=freeze $self;
+ open(FILE,">$file") or die "Can't open $file: $!";
+ print FILE $string;
+ close FILE or die "Can't close file: $!";
+ my($check_self)=thaw $string;
+ die "Verify error: Can't freeze and thaw dbdef $self"
+ if (cmpStr($self,$check_self));
+}
+
+=item addtable TABLE_OBJECT
+
+Adds the given DBIx::DBSchema::Table object to this DBIx::DBSchema.
+
+=cut
+
+sub addtable {
+ my($self,$table)=@_;
+ $self->{'tables'}->{$table->name} = $table; #check for dupliates?
+}
+
+=item tables
+
+Returns a list of the names of all tables.
+
+=cut
+
+sub tables {
+ my($self)=@_;
+ keys %{$self->{'tables'}};
+}
+
+=item table TABLENAME
+
+Returns the specified DBIx::DBSchema::Table object.
+
+=cut
+
+sub table {
+ my($self,$table)=@_;
+ $self->{'tables'}->{$table};
+}
+
+=item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL `CREATE' statements for this schema.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL.
+
+If not passed a data source (or handle), or if there is no driver for the
+specified database, will attempt to use generic SQL syntax.
+
+=cut
+
+sub sql {
+ my($self, $dbh) = (shift, shift);
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ $created_dbh = 1;
+ }
+ my @r = map { $self->table($_)->sql_create_table($dbh); } $self->tables;
+ $dbh->disconnect if $created_dbh;
+ @r;
+}
+
+=item pretty_print
+
+Returns the data in this schema as Perl source, suitable for assigning to a
+hash.
+
+=cut
+
+sub pretty_print {
+ my($self) = @_;
+ join("},\n\n",
+ map {
+ my $table = $_;
+ "'$table' => {\n".
+ " 'columns' => [\n".
+ join("", map {
+ #cant because -w complains about , in qw()
+ # (also biiiig problems with empty lengths)
+ #" qw( $_ ".
+ #$self->table($table)->column($_)->type. " ".
+ #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ".
+ #$self->table($table)->column($_)->length. " ),\n"
+ " '$_', ".
+ "'". $self->table($table)->column($_)->type. "', ".
+ "'". $self->table($table)->column($_)->null. "', ".
+ "'". $self->table($table)->column($_)->length. "', ".
+ "'". $self->table($table)->column($_)->default. "', ".
+ "'". $self->table($table)->column($_)->local. "',\n"
+ } $self->table($table)->columns
+ ).
+ " ],\n".
+ " 'primary_key' => '". $self->table($table)->primary_key. "',\n".
+ " 'unique' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$self->table($table)->unique->lol_ref}
+ ). " ],\n".
+ " 'index' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$self->table($table)->index->lol_ref}
+ ). " ],\n"
+ #" 'index' => [ ". " ],\n"
+ } $self->tables
+ ), "}\n";
+}
+
+=cut
+
+=item pretty_read HASHREF
+
+Creates a schema as specified by a data structure such as that created by
+B<pretty_print> method.
+
+=cut
+
+sub pretty_read {
+ my($proto, $href) = @_;
+ my $schema = $proto->new( map {
+ my(@columns);
+ while ( @{$href->{$_}{'columns'}} ) {
+ push @columns, DBIx::DBSchema::Column->new(
+ splice @{$href->{$_}{'columns'}}, 0, 6
+ );
+ }
+ DBIx::DBSchema::Table->new(
+ $_,
+ $href->{$_}{'primary_key'},
+ DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}),
+ DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}),
+ @columns,
+ );
+ } (keys %{$href}) );
+}
+
+# private subroutines
+
+sub _load_driver {
+ my($dbh) = @_;
+ my $driver;
+ if ( ref($dbh) ) {
+ $driver = $dbh->{Driver}->{Name};
+ } else {
+ $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
+ or '' =~ /()/; # ensure $1 etc are empty if match fails
+ $driver = $1 or confess "can't parse data source: $dbh";
+ }
+
+ #require "DBIx/DBSchema/DBD/$driver.pm";
+ #$driver;
+ eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@;
+}
+
+sub _tables_from_dbh {
+ my($dbh) = @_;
+ my $sth = $dbh->table_info or die $dbh->errstr;
+ #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
+ # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
+ map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
+ @{ $sth->fetchall_arrayref([2,3]) };
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman
+<mitchell.friedman@numethods.com> contributed the start of a Sybase driver.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+Each DBIx::DBSchema object should have a name which corresponds to its name
+within the SQL database engine (DBI data source).
+
+pretty_print is actually pretty ugly.
+
+Perhaps pretty_read should eval column types so that we can use DBI
+qw(:sql_types) here instead of externally.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,
+L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
+L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
+L<DBI>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm
new file mode 100644
index 000000000..ceeb223ca
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm
@@ -0,0 +1,141 @@
+package DBIx::DBSchema::ColGroup;
+
+use strict;
+use vars qw(@ISA);
+#use Exporter;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+=head1 NAME
+
+DBIx::DBSchema::ColGroup - Column group objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::ColGroup;
+
+ $colgroup = new DBIx::DBSchema::ColGroup ( $lol_ref );
+ $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );
+ $colgroup = new DBIx::DBSchema::ColGroup (
+ [
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ ]
+ );
+
+ $lol_ref = $colgroup->lol_ref;
+
+ @sql_lists = $colgroup->sql_list;
+
+ @singles = $colgroup->singles;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::ColGroup objects represent sets of sets of columns. (IOW a
+"list of lists" - see L<perllol>.)
+
+=head1 METHODS
+
+=over 4
+
+=item new [ LOL_REF ]
+
+Creates a new DBIx::DBSchema::ColGroup object. Pass a reference to a list of
+lists of column names.
+
+=cut
+
+sub new {
+ my($proto, $lol) = @_;
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'lol' => $lol,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item lol_ref
+
+Returns a reference to a list of lists of column names.
+
+=cut
+
+sub lol_ref {
+ my($self) = @_;
+ $self->{'lol'};
+}
+
+=item sql_list
+
+Returns a flat list of comma-separated values, for SQL statements.
+
+For example:
+
+ @lol = (
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ );
+
+ $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );
+
+ print join("\n", $colgroup->sql_list), "\n";
+
+Will print:
+
+ single_column
+ multiple_columns, another_column
+
+=cut
+
+sub sql_list { #returns a flat list of comman-separates lists (for sql)
+ my($self)=@_;
+ grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
+}
+
+=item singles
+
+Returns a flat list of all single item lists.
+
+=cut
+
+sub singles { #returns single-field groups as a flat list
+ my($self)=@_;
+ #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+ map {
+ ${$_}[0] =~ /^(\w+)$/
+ #aah!
+ or die "Illegal column ", ${$_}[0], " in colgroup!";
+ $1;
+ } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema>, L<perllol>, L<perldsc>,
+L<DBI>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm
new file mode 100644
index 000000000..1a92baae1
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm
@@ -0,0 +1,37 @@
+package DBIx::DBSchema::ColGroup::Index;
+
+use strict;
+use vars qw(@ISA);
+use DBIx::DBSchema::ColGroup;
+
+@ISA=qw(DBIx::DBSchema::ColGroup);
+
+=head1 NAME
+
+DBIx::DBSchema::ColGroup::Index - Index column group object
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::ColGroup::Index;
+
+ # see DBIx::DBSchema::ColGroup methods
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::ColGroup::Index objects represent the (non-unique) indices of a
+database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup::Index
+inherits from DBIx::DBSchema::ColGroup.
+
+=head1 BUGS
+
+Is this empty subclass needed?
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<FS::Record>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm
new file mode 100644
index 000000000..450043fdf
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm
@@ -0,0 +1,38 @@
+package DBIx::DBSchema::ColGroup::Unique;
+
+use strict;
+use vars qw(@ISA);
+use DBIx::DBSchema::ColGroup;
+
+@ISA=qw(DBIx::DBSchema::ColGroup);
+
+=head1 NAME
+
+DBIx::DBSchema::ColGroup::Unique - Unique column group object
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::ColGroup::Unique;
+
+ # see DBIx::DBSchema::ColGroup methods
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::ColGroup::Unique objects represent the unique indices of a
+database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup:Unique
+inherits from DBIx::DBSchema::ColGroup.
+
+=head1 BUGS
+
+Is this empty subclass needed?
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<FS::Record>
+
+=cut
+
+1;
+
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm
new file mode 100644
index 000000000..4e26646e7
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm
@@ -0,0 +1,300 @@
+package DBIx::DBSchema::Column;
+
+use strict;
+use vars qw(@ISA $VERSION);
+#use Carp;
+#use Exporter;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+$VERSION = '0.02';
+
+=head1 NAME
+
+DBIx::DBSchema::Column - Column objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::Column;
+
+ #named params with a hashref (preferred)
+ $column = new DBIx::DBSchema::Column ( {
+ 'name' => 'column_name',
+ 'type' => 'varchar'
+ 'null' => 'NOT NULL',
+ 'length' => 64,
+ 'default' => '
+ 'local' => '',
+ } );
+
+ #list
+ $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
+
+ $name = $column->name;
+ $column->name( 'name' );
+
+ $sql_type = $column->type;
+ $column->type( 'sql_type' );
+
+ $null = $column->null;
+ $column->null( 'NULL' );
+ $column->null( 'NOT NULL' );
+ $column->null( '' );
+
+ $length = $column->length;
+ $column->length( '10' );
+ $column->length( '8,2' );
+
+ $default = $column->default;
+ $column->default( 'Roo' );
+
+ $sql_line = $column->line;
+ $sql_line = $column->line($datasrc);
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::Column objects represent columns in tables (see
+L<DBIx::DBSchema::Table>).
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+=item new [ name [ , type [ , null [ , length [ , default [ , local ] ] ] ] ] ]
+
+Creates a new DBIx::DBSchema::Column object. Takes a hashref of named
+parameters, or a list. B<name> is the name of the column. B<type> is the SQL
+data type. B<null> is the nullability of the column (intrepreted using Perl's
+rules for truth, with one exception: `NOT NULL' is false). B<length> is the
+SQL length of the column. B<default> is the default value of the column.
+B<local> is reserved for database-specific information.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self;
+ if ( ref($_[0]) ) {
+ $self = shift;
+ } else {
+ $self = { map { $_ => shift } qw(name type null length default local) };
+ }
+
+ #croak "Illegal name: ". $self->{'name'}
+ # if grep $self->{'name'} eq $_, @reserved_words;
+
+ $self->{'null'} =~ s/^NOT NULL$//i;
+ $self->{'null'} = 'NULL' if $self->{'null'};
+
+ bless ($self, $class);
+
+}
+
+=item name [ NAME ]
+
+Returns or sets the column name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+ $self->{'name'} = $value;
+ } else {
+ $self->{'name'};
+ }
+}
+
+=item type [ TYPE ]
+
+Returns or sets the column type.
+
+=cut
+
+sub type {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'type'} = $value;
+ } else {
+ $self->{'type'};
+ }
+}
+
+=item null [ NULL ]
+
+Returns or sets the column null flag (the empty string is equivalent to
+`NOT NULL')
+
+=cut
+
+sub null {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $value =~ s/^NOT NULL$//i;
+ $value = 'NULL' if $value;
+ $self->{'null'} = $value;
+ } else {
+ $self->{'null'};
+ }
+}
+
+=item length [ LENGTH ]
+
+Returns or sets the column length.
+
+=cut
+
+sub length {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'length'} = $value;
+ } else {
+ $self->{'length'};
+ }
+}
+
+=item default [ LOCAL ]
+
+Returns or sets the default value.
+
+=cut
+
+sub default {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'default'} = $value;
+ } else {
+ $self->{'default'};
+ }
+}
+
+
+=item local [ LOCAL ]
+
+Returns or sets the database-specific field.
+
+=cut
+
+sub local {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'local'} = $value;
+ } else {
+ $self->{'local'};
+ }
+}
+
+=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns an SQL column definition.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL. Non-standard syntax
+for other engines (if applicable) may also be supported in the future.
+
+=cut
+
+sub line {
+ my($self,$dbh) = (shift, shift);
+
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
+ $created_dbh = 1;
+ }
+
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my %typemap;
+ %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
+ my $type = defined( $typemap{uc($self->type)} )
+ ? $typemap{uc($self->type)}
+ : $self->type;
+
+ my $null = $self->null;
+
+ my $default;
+ if ( defined($self->default) && $self->default ne ''
+ && ref($dbh)
+ # false laziness: nicked from FS::Record::_quote
+ && ( $self->default !~ /^\-?\d+(\.\d+)?$/
+ || $type =~ /(char|binary|blob|text)$/i
+ )
+ ) {
+ $default = $dbh->quote($self->default);
+ } else {
+ $default = $self->default;
+ }
+
+ #this should be a callback into the driver
+ if ( $driver eq 'mysql' ) { #yucky mysql hack
+ $null ||= "NOT NULL";
+ $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
+ } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
+ $null ||= "NOT NULL";
+ $null =~ s/^NULL$//;
+ }
+
+ my $r = join(' ',
+ $self->name,
+ $type. ( ( defined($self->length) && $self->length )
+ ? '('.$self->length.')'
+ : ''
+ ),
+ $null,
+ ( ( defined($default) && $default ne '' )
+ ? 'DEFAULT '. $default
+ : ''
+ ),
+ ( ( $driver eq 'mysql' && defined($self->local) )
+ ? $self->local
+ : ''
+ ),
+ );
+ $dbh->disconnect if $created_dbh;
+ $r;
+
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+line() has database-specific foo that probably ought to be abstracted into
+the DBIx::DBSchema:DBD:: modules.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm
new file mode 100644
index 000000000..a4c60003e
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm
@@ -0,0 +1,113 @@
+package DBIx::DBSchema::DBD;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.02';
+
+=head1 NAME
+
+DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide and Base Class
+
+=head1 SYNOPSIS
+
+ perldoc DBIx::DBSchema::DBD
+
+ package DBIx::DBSchema::DBD::FooBase
+ use DBIx::DBSchmea::DBD;
+ @ISA = qw(DBIx::DBSchema::DBD);
+
+=head1 DESCRIPTION
+
+Drivers should be named DBIx::DBSchema::DBD::DatabaseName, where DatabaseName
+is the same as the DBD:: driver for this database. Drivers should implement the
+following class methods:
+
+=over 4
+
+=item columns CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a listref of listrefs (see
+L<perllol>), each containing six elements: column name, column type,
+nullability, column length, column default, and a field reserved for
+driver-specific use.
+
+=item column CLASS DBI_DBH TABLE COLUMN
+
+Same as B<columns> above, except return the listref for a single column. You
+can inherit from DBIx::DBSchema::DBD to provide this function.
+
+=cut
+
+sub column {
+ my($proto, $dbh, $table, $column) = @_;
+ #@a = grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) };
+ #$a[0];
+ @{ [
+ grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) }
+ ] }[0]; #force list context on grep, return scalar of first element
+}
+
+=item primary_key CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return the primary key for the specified
+table.
+
+=item unique CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of unique indices. The
+keys of the hashref are index names, and the values are arrayrefs which point
+a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=item index CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of (non-unique) indices.
+The keys of the hashref are index names, and the values are arrayrefs which
+point a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=back
+
+=head1 TYPE MAPPING
+
+You can define a %typemap array for your driver to map "standard" data
+types to database-specific types. For example, the MySQL TIMESTAMP field
+has non-standard auto-updating semantics; the MySQL DATETIME type is
+what other databases and the ODBC standard call TIMESTAMP, so one of the
+entries in the MySQL %typemap is:
+
+ 'TIMESTAMP' => 'DATETIME',
+
+Another example is the Pg %typemap which maps the standard types BLOB and
+LONG VARBINARY to the Pg-specific BYTEA:
+
+ 'BLOB' => 'BYTEA',
+ 'LONG VARBINARY' => 'BYTEA',
+
+Make sure you use all uppercase-keys.
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>,
+L<DBIx::DBSchema::ColGroup>, L<DBI>, L<DBI::DBD>, L<perllol>,
+L<perldsc/"HASHES OF LISTS">
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm
new file mode 100644
index 000000000..018b89028
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm
@@ -0,0 +1,175 @@
+package DBIx::DBSchema::DBD::Pg;
+
+use strict;
+use vars qw($VERSION @ISA %typemap);
+use DBD::Pg 1.22;
+use DBIx::DBSchema::DBD;
+
+$VERSION = '0.08';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+ 'BLOB' => 'BYTEA',
+ 'LONG VARBINARY' => 'BYTEA',
+);
+
+=head1 NAME
+
+DBIx::DBSchema::DBD::Pg - PostgreSQL native driver for DBIx::DBSchema
+
+=head1 SYNOPSIS
+
+use DBI;
+use DBIx::DBSchema;
+
+$dbh = DBI->connect('dbi:Pg:dbname=database', 'user', 'pass');
+$schema = new_native DBIx::DBSchema $dbh;
+
+=head1 DESCRIPTION
+
+This module implements a PostgreSQL-native driver for DBIx::DBSchema.
+
+=cut
+
+sub columns {
+ my($proto, $dbh, $table) = @_;
+ my $sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull,
+ a.atthasdef, a.attnum
+ FROM pg_class c, pg_attribute a, pg_type t
+ WHERE c.relname = '$table'
+ AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid
+ ORDER BY a.attnum
+END
+ $sth->execute or die $sth->errstr;
+
+ map {
+
+ my $default = '';
+ if ( $_->{atthasdef} ) {
+ my $attnum = $_->{attnum};
+ my $d_sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT substring(d.adsrc for 128) FROM pg_attrdef d, pg_class c
+ WHERE c.relname = '$table' AND c.oid = d.adrelid AND d.adnum = $attnum
+END
+ $d_sth->execute or die $d_sth->errstr;
+
+ $default = $d_sth->fetchrow_arrayref->[0];
+ };
+
+ my $len = '';
+ if ( $_->{attlen} == -1 && $_->{atttypmod} != -1
+ && $_->{typname} ne 'text' ) {
+ $len = $_->{atttypmod} - 4;
+ if ( $_->{typname} eq 'numeric' ) {
+ $len = ($len >> 16). ','. ($len & 0xffff);
+ }
+ }
+
+ my $type = $_->{'typname'};
+ $type = 'char' if $type eq 'bpchar';
+
+ [
+ $_->{'attname'},
+ $type,
+ ! $_->{'attnotnull'},
+ $len,
+ $default,
+ '' #local
+ ];
+
+ } @{ $sth->fetchall_arrayref({}) };
+}
+
+sub primary_key {
+ my($proto, $dbh, $table) = @_;
+ my $sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT a.attname, a.attnum
+ FROM pg_class c, pg_attribute a, pg_type t
+ WHERE c.relname = '${table}_pkey'
+ AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid
+END
+ $sth->execute or die $sth->errstr;
+ my $row = $sth->fetchrow_hashref or return '';
+ $row->{'attname'};
+}
+
+sub unique {
+ my($proto, $dbh, $table) = @_;
+ my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $_ ) ] }
+ grep { $proto->_is_unique($dbh, $_ ) }
+ $proto->_all_indices($dbh, $table)
+ };
+}
+
+sub index {
+ my($proto, $dbh, $table) = @_;
+ my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $_ ) ] }
+ grep { ! $proto->_is_unique($dbh, $_ ) }
+ $proto->_all_indices($dbh, $table)
+ };
+}
+
+sub _all_indices {
+ my($proto, $dbh, $table) = @_;
+ my $sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT c2.relname
+ FROM pg_class c, pg_class c2, pg_index i
+ WHERE c.relname = '$table' AND c.oid = i.indrelid AND i.indexrelid = c2.oid
+END
+ $sth->execute or die $sth->errstr;
+ map { $_->{'relname'} }
+ grep { $_->{'relname'} !~ /_pkey$/ }
+ @{ $sth->fetchall_arrayref({}) };
+}
+
+sub _index_fields {
+ my($proto, $dbh, $index) = @_;
+ my $sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT a.attname, a.attnum
+ FROM pg_class c, pg_attribute a, pg_type t
+ WHERE c.relname = '$index'
+ AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid
+END
+ $sth->execute or die $sth->errstr;
+ map { $_->{'attname'} } @{ $sth->fetchall_arrayref({}) };
+}
+
+sub _is_unique {
+ my($proto, $dbh, $index) = @_;
+ my $sth = $dbh->prepare(<<END) or die $dbh->errstr;
+ SELECT i.indisunique
+ FROM pg_index i, pg_class c, pg_am a
+ WHERE i.indexrelid = c.oid AND c.relname = '$index' AND c.relam = a.oid
+END
+ $sth->execute or die $sth->errstr;
+ my $row = $sth->fetchrow_hashref or die 'guru meditation #420';
+ $row->{'indisunique'};
+}
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+Yes.
+
+columns doesn't return column default information.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm
new file mode 100755
index 000000000..4a740693a
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm
@@ -0,0 +1,141 @@
+package DBIx::DBSchema::DBD::Sybase;
+
+use strict;
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
+
+$VERSION = '0.03';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+# 'empty' => 'empty'
+);
+
+=head1 NAME
+
+DBIx::DBSchema::DBD::Sybase - Sybase database driver for DBIx::DBSchema
+
+=head1 SYNOPSIS
+
+use DBI;
+use DBIx::DBSchema;
+
+$dbh = DBI->connect('dbi:Sybase:dbname=database', 'user', 'pass');
+$schema = new_native DBIx::DBSchema $dbh;
+
+=head1 DESCRIPTION
+
+This module implements a Sybase driver for DBIx::DBSchema.
+
+=cut
+
+sub columns {
+ my($proto, $dbh, $table) = @_;
+
+ my $sth = $dbh->prepare("sp_columns \@table_name=$table")
+ or die $dbh->errstr;
+
+ $sth->execute or die $sth->errstr;
+ my @cols = map {
+ [
+ $_->{'column_name'},
+ $_->{'type_name'},
+ ($_->{'nullable'} ? 1 : ''),
+ $_->{'length'},
+ '', #default
+ '' #local
+ ]
+ } @{ $sth->fetchall_arrayref({}) };
+ $sth->finish;
+
+ @cols;
+}
+
+sub primary_key {
+ return("StubbedPrimaryKey");
+}
+
+
+sub unique {
+ my($proto, $dbh, $table) = @_;
+ my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] }
+ grep { $proto->_is_unique($dbh, $_ ) }
+ $proto->_all_indices($dbh, $table)
+ };
+}
+
+sub index {
+ my($proto, $dbh, $table) = @_;
+ my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] }
+ grep { ! $proto->_is_unique($dbh, $_ ) }
+ $proto->_all_indices($dbh, $table)
+ };
+}
+
+sub _all_indices {
+ my($proto, $dbh, $table) = @_;
+
+ my $sth = $dbh->prepare_cached(<<END) or die $dbh->errstr;
+ SELECT name
+ FROM sysindexes
+ WHERE id = object_id('$table') and indid between 1 and 254
+END
+ $sth->execute or die $sth->errstr;
+ my @indices = map { $_->[0] } @{ $sth->fetchall_arrayref() };
+ $sth->finish;
+ $sth = undef;
+ @indices;
+}
+
+sub _index_fields {
+ my($proto, $dbh, $table, $index) = @_;
+
+ my @keys;
+
+ my ($indid) = $dbh->selectrow_array("select indid from sysindexes where id = object_id('$table') and name = '$index'");
+ for (1..30) {
+ push @keys, $dbh->selectrow_array("select index_col('$table', $indid, $_)") || ();
+ }
+
+ return @keys;
+}
+
+sub _is_unique {
+ my($proto, $dbh, $table, $index) = @_;
+
+ my ($isunique) = $dbh->selectrow_array("select status & 2 from sysindexes where id = object_id('$table') and name = '$index'");
+
+ return $isunique;
+}
+
+=head1 AUTHOR
+
+Charles Shapiro <charles.shapiro@numethods.com>
+(courtesy of Ivan Kohler <ivan-dbix-dbschema@420.am>)
+
+Mitchell Friedman <mitchell.friedman@numethods.com>
+
+Bernd Dulfer <bernd@widd.de>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001 Charles Shapiro, Mitchell J. Friedman
+Copyright (c) 2001 nuMethods LLC.
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+Yes.
+
+The B<primary_key> method does not yet work.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm
new file mode 100644
index 000000000..f3804dd28
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm
@@ -0,0 +1,126 @@
+package DBIx::DBSchema::DBD::mysql;
+
+use strict;
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
+
+$VERSION = '0.03';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+ 'TIMESTAMP' => 'DATETIME',
+ 'SERIAL' => 'INTEGER',
+ 'BOOL' => 'TINYINT',
+ 'LONG VARBINARY' => 'LONGBLOB',
+);
+
+=head1 NAME
+
+DBIx::DBSchema::DBD::mysql - MySQL native driver for DBIx::DBSchema
+
+=head1 SYNOPSIS
+
+use DBI;
+use DBIx::DBSchema;
+
+$dbh = DBI->connect('dbi:mysql:database', 'user', 'pass');
+$schema = new_native DBIx::DBSchema $dbh;
+
+=head1 DESCRIPTION
+
+This module implements a MySQL-native driver for DBIx::DBSchema.
+
+=cut
+
+sub columns {
+ my($proto, $dbh, $table ) = @_;
+ my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ map {
+ $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
+ or die "Illegal type: ". $_->{'Type'}. "\n";
+ my($type, $length) = ($1, $2);
+ [
+ $_->{'Field'},
+ $type,
+ $_->{'Null'},
+ $length,
+ $_->{'Default'},
+ $_->{'Extra'}
+ ]
+ } @{ $sth->fetchall_arrayref( {} ) };
+}
+
+#sub primary_key {
+# my($proto, $dbh, $table ) = @_;
+# my $primary_key = '';
+# my $sth = $dbh->prepare("SHOW INDEX FROM $table")
+# or die $dbh->errstr;
+# $sth->execute or die $sth->errstr;
+# my @pkey = map { $_->{'Column_name'} } grep {
+# $_->{'Key_name'} eq "PRIMARY"
+# } @{ $sth->fetchall_arrayref( {} ) };
+# scalar(@pkey) ? $pkey[0] : '';
+#}
+
+sub primary_key {
+ my($proto, $dbh, $table) = @_;
+ my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
+ $pkey;
+}
+
+sub unique {
+ my($proto, $dbh, $table) = @_;
+ my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
+ $unique_href;
+}
+
+sub index {
+ my($proto, $dbh, $table) = @_;
+ my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
+ $index_href;
+}
+
+sub _show_index {
+ my($proto, $dbh, $table ) = @_;
+ my $sth = $dbh->prepare("SHOW INDEX FROM $table")
+ or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+
+ my $pkey = '';
+ my(%index, %unique);
+ foreach my $row ( @{ $sth->fetchall_arrayref({}) } ) {
+ if ( $row->{'Key_name'} eq 'PRIMARY' ) {
+ $pkey = $row->{'Column_name'};
+ } elsif ( $row->{'Non_unique'} ) { #index
+ push @{ $index{ $row->{'Key_name'} } }, $row->{'Column_name'};
+ } else { #unique
+ push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'};
+ }
+ }
+
+ ( $pkey, \%unique, \%index );
+}
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm
new file mode 100644
index 000000000..2d6272ecb
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm
@@ -0,0 +1,471 @@
+package DBIx::DBSchema::Table;
+
+use strict;
+use vars qw(@ISA %create_params);
+#use Carp;
+#use Exporter;
+use DBIx::DBSchema::Column 0.02;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+=head1 NAME
+
+DBIx::DBSchema::Table - Table objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::Table;
+
+ #old style (depriciated)
+ $table = new DBIx::DBSchema::Table (
+ "table_name",
+ "primary_key",
+ $dbix_dbschema_colgroup_unique_object,
+ $dbix_dbschema_colgroup_index_object,
+ @dbix_dbschema_column_objects,
+ );
+
+ #new style (preferred), pass a hashref of parameters
+ $table = new DBIx::DBSchema::Table (
+ {
+ name => "table_name",
+ primary_key => "primary_key",
+ unique => $dbix_dbschema_colgroup_unique_object,
+ 'index' => $dbix_dbschema_colgroup_index_object,
+ columns => \@dbix_dbschema_column_objects,
+ }
+ );
+
+ $table->addcolumn ( $dbix_dbschema_column_object );
+
+ $table_name = $table->name;
+ $table->name("table_name");
+
+ $primary_key = $table->primary_key;
+ $table->primary_key("primary_key");
+
+ $dbix_dbschema_colgroup_unique_object = $table->unique;
+ $table->unique( $dbix_dbschema__colgroup_unique_object );
+
+ $dbix_dbschema_colgroup_index_object = $table->index;
+ $table->index( $dbix_dbschema_colgroup_index_object );
+
+ @column_names = $table->columns;
+
+ $dbix_dbschema_column_object = $table->column("column");
+
+ #preferred
+ @sql_statements = $table->sql_create_table( $dbh );
+ @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
+
+ #possible problems
+ @sql_statements = $table->sql_create_table( $datasrc );
+ @sql_statements = $table->sql_create_table;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::Table objects represent a single database table.
+
+=head1 METHODS
+
+=over 4
+
+=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
+
+=item new HASHREF
+
+Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
+hash reference of named parameters.
+
+ {
+ name => TABLE_NAME,
+ primary_key => PRIMARY_KEY,
+ unique => UNIQUE,
+ 'index' => INDEX,
+ columns => COLUMNS
+ }
+
+TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
+empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
+L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
+DBIx::DBSchema::ColGroup::Index object (see
+L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
+DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self;
+ if ( ref($_[0]) ) {
+
+ $self = shift;
+ $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
+ $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
+
+ } else {
+
+ my($name,$primary_key,$unique,$index,@columns) = @_;
+
+ my %columns = map { $_->name, $_ } @columns;
+ my @column_order = map { $_->name } @columns;
+
+ $self = {
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+ 'unique' => $unique,
+ 'index' => $index,
+ 'columns' => \%columns,
+ 'column_order' => \@column_order,
+ };
+
+ }
+
+ #check $primary_key, $unique and $index to make sure they are $columns ?
+ # (and sanity check?)
+
+ bless ($self, $class);
+
+}
+
+=item new_odbc DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses the experimental DBI type_info
+method to create a table with standard (ODBC) SQL column types that most
+closely correspond to any non-portable column types. Use this to import a
+schema that you wish to use with many different database engines. Although
+primary key and (unique) index information will only be imported from databases
+with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
+column names and attributes *should* work for any database.
+
+Note: the _odbc refers to the column types used and nothing else - you do not
+have to have ODBC installed or connect to the database via ODBC.
+
+=cut
+
+%create_params = (
+# undef => sub { '' },
+ '' => sub { '' },
+ 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
+ 'precision,scale' =>
+ sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
+);
+
+sub new_odbc {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my $sth = _null_sth($dbh, $name);
+ my $sthpos = 0;
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ $driver
+ ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
+ : []
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ $driver
+ ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ : []
+ ),
+ map {
+ my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
+ or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
+ "returned no results for type ". $sth->{TYPE}->[$sthpos];
+ new DBIx::DBSchema::Column
+ $_,
+ $type_info->{'TYPE_NAME'},
+ #"SQL_". uc($type_info->{'TYPE_NAME'}),
+ $sth->{NULLABLE}->[$sthpos],
+ &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
+ ${ [
+ eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
+ ] }[4]
+ # DB-local
+ } @{$sth->{NAME}}
+ );
+}
+
+=item new_native DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses database-native methods to read the
+schema, and will preserve any non-portable column types. The method is only
+available if there is a DBIx::DBSchema::DBD for the corresponding database
+engine (currently, MySQL and PostgreSQL).
+
+=cut
+
+sub new_native {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ ),
+ map {
+ DBIx::DBSchema::Column->new( @{$_} )
+ } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
+ );
+}
+
+=item addcolumn COLUMN
+
+Adds this DBIx::DBSchema::Column object.
+
+=cut
+
+sub addcolumn {
+ my($self,$column)=@_;
+ ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+ push @{$self->{'column_order'}}, $column->name;
+}
+
+=item delcolumn COLUMN_NAME
+
+Deletes this column. Returns false if no column of this name was found to
+remove, true otherwise.
+
+=cut
+
+sub delcolumn {
+ my($self,$column) = @_;
+ return 0 unless exists $self->{'columns'}{$column};
+ delete $self->{'columns'}{$column};
+ @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
+}
+
+=item name [ TABLE_NAME ]
+
+Returns or sets the table name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{name} = $value;
+ } else {
+ $self->{name};
+ }
+}
+
+=item primary_key [ PRIMARY_KEY ]
+
+Returns or sets the primary key.
+
+=cut
+
+sub primary_key {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{primary_key} = $value;
+ } else {
+ #$self->{primary_key};
+ #hmm. maybe should untaint the entire structure when it comes off disk
+ # cause if you don't trust that, ?
+ $self->{primary_key} =~ /^(\w*)$/
+ #aah!
+ or die "Illegal primary key: ", $self->{primary_key};
+ $1;
+ }
+}
+
+=item unique [ UNIQUE ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
+
+=cut
+
+sub unique {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{unique} = $value;
+ } else {
+ $self->{unique};
+ }
+}
+
+=item index [ INDEX ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Index object.
+
+=cut
+
+sub index {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'index'} = $value;
+ } else {
+ $self->{'index'};
+ }
+}
+
+=item columns
+
+Returns a list consisting of the names of all columns.
+
+=cut
+
+sub columns {
+ my($self)=@_;
+ #keys %{$self->{'columns'}};
+ #must preserve order
+ @{ $self->{'column_order'} };
+}
+
+=item column COLUMN_NAME
+
+Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
+COLUMN_NAME.
+
+=cut
+
+sub column {
+ my($self,$column)=@_;
+ $self->{'columns'}->{$column};
+}
+
+=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statments to create this table.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
+MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
+(if applicable) may also be supported in the future.
+
+=cut
+
+sub sql_create_table {
+ my($self, $dbh) = (shift, shift);
+
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
+ $created_dbh = 1;
+ }
+ #false laziness: nicked from DBSchema::_load_driver
+ my $driver;
+ if ( ref($dbh) ) {
+ $driver = $dbh->{Driver}->{Name};
+ } else {
+ my $discard = $dbh;
+ $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
+ or '' =~ /()/; # ensure $1 etc are empty if match fails
+ $driver = $1 or die "can't parse data source: $dbh";
+ }
+ #eofalse
+
+#should be in the DBD somehwere :/
+# my $saved_pkey = '';
+# if ( $driver eq 'Pg' && $self->primary_key ) {
+# my $pcolumn = $self->column( (
+# grep { $self->column($_)->name eq $self->primary_key } $self->columns
+# )[0] );
+##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
+# $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
+# #my $saved_pkey = $self->primary_key;
+# #$self->primary_key('');
+# #change it back afterwords :/
+# }
+
+ my @columns = map { $self->column($_)->line($dbh) } $self->columns;
+
+ push @columns, "PRIMARY KEY (". $self->primary_key. ")"
+ #if $self->primary_key && $driver ne 'Pg';
+ if $self->primary_key;
+
+ my $indexnum = 1;
+
+ my @r = (
+ "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
+ );
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->unique->sql_list
+ if $self->unique;
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->index->sql_list
+ if $self->index;
+
+ #$self->primary_key($saved_pkey) if $saved_pkey;
+ $dbh->disconnect if $created_dbh;
+ @r;
+}
+
+#
+
+sub _null_sth {
+ my($dbh, $table) = @_;
+ my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
+ or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ $sth;
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
+with no indices.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+sql_create_table() has database-specific foo that probably ought to be
+abstracted into the DBIx::DBSchema::DBD:: modules.
+
+sql_create_table may change or destroy the object's data. If you need to use
+the object after sql_create_table, make a copy beforehand.
+
+Some of the logic in new_odbc might be better abstracted into Column.pm etc.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
+
+=cut
+
+1;
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST
new file mode 100644
index 000000000..b04de251f
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST
@@ -0,0 +1,19 @@
+Changes
+MANIFEST
+MANIFEST.SKIP
+README
+TODO
+Makefile.PL
+DBSchema.pm
+t/load.t
+t/load-mysql.t
+t/load-pg.t
+DBSchema/Table.pm
+DBSchema/ColGroup.pm
+DBSchema/ColGroup/Index.pm
+DBSchema/ColGroup/Unique.pm
+DBSchema/Column.pm
+DBSchema/DBD.pm
+DBSchema/DBD/mysql.pm
+DBSchema/DBD/Pg.pm
+DBSchema/DBD/Sybase.pm
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP
new file mode 100644
index 000000000..ae335e78a
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP
@@ -0,0 +1 @@
+CVS/
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL
new file mode 100644
index 000000000..a10e4daf8
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'DBIx::DBSchema',
+ 'VERSION_FROM' => 'DBSchema.pm', # finds $VERSION
+ 'PREREQ_PM' => {
+ 'DBI' => 0,
+ 'FreezeThaw' => 0,
+ },
+);
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README
new file mode 100644
index 000000000..8911ea4ca
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README
@@ -0,0 +1,42 @@
+DBIx::DBSchema
+
+Copyright (c) 2000-2002 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+This module implements an OO-interface to database schemas. Using this module,
+you can create a database schema with an OO Perl interface. You can read the
+schema from an existing database. You can save the schema to disk and restore
+it from different process. Most importantly, DBIx::DBSchema can write SQL
+CREATE statements for different databases from a single source.
+
+Currently supported databases are MySQL, PostgreSQL and Sybase.
+DBIx::DBSchema will attempt to use generic SQL syntax for other databases.
+Assistance adding support for other databases is welcomed. See the
+DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and Base Class".
+
+To install:
+ perl Makefile.PL
+ make
+ make test # nothing substantial yet
+ make install
+
+Documentation will then be available via `man DBIx::DBSchema' or
+`perldoc DBIx::DBSchema'.
+
+Anonymous CVS access is available:
+ $ export CVSROOT=":pserver:anonymous@cleanwhisker.420.am:/home/cvs/cvsroot"
+ $ cvs login
+ (Logging in to anonymous@cleanwhisker.420.am)
+ CVS password: anonymous
+ $ cvs checkout DBIx-DBSchema
+as well as <http://www.420.am/cgi-bin/cvsweb/DBIx-DBSchema>.
+
+A mailing list is available. Send a blank message to
+<ivan-dbix-dbschema-users-subscribe@420.am>.
+
+Homepage: <http://www.420.am/dbix-dbschema>
+
+$Id: README,v 1.1 2004-04-29 09:21:27 ivan Exp $
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO
new file mode 100644
index 000000000..e75850bdb
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO
@@ -0,0 +1,6 @@
+port and test with additional databases
+
+sql CREATE TABLE output should convert integers
+(i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
+to fudge things
+
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t
new file mode 100644
index 000000000..78818c10d
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema::DBD::mysql;
+$loaded = 1;
+print "ok 1\n";
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t
new file mode 100644
index 000000000..93fcf4abb
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t
@@ -0,0 +1,12 @@
+print "1..1\n";
+eval "use DBD::Pg 1.32";
+if ( length($@) ) {
+ print "ok 1 # Skipped: DBD::Pg 1.32 required for Pg";
+} else {
+ eval "use DBIx::DBSchema::DBD::Pg;";
+ if ( length($@) ) {
+ print "not ok 1\n";
+ } else {
+ print "ok 1\n";
+ }
+}
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t
new file mode 100644
index 000000000..67ea44b24
--- /dev/null
+++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema;
+$loaded = 1;
+print "ok 1\n";