Index: Pg.pm
===================================================================
RCS file: /usr/local/cvsroot/dbdpg/dbdpg/Pg.pm,v
retrieving revision 1.24
diff -c -r1.24 Pg.pm
*** Pg.pm 26 Mar 2003 15:55:41 -0000 1.24
--- Pg.pm 27 Mar 2003 14:35:22 -0000
***************
*** 58,64 ****
}
## 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();");
--- 58,64 ----
}
## 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();");
***************
*** 67,77 ****
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;
--- 67,90 ----
return $dbh{pg_server_version};
}
! ## Is the second version greater than or equal to the first?
! sub _pg_check_version($$) {
! ## Check each section from left to right
! my @uno = split (/\./ => $_[0]);
! my @dos = split (/\./ => $_[1]);
! for (my $i=0; defined $uno[$i] or defined $dos[$i]; $i++) {
! $uno[$i] = 0 if ! defined $uno[$i];
! $dos[$i] = 0 if ! defined $dos[$i];
! return 2 if $uno[$i] < $dos[$i];
! return 0 if $uno[$i] > $dos[$i];
! }
! return 1; ## versions are equal
! }
!
! sub _pg_use_catalog {
my $dbh = shift;
! my $version = DBD::Pg::_pg_server_version($dbh);
! return DBD::Pg::_pg_check_version(7.3, $version) ? "pg_catalog." : "";
}
1;
***************
*** 85,91 ****
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);
--- 98,104 ----
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);
***************
*** 171,183 ****
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'/;
--- 184,199 ----
my ($dbh) = shift;
my @attrs = @_;
# my ($dbh, $catalog, $schema, $table, $column) = @_;
! my $CATALOG = DBD::Pg::_pg_use_catalog($dbh);
!
! my $version = DBD::Pg::_pg_server_version($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
! next if $flds[$idx] eq 'n.nspname' and ! DBD::Pg::_pg_check_version(7.3, $version);
if(defined $attrs[$idx] and length $attrs[$idx]) {
# Insure that the value is enclosed in single quotes.
$attrs[$idx] =~ s/^'?(\w+)'?$/'$1'/;
***************
*** 199,207 ****
my $wh = ""; # ();
$wh = join( " AND ", '', @wh ) if (@wh);
! my $version = DBD::Pg::pg_server_version($dbh);
! 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"
--- 215,224 ----
my $wh = ""; # ();
$wh = join( " AND ", '', @wh ) if (@wh);
! my $showschema = DBD::Pg::_pg_check_version(7.3, $version) ?
! "n.nspname" : "NULL::text";
! my $schemajoin = DBD::Pg::_pg_check_version(7.3, $version) ?
! "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)" : "";
my $col_info_sql = qq{
SELECT
NULL::text AS "TABLE_CAT"
***************
*** 250,270 ****
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)/;
! my @flds = qw/catname u.usename bc.relname/;
! $flds[1] = 'n.nspname' unless ($1.$2 < 73);
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.
--- 267,286 ----
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);
! my @flds = qw/catname n.nspname bc.relname/;
for my $idx (0 .. $#attrs) {
! next if $flds[$idx] eq 'catname'; # Skip catalog
! next if $flds[$idx] eq 'n.nspname' and ! DBD::Pg::_pg_check_version(7.3, $version);
if(defined $attrs[$idx] and length $attrs[$idx]) {
if ($attrs[$idx] =~ m/[,%_?]/) {
# contains a meta character.
***************
*** 288,295 ****
$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"
--- 304,313 ----
$wh = join( " AND ", '', @wh ) if (@wh);
# Base primary key selection query borrowed from phpPgAdmin.
! my $showschema = DBD::Pg::_pg_check_version(7.3, $version) ?
! "n.nspname" : "NULL::text";
! my $schemajoin = DBD::Pg::_pg_check_version(7.3, $version) ?
! "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = bc.relnamespace)" : "";
my $pri_key_sql = qq{
SELECT
NULL::text AS "TABLE_CAT"
***************
*** 360,368 ****
$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 = ();
--- 378,385 ----
$fk_catalog, $fk_schema, $fk_table) = @_;
# this query doesn't work for Postgres before 7.3
! my $version = DBD::Pg::_pg_server_version($dbh);
! return undef unless DBD::Pg::_pg_check_version(7.3, $version);
# Used to hold data for the attributes.
my @dat = ();
***************
*** 599,606 ****
my $tbl_sql = ();
! my $version = DBD::Pg::pg_server_version($dbh);
! my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
if ( # Rules 19a
(defined $catalog and $catalog eq '%')
--- 616,626 ----
my $tbl_sql = ();
! my $version = DBD::Pg::_pg_server_version($dbh);
! my $CATALOG = DBD::Pg::_pg_use_catalog($dbh);
! my $schemacase = DBD::Pg::_pg_check_version(7.3, $version) ?
! "CASE WHEN n.nspname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END" :
! "CASE WHEN c.relname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END";
if ( # Rules 19a
(defined $catalog and $catalog eq '%')
***************
*** 621,643 ****
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 '')
--- 641,663 ----
and (defined $schema and $schema eq '%')
and (defined $table and $table eq '')
) {
! $tbl_sql = DBD::Pg::_pg_check_version(7.3, $version) ?
! 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
! } :
! 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 19c
(defined $catalog and $catalog eq '')
***************
*** 698,707 ****
}
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"
--- 718,726 ----
}
else {
# Default SQL
! my $showschema = DBD::Pg::_pg_check_version(7.3, $version) ? "n.nspname" : "NULL::text";
! my $schemajoin = DBD::Pg::_pg_check_version(7.3, $version) ?
! "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)" : "";
$tbl_sql = qq{
SELECT NULL::text AS "TABLE_CAT"
, $showschema AS "TABLE_SCHEM"
***************
*** 723,729 ****
(c.relkind = 'v'
AND c.relhasrules = TRUE))
AND c.relname !~ '^xin[vx][0-9]+'
- AND c.relowner = u.usesysid
ORDER BY 1, 2, 3
};
--- 742,747 ----
***************
*** 733,739 ****
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/) {
--- 751,758 ----
my @flds = qw/catname n.nspname c.relname c.relkind/;
for my $idx (0 .. $#attrs) {
! next if $flds[$idx] eq 'catname'; # Skip catalog
! next if $flds[$idx] eq 'n.nspname' and ! DBD::Pg::_pg_check_version(7.3, $version);
if(defined $attrs[$idx] and length $attrs[$idx]) {
# Change the "name" of the types to the real value.
if ($flds[$idx] =~ m/relkind/) {
***************
*** 770,777 ****
, $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'
--- 789,796 ----
, $showschema AS "TABLE_SCHEM"
, c.relname AS "TABLE_NAME"
, CASE
! WHEN c.relkind = 'r' THEN
! $schemacase
WHEN c.relkind = 'v' THEN 'VIEW'
WHEN c.relkind = 'i' THEN 'INDEX'
WHEN c.relkind = 'S' THEN 'SEQUENCE'
***************
*** 803,829 ****
sub tables {
my($dbh) = @_;
! my $version = DBD::Pg::pg_server_version($dbh);
! 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;
--- 822,850 ----
sub tables {
my($dbh) = @_;
! my $version = DBD::Pg::_pg_server_version($dbh);
! my $SQL = DBD::Pg::_pg_check_version(7.3, $version) ?
"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"
! :
! "SELECT relname AS \"TABLE_NAME\"
! FROM pg_class
! WHERE relkind = 'r'
! AND relname !~ '^pg_'
! AND relname !~ '^xin[vx][0-9]+'
! ORDER BY 1";
my $sth = $dbh->prepare($SQL) or return undef;
$sth->execute or return undef;
my (@tables, @relname);
while (@relname = $sth->fetchrow_array) {
! push @tables, DBD::Pg::_pg_check_version(7.3, $version) ?
! "$relname[0].$relname[1]" : $relname[0];
}
$sth->finish;
***************
*** 833,839 ****
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
--- 854,860 ----
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
***************
*** 908,918 ****
# 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;
--- 929,939 ----
# by pg_constraint. To maintain compatibility, check
# version number and execute appropriate query.
! my $version = DBD::Pg::_pg_server_version($dbh);
! my $con_query = DBD::Pg::_pg_check_version(7.3, $version)
! ? "SELECT consrc FROM pg_catalog.pg_constraint WHERE contype = 'c' AND conname = '${table}_$col_name'"
! : "SELECT rcsrc FROM pg_relcheck WHERE rcname = '${table}_$col_name'";
my ($constraint) = $dbh->selectrow_array($con_query);
$constraint = '' unless $constraint;
Index: t/15funct.t
===================================================================
RCS file: /usr/local/cvsroot/dbdpg/dbdpg/t/15funct.t,v
retrieving revision 1.8
diff -c -r1.8 15funct.t
*** t/15funct.t 27 Nov 2002 16:58:02 -0000 1.8
--- t/15funct.t 27 Mar 2003 14:35:22 -0000
***************
*** 48,54 ****
eval {
$sth = $dbh->get_info();
};
! ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
$sth = undef;
# Table Info
--- 48,54 ----
eval {
$sth = $dbh->get_info();
};
! ok ($@, "Call to get_info with 0 arguments, error expected: $@" );
$sth = undef;
# Table Info
***************
*** 63,69 ****
$sth = $dbh->column_info();
};
ok ((!$@ and defined $sth), "column_info tested" );
! #ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
$sth = undef;
--- 63,69 ----
$sth = $dbh->column_info();
};
ok ((!$@ and defined $sth), "column_info tested" );
! #ok ($@, "Call to column_info with 0 arguments, error expected: $@" );
$sth = undef;
***************
*** 118,139 ****
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 ..." );
--- 118,123 ----
***************
*** 152,159 ****
# 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}) " .
--- 136,158 ----
# SQL_TABLE_TERM
# SQL_USER_NAME
!
! TODO: {
!
! local $TODO = "table_info is not implemented yet";
! # , 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" )}
! );
!
foreach my $info (sort keys %$get_info) {
my $type = $dbh->get_info($get_info->{$info});
ok( defined $type, "get_info($info) ($get_info->{$info}) " .
***************
*** 285,291 ****
$sth = $dbh->primary_key_info();
die unless $sth;
};
! ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
$sth = undef;
# Primary Key
--- 284,290 ----
$sth = $dbh->primary_key_info();
die unless $sth;
};
! ok ($@, "Call to primary_key_info with 0 arguments, error expected: $@" );
$sth = undef;
# Primary Key
***************
*** 293,299 ****
$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 );
--- 292,298 ----
$sth = $dbh->primary_key();
die unless $sth;
};
! ok ($@, "Call to primary_key with 0 arguments, error expected: $@" );
$sth = undef;
$sth = $dbh->primary_key_info(undef, undef, undef );
***************
*** 333,351 ****
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" );
--- 332,347 ----
undef $sth;
! # foreign_key_info
! local ($dbh->{Warn}, $dbh->{PrintError});
! $dbh->{PrintError} = $dbh->{Warn} = 0;
!
! eval {
$sth = $dbh->foreign_key_info();
! die unless $sth;
! };
! ok ($@, "Call to foreign_key_info with 0 arguments, error expected: $@" );
! $sth = undef;
ok( $dbh->disconnect, "Disconnect from database" );