Skip Menu |
 

This queue is for tickets about the DBD-SQLite CPAN distribution.

Report information
The Basics
Id: 86080
Status: resolved
Priority: 0/
Queue: DBD-SQLite

People
Owner: Nobody in particular
Requestors: DDICK [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: PATCH: statistics_info support
Patch includes support for the statistics_info function
Subject: dbd_sqlite_statistics.patch
diff -Naur old/lib/DBD/SQLite.pm new/lib/DBD/SQLite.pm --- old/lib/DBD/SQLite.pm 2013-06-10 01:04:08.000000000 +1000 +++ new/lib/DBD/SQLite.pm 2013-06-12 06:49:29.139486160 +1000 @@ -617,6 +617,90 @@ 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 [ diff -Naur old/t/55_statistics_info.t new/t/55_statistics_info.t --- old/t/55_statistics_info.t 1970-01-01 10:00:00.000000000 +1000 +++ new/t/55_statistics_info.t 2013-06-12 17:27:50.491686599 +1000 @@ -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");
Download (untitled) / with headers
text/plain 209b
Thanks. Applied. https://github.com/DBD-SQLite/DBD-SQLite/commit/0b8fedf492fc1b1f0654b4b7fc2973d62e9a1248 On Wed Jun 12 16:40:16 2013, DDICK wrote: Show quoted text
> Patch includes support for the statistics_info function
Download (untitled) / with headers
text/plain 322b
Closed as DBD::SQLite 1.40 with this patch is out. On Sat Jun 15 04:28:48 2013, ISHIGAKI wrote: Show quoted text
> Thanks. Applied. > > https://github.com/DBD-SQLite/DBD- > SQLite/commit/0b8fedf492fc1b1f0654b4b7fc2973d62e9a1248 > > On Wed Jun 12 16:40:16 2013, DDICK wrote:
> > Patch includes support for the statistics_info function


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.