mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
applied a patch from DDICK to add statistics_info (RT #86080)
This commit is contained in:
Kenichi Ishigaki
parent
6964813bb6
commit
0b8fedf492
2 changed files with 183 additions and 0 deletions
|
|
@ -617,6 +617,90 @@ sub foreign_key_info {
|
|||
return $sponge_sth;
|
||||
}
|
||||
|
||||
my @STATISTICS_INFO_ODBC = (
|
||||
'TABLE_CAT', # The catalog identifier.
|
||||
'TABLE_SCHEM', # The schema identifier.
|
||||
'TABLE_NAME', # The table identifier.
|
||||
'NON_UNIQUE', # Unique index indicator.
|
||||
'INDEX_QUALIFIER', # Index qualifier identifier.
|
||||
'INDEX_NAME', # The index identifier.
|
||||
'TYPE', # The type of information being returned.
|
||||
'ORDINAL_POSITION', # Column sequence number (starting with 1).
|
||||
'COLUMN_NAME', # The column identifier.
|
||||
'ASC_OR_DESC', # Column sort sequence.
|
||||
'CARDINALITY', # Cardinality of the table or index.
|
||||
'PAGES', # Number of storage pages used by this table or index.
|
||||
'FILTER_CONDITION', # The index filter condition as a string.
|
||||
);
|
||||
|
||||
sub statistics_info {
|
||||
my ($dbh, $catalog, $schema, $table, $unique_only, $quick) = @_;
|
||||
|
||||
my $databases = $dbh->selectall_arrayref("PRAGMA database_list", {Slice => {}});
|
||||
|
||||
my @statistics_info;
|
||||
for my $database (@$databases) {
|
||||
my $dbname = $database->{name};
|
||||
next if defined $schema && $schema ne '%' && $schema ne $dbname;
|
||||
|
||||
my $quoted_dbname = $dbh->quote_identifier($dbname);
|
||||
my $master_table =
|
||||
($dbname eq 'main') ? 'sqlite_master' :
|
||||
($dbname eq 'temp') ? 'sqlite_temp_master' :
|
||||
$quoted_dbname.'.sqlite_master';
|
||||
|
||||
my $tables = $dbh->selectall_arrayref("SELECT name FROM $master_table WHERE type = ?", undef, "table");
|
||||
for my $table_ref (@$tables) {
|
||||
my $tbname = $table_ref->[0];
|
||||
next if defined $table && $table ne '%' && $table ne $tbname;
|
||||
|
||||
my $quoted_tbname = $dbh->quote_identifier($tbname);
|
||||
my $sth = $dbh->prepare("PRAGMA $quoted_dbname.index_list($quoted_tbname)");
|
||||
$sth->execute;
|
||||
while(my $row = $sth->fetchrow_hashref) {
|
||||
|
||||
next if defined $unique_only && $unique_only && $row->{unique};
|
||||
my $quoted_idx = $dbh->quote_identifier($row->{name});
|
||||
for my $db (@$databases) {
|
||||
my $quoted_db = $dbh->quote_identifier($db->{name});
|
||||
my $i_sth = $dbh->prepare("PRAGMA $quoted_db.index_info($quoted_idx)");
|
||||
$i_sth->execute;
|
||||
my $cols = {};
|
||||
while(my $info = $i_sth->fetchrow_hashref) {
|
||||
push @statistics_info, {
|
||||
TABLE_CAT => undef,
|
||||
TABLE_SCHEM => $db->{name},
|
||||
TABLE_NAME => $tbname,
|
||||
NON_UNIQUE => $row->{unique} ? 0 : 1,
|
||||
INDEX_QUALIFIER => undef,
|
||||
INDEX_NAME => $row->{name},
|
||||
TYPE => 'btree', # see http://www.sqlite.org/version3.html esp. "Traditional B-trees are still used for indices"
|
||||
ORDINAL_POSITION => $info->{seqno} + 1,
|
||||
COLUMN_NAME => $info->{name},
|
||||
ASC_OR_DESC => undef,
|
||||
CARDINALITY => undef,
|
||||
PAGES => undef,
|
||||
FILTER_CONDITION => undef,
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $sponge_dbh = DBI->connect("DBI:Sponge:", "", "")
|
||||
or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
|
||||
my $sponge_sth = $sponge_dbh->prepare("statistics_info", {
|
||||
NAME => \@STATISTICS_INFO_ODBC,
|
||||
rows => [ map { [@{$_}{@STATISTICS_INFO_ODBC} ] } @statistics_info ],
|
||||
NUM_OF_FIELDS => scalar(@STATISTICS_INFO_ODBC),
|
||||
}) or return $dbh->DBI::set_err(
|
||||
$sponge_dbh->err,
|
||||
$sponge_dbh->errstr,
|
||||
);
|
||||
return $sponge_sth;
|
||||
}
|
||||
|
||||
sub type_info_all {
|
||||
return; # XXX code just copied from DBD::Oracle, not yet thought about
|
||||
# return [
|
||||
|
|
|
|||
99
t/55_statistics_info.t
Normal file
99
t/55_statistics_info.t
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
use DBD::SQLite;
|
||||
unless ($DBD::SQLite::sqlite_version_number && $DBD::SQLite::sqlite_version_number >= 3006019) {
|
||||
plan skip_all => "this test requires SQLite 3.6.19 and newer";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
my @sql_statements = split /\n\n/, <<__EOSQL__;
|
||||
CREATE TABLE a (
|
||||
id INTEGER,
|
||||
fname TEXT,
|
||||
lname TEXT,
|
||||
UNIQUE(id)
|
||||
);
|
||||
|
||||
CREATE INDEX "a_fn" ON "a" ( "fname" );
|
||||
|
||||
CREATE INDEX "a_ln" ON "a" ( "lname" );
|
||||
|
||||
CREATE UNIQUE INDEX "a_an" ON "a" ( "fname", "lname" );
|
||||
|
||||
ATTACH DATABASE ':memory:' AS remote;
|
||||
|
||||
CREATE TABLE remote.b (
|
||||
id INTEGER,
|
||||
fname TEXT,
|
||||
lname TEXT,
|
||||
PRIMARY KEY(id),
|
||||
UNIQUE(fname, lname)
|
||||
);
|
||||
|
||||
__EOSQL__
|
||||
|
||||
|
||||
plan tests => @sql_statements + 33;
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
|
||||
my $sth;
|
||||
my $stats_data;
|
||||
my $R = \%DBD::SQLite::db::DBI_code_for_rule;
|
||||
|
||||
ok ($dbh->do($_), $_) foreach @sql_statements;
|
||||
|
||||
$sth = $dbh->statistics_info(undef, undef, 'a', 0, 0);
|
||||
$stats_data = $sth->fetchall_hashref([ 'INDEX_NAME', 'ORDINAL_POSITION' ]);
|
||||
|
||||
for ($stats_data->{a_fn}->{1}) {
|
||||
is($_->{TABLE_NAME}, "a" , "table name");
|
||||
is($_->{COLUMN_NAME}, "fname", "column name");
|
||||
is($_->{TYPE}, "btree", "type");
|
||||
is($_->{ORDINAL_POSITION}, 1, "ordinal position");
|
||||
is($_->{NON_UNIQUE}, 1, "non unique");
|
||||
is($_->{INDEX_NAME}, "a_fn", "index name");
|
||||
is($_->{TABLE_SCHEM}, "main", "table schema");
|
||||
}
|
||||
ok(not(exists $stats_data->{a_fn}->{2}), "only one index in a_fn index");
|
||||
for ($stats_data->{a_ln}->{1}) {
|
||||
is($_->{TABLE_NAME}, "a" , "table name");
|
||||
is($_->{COLUMN_NAME}, "lname", "column name");
|
||||
is($_->{TYPE}, "btree", "type");
|
||||
is($_->{ORDINAL_POSITION}, 1, "ordinal position");
|
||||
is($_->{NON_UNIQUE}, 1, "non unique");
|
||||
is($_->{INDEX_NAME}, "a_ln", "index name");
|
||||
is($_->{TABLE_SCHEM}, "main", "table schema");
|
||||
}
|
||||
ok(not(exists $stats_data->{a_ln}->{2}), "only one index in a_ln index");
|
||||
for ($stats_data->{a_an}->{1}) {
|
||||
is($_->{TABLE_NAME}, "a" , "table name");
|
||||
is($_->{COLUMN_NAME}, "fname", "column name");
|
||||
is($_->{TYPE}, "btree", "type");
|
||||
is($_->{ORDINAL_POSITION}, 1, "ordinal position");
|
||||
is($_->{NON_UNIQUE}, 0, "non unique");
|
||||
is($_->{INDEX_NAME}, "a_an", "index name");
|
||||
is($_->{TABLE_SCHEM}, "main", "table schema");
|
||||
}
|
||||
for ($stats_data->{a_an}->{2}) {
|
||||
is($_->{TABLE_NAME}, "a" , "table name");
|
||||
is($_->{COLUMN_NAME}, "lname", "column name");
|
||||
is($_->{TYPE}, "btree", "type");
|
||||
is($_->{ORDINAL_POSITION}, 2, "ordinal position");
|
||||
is($_->{NON_UNIQUE}, 0, "non unique");
|
||||
is($_->{INDEX_NAME}, "a_an", "index name");
|
||||
is($_->{TABLE_SCHEM}, "main", "table schema");
|
||||
}
|
||||
ok(not(exists $stats_data->{a_ln}->{3}), "only two indexes in a_an index");
|
||||
Loading…
Add table
Reference in a new issue