Author: turnstep
Date: Thu Nov 30 20:33:49 2006
New Revision: 8337
Modified:
DBD-Pg/trunk/Changes
DBD-Pg/trunk/Pg.pm
DBD-Pg/trunk/t/03dbmethod.t
Log:
Add statistics_info method, from Brandon Black
Modified: DBD-Pg/trunk/Changes
==============================================================================
--- DBD-Pg/trunk/Changes (original)
+++ DBD-Pg/trunk/Changes Thu Nov 30 20:33:49 2006
@@ -5,6 +5,7 @@
- Fix pg_description join in table_info(). [Max Cohan [EMAIL PROTECTED]
- Fix memory leak in bytea quoting. (CPAN bug #21392). Fix memory leak
in pg_notifies. [Stephen Marshall [EMAIL PROTECTED]
+ - Added statistics_info function [Brandon Black [EMAIL PROTECTED]
1.49 May 7, 2006
- Thanks to Backcountry.com for sponsoring work on this release. [GSM]
Modified: DBD-Pg/trunk/Pg.pm
==============================================================================
--- DBD-Pg/trunk/Pg.pm (original)
+++ DBD-Pg/trunk/Pg.pm Thu Nov 30 20:33:49 2006
@@ -496,6 +496,151 @@
return $sth;
}
+ sub statistics_info {
+ my $dbh = shift;
+ my ($catalog, $schema, $table, $unique_only, $quick, $attr) =
@_;
+
+ ## Catalog is ignored, but table is mandatory
+ return undef unless defined $table and length $table;
+
+ my $version = $dbh->{private_dbdpg}{version};
+
+ # These defaults are for schema-less pre-7.3 versions...
+ my $schema_out = 'NULL::text AS nspname';
+ my $schema_from = '';
+ my $schema_where = '';
+ my @exe_args = ($table);
+
+ my $gotschema = $version >= 70300 ? 1 : 0;
+ my $input_schema = (defined $schema and length $schema) ? 1 : 0;
+
+ if($gotschema) {
+ $schema_out = 'n.nspname';
+ $schema_from = ", ${DBD::Pg::dr::CATALOG}pg_namespace
n";
+ if($input_schema) {
+ $schema_where = 'AND n.nspname = ? AND n.oid =
d.relnamespace';
+ push(@exe_args, $schema);
+ }
+ else {
+ $schema_where = 'AND n.oid = d.relnamespace';
+ }
+ }
+
+ my $table_stats_sql = qq{
+ SELECT d.relpages, d.reltuples, $schema_out
+ FROM pg_class d $schema_from
+ WHERE d.relname = ? $schema_where
+ };
+
+ my $colnames_sql = qq{
+ SELECT
+ a.attnum, a.attname
+ FROM
+ ${DBD::Pg::dr::CATALOG}pg_attribute a,
${DBD::Pg::dr::CATALOG}pg_class d
+ $schema_from
+ WHERE
+ a.attrelid = d.oid AND d.relname = ?
$schema_where
+ };
+
+ my $stats_sql = qq{
+ SELECT
+ c.relname, i.indkey, i.indisunique,
i.indisclustered, a.amname,
+ $schema_out, c.relpages, c.reltuples,
i.indexprs,
+ pg_get_expr(i.indpred,i.indrelid) as predicate
+ FROM
+ ${DBD::Pg::dr::CATALOG}pg_index i,
${DBD::Pg::dr::CATALOG}pg_class c,
+ ${DBD::Pg::dr::CATALOG}pg_class d,
${DBD::Pg::dr::CATALOG}pg_am a
+ $schema_from
+ WHERE
+ d.relname = ? $schema_where AND d.oid =
i.indrelid
+ AND i.indexrelid = c.oid AND c.relam = a.oid
+ ORDER BY
+ i.indisunique desc, a.amname, c.relname
+ };
+
+ my @output_rows;
+
+ # Table-level stats
+ if(!$unique_only) {
+ my $table_stats_sth = $dbh->prepare($table_stats_sql);
+ $table_stats_sth->execute(@exe_args) or return undef;
+ my $tst = $table_stats_sth->fetchrow_hashref or return
undef;
+ push(@output_rows, [
+ undef, # TABLE_CAT
+ $tst->{nspname}, # TABLE_SCHEM
+ $table, # TABLE_NAME
+ undef, # NON_UNIQUE
+ undef, # INDEX_QUALIFIER
+ undef, # INDEX_NAME
+ 'table', # TYPE
+ undef, # ORDINAL_POSITION
+ undef, # COLUMN_NAME
+ undef, # ASC_OR_DESC
+ $tst->{reltuples},# CARDINALITY
+ $tst->{relpages}, # PAGES
+ undef, # FILTER_CONDITION
+ ]);
+ }
+
+ # Fetch the column names for later use
+ my $colnames_sth = $dbh->prepare($colnames_sql);
+ $colnames_sth->execute(@exe_args) or return undef;
+ my $colnames = $colnames_sth->fetchall_hashref('attnum');
+
+ # Fetch the index definitions
+ my $sth = $dbh->prepare($stats_sql);
+ $sth->execute(@exe_args) or return undef;
+
+ STAT_ROW:
+ while(my $row = $sth->fetchrow_hashref) {
+ next if $row->{indexprs}; # We can't return these
accurately via this interface ...
+ next if $unique_only && !$row->{indisunique};
+
+ my $indtype = $row->{indisclustered}
+ ? 'clustered'
+ : ( $row->{amname} eq 'btree' )
+ ? 'btree'
+ : ($row->{amname} eq 'hash' )
+ ? 'hashed' : 'other';
+
+ my $nonunique = $row->{indisunique} ? 0 : 1;
+
+ my @index_row = (
+ undef, # TABLE_CAT
+ $row->{nspname}, # TABLE_SCHEM
+ $table, # TABLE_NAME
+ $nonunique, # NON_UNIQUE
+ undef, # INDEX_QUALIFIER
+ $row->{relname}, # INDEX_NAME
+ $indtype, # TYPE
+ undef, # ORDINAL_POSITION
+ undef, # COLUMN_NAME
+ 'A', # ASC_OR_DESC
+ $row->{reltuples}, # CARDINALITY
+ $row->{relpages}, # PAGES
+ $row->{predicate}, # FILTER_CONDITION
+ );
+
+ my $col_nums = $row->{indkey};
+ $col_nums =~ s/^\s+//;
+ my @col_nums = split(/\s+/, $col_nums);
+
+ my $ord_pos = 1;
+ foreach my $col_num (@col_nums) {
+ my @copy = @index_row;
+ $copy[7] = $ord_pos++; # ORDINAL_POSITION
+ $copy[8] = $colnames->{$col_num}->{attname}; #
COLUMN_NAME
+ push(@output_rows, [EMAIL PROTECTED]);
+ }
+ }
+
+ my @output_colnames = qw/ TABLE_CAT TABLE_SCHEM TABLE_NAME
NON_UNIQUE INDEX_QUALIFIER
+ INDEX_NAME TYPE ORDINAL_POSITION
COLUMN_NAME ASC_OR_DESC
+ CARDINALITY PAGES FILTER_CONDITION /;
+
+ return _prepare_from_data('statistics_info', [EMAIL PROTECTED],
[EMAIL PROTECTED]);
+ }
+
sub primary_key_info {
my $dbh = shift;
Modified: DBD-Pg/trunk/t/03dbmethod.t
==============================================================================
--- DBD-Pg/trunk/t/03dbmethod.t (original)
+++ DBD-Pg/trunk/t/03dbmethod.t Thu Nov 30 20:33:49 2006
@@ -18,7 +18,7 @@
$|=1;
if (defined $ENV{DBI_DSN}) {
- plan tests => 186;
+ plan tests => 196;
}
else {
plan skip_all => 'Cannot run test unless DBI_DSN is defined. See the
README file';
@@ -430,6 +430,131 @@
is_deeply( [EMAIL PROTECTED], $expected, 'DB handle method "primary_key"
returns empty list for invalid table');
#
+# Test of the "statistics_info" database handle method
+#
+
+$sth = $dbh->statistics_info(undef,undef,undef,undef,undef);
+is ($sth, undef, 'DB handle method "statistics_info" returns undef: no table');
+
+# Drop any tables that may exist
+my $fktables = join "," => map { "'dbd_pg_test$_'" } (1..3);
+$SQL = "SELECT relname FROM pg_catalog.pg_class WHERE relkind='r' AND relname
IN ($fktables)";
+{
+ local $SIG{__WARN__} = sub {};
+ for (@{$dbh->selectall_arrayref($SQL)}) {
+ $dbh->do("DROP TABLE $_->[0] CASCADE");
+ }
+}
+
+## Invalid table
+$sth = $dbh->statistics_info(undef,undef,'dbd_pg_test9',undef,undef);
+is ($sth, undef, 'DB handle method "statistics_info" returns undef: bad
table');
+
+## Create some tables with various indexes
+{
+ local $SIG{__WARN__} = sub {};
+ $dbh->do("CREATE TABLE dbd_pg_test1 (a INT, b INT NOT NULL, c INT NOT
NULL, ".
+ "CONSTRAINT dbd_pg_test1_pk PRIMARY KEY (a))");
+ $dbh->do("ALTER TABLE dbd_pg_test1 ADD CONSTRAINT dbd_pg_test1_uc1
UNIQUE (b)");
+ $dbh->do("CREATE UNIQUE INDEX dbd_pg_test1_index_c ON dbd_pg_test1(c)");
+ $dbh->do("CREATE TABLE dbd_pg_test2 (a INT, b INT, c INT, PRIMARY
KEY(a,b), UNIQUE(b,c))");
+ $dbh->do("CREATE INDEX dbd_pg_test2_skipme ON dbd_pg_test2(c,(a+b))");
+ $dbh->do("CREATE TABLE dbd_pg_test3 (a INT, b INT, c INT, PRIMARY
KEY(a)) WITH OIDS");
+ $dbh->do("CREATE UNIQUE INDEX dbd_pg_test3_index_b ON dbd_pg_test3(b)");
+ $dbh->do("CREATE INDEX dbd_pg_test3_index_c ON dbd_pg_test3 USING
hash(c)");
+ $dbh->do("CREATE INDEX dbd_pg_test3_oid ON dbd_pg_test3(oid)");
+ $dbh->do("CREATE UNIQUE INDEX dbd_pg_test3_pred ON dbd_pg_test3(c)
WHERE c > 0 AND c < 45");
+ $dbh->commit();
+}
+
+my $correct_stats = {
+one => [
+ [ undef, 'public', 'dbd_pg_test1', undef, undef, undef, 'table', undef,
undef, undef, '0', '0', undef ],
+ [ undef, 'public', 'dbd_pg_test1', '0', undef, 'dbd_pg_test1_index_c',
'btree', 1, 'c', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test1', '0', undef, 'dbd_pg_test1_pk',
'btree', 1, 'a', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test1', '0', undef, 'dbd_pg_test1_uc1',
'btree', 1, 'b', 'A', '0', '1', undef ],
+],
+two => [
+ [ undef, 'public', 'dbd_pg_test2', undef, undef, undef, 'table', undef,
undef, undef, '0', '0', undef ],
+ [ undef, 'public', 'dbd_pg_test2', '0', undef, 'dbd_pg_test2_b_key',
'btree', 1, 'b', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test2', '0', undef, 'dbd_pg_test2_b_key',
'btree', 2, 'c', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test2', '0', undef, 'dbd_pg_test2_pkey',
'btree', 1, 'a', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test2', '0', undef, 'dbd_pg_test2_pkey',
'btree', 2, 'b', 'A', '0', '1', undef ],
+],
+three => [
+ [ undef, 'public', 'dbd_pg_test3', undef, undef, undef, 'table', undef,
undef, undef, '0', '0', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_index_b',
'btree', 1, 'b', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_pkey',
'btree', 1, 'a', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_pred',
'btree', 1, 'c', 'A', '0', '1', '((c > 0) AND (c < 45))' ],
+ [ undef, 'public', 'dbd_pg_test3', '1', undef, 'dbd_pg_test3_oid',
'btree', 1, 'oid', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '1', undef, 'dbd_pg_test3_index_c',
'hashed', 1, 'c', 'A', '0', '0', undef ],
+],
+three_uo => [
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_index_b',
'btree', 1, 'b', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_pkey',
'btree', 1, 'a', 'A', '0', '1', undef ],
+ [ undef, 'public', 'dbd_pg_test3', '0', undef, 'dbd_pg_test3_pred',
'btree', 1, 'c', 'A', '0', '1', '((c > 0) AND (c < 45))' ],
+],
+};
+
+if(!$got73) { # wipe out the schema names in the expected results above
+ foreach my $subset (values %$correct_stats) {
+ foreach (@$subset) {
+ $_->[1] = undef;
+ }
+ }
+}
+
+SKIP: {
+ skip qq{Cannot test statistics_info with schema arg on pre-7.3
servers.}, 3
+ if ! $got73;
+
+ my $stats;
+
+ $sth = $dbh->statistics_info(undef,'public','dbd_pg_test1',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{one}, 'Correct stats output for
public.dbd_pg_test1');
+
+ $sth = $dbh->statistics_info(undef,'public','dbd_pg_test2',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{two}, 'Correct stats output for
public.dbd_pg_test2');
+
+ $sth = $dbh->statistics_info(undef,'public','dbd_pg_test3',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{three}, 'Correct stats output for
public.dbd_pg_test3');
+
+ $sth = $dbh->statistics_info(undef,'public','dbd_pg_test3',1,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{three_uo}, 'Correct stats output for
public.dbd_pg_test3 (unique only)');
+}
+
+{
+ my $stats;
+
+ $sth = $dbh->statistics_info(undef,undef,'dbd_pg_test1',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{one}, 'Correct stats output for
dbd_pg_test1');
+
+ $sth = $dbh->statistics_info(undef,undef,'dbd_pg_test2',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{two}, 'Correct stats output for
dbd_pg_test2');
+
+ $sth = $dbh->statistics_info(undef,undef,'dbd_pg_test3',undef,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{three}, 'Correct stats output for
dbd_pg_test3');
+
+ $sth = $dbh->statistics_info(undef,undef,'dbd_pg_test3',1,undef);
+ $stats = $sth->fetchall_arrayref;
+ is_deeply($stats, $correct_stats->{three_uo}, 'Correct stats output for
dbd_pg_test3 (unique only)');
+}
+
+# Clean everything up
+{
+ $dbh->do("DROP TABLE dbd_pg_test3");
+ $dbh->do("DROP TABLE dbd_pg_test2");
+ $dbh->do("DROP TABLE dbd_pg_test1");
+}
+
+#
# Test of the "foreign_key_info" database handle method
#
