diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index 663ee4e..360886f 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -2160,6 +2160,13 @@ Returns a hash reference that holds a set of status information of SQLite statem You may also pass 0 as an argument to reset the status. +=head2 $sth->sqlite_create_module() + +Registers a name for a I. Module names must be +registered before creating a new virtual table using the module and +before using a preexisting virtual table for the module. +Virtual tables are explained in L. + =head1 DRIVER CONSTANTS A subset of SQLite C constants are made available to Perl, diff --git a/lib/DBD/SQLite/VirtualTable/FileContent.pm b/lib/DBD/SQLite/VirtualTable/FileContent.pm index d01fce8..5b45c61 100644 --- a/lib/DBD/SQLite/VirtualTable/FileContent.pm +++ b/lib/DBD/SQLite/VirtualTable/FileContent.pm @@ -163,7 +163,6 @@ sub get_content { - #====================================================================== package DBD::SQLite::VirtualTable::FileContent::Cursor; #====================================================================== diff --git a/lib/DBD/SQLite/VirtualTable/PerlData.pm b/lib/DBD/SQLite/VirtualTable/PerlData.pm index 5e3f15c..e6ba8a6 100644 --- a/lib/DBD/SQLite/VirtualTable/PerlData.pm +++ b/lib/DBD/SQLite/VirtualTable/PerlData.pm @@ -87,12 +87,13 @@ sub BEST_INDEX { $optype = $NUM; } else { - my $get_col = $self->{options}{arrayrefs} ? "->[$col]" - : $self->{options}{hashrefs} ? "->{$self->{headers}[$col]}" - : $self->{options}{colref} ? "" - : die "corrupted data in ->{options}"; - $member = '$self->row($i)' . $get_col; - $optype = $self->{optypes}[$col]; + # cnstraint on regular column + my $opts = $self->{options}; + $member = $opts->{arrayrefs} ? "\$row->[$col]" + : $opts->{hashrefs} ? "\$row->{$self->{headers}[$col]}" + : $opts->{colref} ? "\$row" + : die "corrupted data in ->{options}"; + $optype = $self->{optypes}[$col]; } my $op = $SQLOP2PERLOP{$constraint->{op}}[$optype]; my $quote = $op eq '=~' ? 'qr' : 'q'; @@ -123,10 +124,11 @@ sub BEST_INDEX { sub _build_new_row { my ($self, $values) = @_; - return $self->{options}{arrayrefs} ? $values - : $self->{options}{hashrefs} ? { mesh @{$self->{headers}}, @$values } - : $self->{options}{colref} ? $values->[0] - : die "corrupted data in ->{options}"; + my $opts = $self->{options}; + return $opts->{arrayrefs} ? $values + : $opts->{hashrefs} ? { mesh @{$self->{headers}}, @$values } + : $opts->{colref} ? $values->[0] + : die "corrupted data in ->{options}"; } @@ -183,8 +185,15 @@ sub row { sub FILTER { my ($self, $idxNum, $idxStr, @values) = @_; + # escape '\' and '}' in values before they are sprintf'ed into q{%s} + s/\\/\\\\/g, s/}/\\}/g foreach @values; + # build a method coderef to fetch matching rows - my $perl_code = sprintf "sub {my (\$self, \$i) = \@_; $idxStr}", @values; + my $perl_code = 'sub {my ($self, $i) = @_; my $row = $self->row($i); ' + . sprintf($idxStr, @values) + . '}'; + + # print STDERR $perl_code, "\n"; $self->{is_wanted_row} = eval $perl_code or die "couldn't eval q{$perl_code} : $@"; @@ -215,12 +224,11 @@ sub COLUMN { my $row = $self->row($self->{row_ix}); - - return $self->{vtable}{options}{arrayrefs} ? $row->[$idxCol] - : $self->{vtable}{options}{hashrefs} ? - $row->{$self->{vtable}{headers}[$idxCol]} - : $self->{vtable}{options}{colref} ? $row - : die "corrupted data in ->{options}"; + my $opts = $self->{vtable}{options}; + return $opts->{arrayrefs} ? $row->[$idxCol] + : $opts->{hashrefs} ? $row->{$self->{vtable}{headers}[$idxCol]} + : $opts->{colref} ? $row + : die "corrupted data in ->{options}"; } sub ROWID { @@ -277,29 +285,162 @@ column declarations, but with an '=' sign. The only authorized (and mandatory) parameter is the one that specifies the Perl datastructure to which the virtual table is bound. -The Perl data must be given as a fully qualified name of a global variable; -it can be one of three different kinds : +It must be given as the fully qualified name of a global variable; +the parameter can be one of three different kinds : =over =item C -arrayref that contains an arrayref for each row +arrayref that contains an arrayref for each row. +Each such row will have a size equivalent to the number +of columns declared for the virtual table. =item C -arrayref that contains a hashref for each row +arrayref that contains a hashref for each row. +Keys in each hashref should correspond to the +columns declared for the virtual table. =item C -arrayref that contains a single scalar for each row -(obviously this is a single-column virtual table) +arrayref that contains a single scalar for each row; +obviously, this is a single-column virtual table. =back =head1 USAGE -[TODO] +=head2 Common part of all examples : declaring the module + +In all examples below, the common part is that the Perl +program should connect to the database and then declare the +C virtual table module, like this + + # connect to the database + my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", '', '', + {RaiseError => 1, AutoCommit => 1}); + # or any other options suitable to your needs + + # register the module + $dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData"); + +Then create a global arrayref variable, using C instead of C, +so that the variable is stored in the symbol table of the enclosing module. + + package Foo::Bar; # could as well be just "main" + our $rows = [ ... ]; + +Finally, create the virtual table and bind it to the global +variable (here we assume that C<@$rows> contains arrayrefs) : + + $dbh->do('CREATE VIRTUAL TABLE temp.vtab' + .' USING perl(col1 INT, col2 TEXT, etc, + arrayrefs="Foo::Bar::rows'); + +In most cases, the virtual table will be for temporary use, which is +the reason why this example prepends C in front of the table +name : this tells SQLite to cleanup that table when the database +handle will be disconnected, without the need to emit an explicit DROP +statement. + +Column names (and optionally their types) are specified in the +virtual table declaration, just like for any regular table. + +=head2 Arrayref example : statistics from files + +Let's suppose we want to perform some searches over a collection of +files, where search constraints may be based on some of the fields +returned by L, such as the size of the file or its last modify +time. Here is a way to do it with a virtual table : + + my @files = ... ; # list of files to inspect + + # apply the L function to each file + our $file_stats = [ map {($_, stat $_)} @files]; + + # create a temporary virtual table + $dbh->do(<<""); + CREATE VIRTUAL TABLE temp.file_stats' + USING perl(path, dev, ino, mode, nlink, uid, gid, rdev, size, + atime, mtime, ctime, blksize, blocks, + arrayrefs="main::file_stats"); + + # search files + my $sth = $dbh->prepare(<<""); + SELECT * FROM file_stats + WHERE mtime BETWEEN ? AND ? + AND uid IN (...) + +=head2 Hashref example : unicode characters + +Given any unicode character, the L function +returns a hashref with various bits of information about that character. +So this can be exploited in a virtual table : + + use Unicode::UCD 'charinfo'; + our $chars = [map {charinfo($_)} 0x300..0x400]; # arbitrary subrange + + # create a temporary virtual table + $dbh->do(<<""); + CREATE VIRTUAL TABLE charinfo USING perl( + code, name, block, script, category, + hashrefs="main::chars" + ) + + # search characters + my $sth = $dbh->prepare(<<""); + SELECT * FROM charinfo + WHERE script='Greek' + AND name LIKE '%SIGMA%' + + +=head2 Colref example: SELECT WHERE ... IN ... + +I file in SQLite's source +(L).> + +A C virtual table is designed to facilitate using an +array of values as the right-hand side of an IN operator. The +usual syntax for IN is to prepare a statement like this: + + SELECT * FROM table WHERE x IN (?,?,?,...,?); + +and then bind individual values to each of the ? slots; but this has +the disadvantage that the number of values must be known in +advance. Instead, we can store values in a Perl array, bind that array +to a virtual table, and then write a statement like this + + SELECT * FROM table WHERE x IN perl_array; + +Here is how such a program would look like : + + # connect to the database + my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", '', '', + {RaiseError => 1, AutoCommit => 1}); + + # Declare a global arrayref containing the values. Here we assume + # they are taken from @ARGV, but any other datasource would do. + # Note the use of "our" instead of "my". + our $valuess = \@ARGV; + + # register the module and declare the virtual table + $dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData"); + $dbh->do('CREATE VIRTUAL TABLE temp.intarray' + .' USING perl(i INT, colref="main::values'); + + # now we can SELECT from another table, using the intarray as a constraint + my $sql = "SELECT * FROM some_table WHERE some_col IN intarray"; + my $result = $dbh->selectall_arrayref($sql); + + +Beware that the virtual table is read-write, so the statement below +would push 99 into @ARGV ! + + INSERT INTO intarray VALUES (99); + + =head1 AUTHOR diff --git a/t/virtual_table/00_base.t b/t/virtual_table/00_base.t index 89c20e1..94f17c0 100644 --- a/t/virtual_table/00_base.t +++ b/t/virtual_table/00_base.t @@ -7,10 +7,9 @@ BEGIN { use t::lib::Test qw/connect_ok/; use Test::More; -# use Test::NoWarnings; -use DBI qw(:sql_types); +use Test::NoWarnings; -plan tests => 9; +plan tests => 10; my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 ); diff --git a/t/virtual_table/10_filecontent.t b/t/virtual_table/10_filecontent.t index 4b9fae7..123b4c6 100644 --- a/t/virtual_table/10_filecontent.t +++ b/t/virtual_table/10_filecontent.t @@ -9,7 +9,6 @@ BEGIN { use t::lib::Test qw/connect_ok/; use Test::More; use Test::NoWarnings; -use DBI qw(:sql_types); use FindBin; plan tests => 13; diff --git a/t/virtual_table/20_perldata.t b/t/virtual_table/20_perldata.t index b16f8ce..3043f64 100644 --- a/t/virtual_table/20_perldata.t +++ b/t/virtual_table/20_perldata.t @@ -9,7 +9,6 @@ BEGIN { use t::lib::Test qw/connect_ok/; use Test::More; use Test::NoWarnings; -use DBI qw(:sql_types); use FindBin; our $perl_rows = [ @@ -18,7 +17,7 @@ our $perl_rows = [ [7, 8, 'nine' ], ]; -plan tests => 24; +plan tests => 29; my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 ); @@ -101,5 +100,22 @@ is_deeply $integers, [1 .. 10, 98, 99], "added 2 ints"; $integers = [ 1, 7 ]; $sql = "SELECT a FROM vtb WHERE a IN intarray"; $res = $dbh->selectcol_arrayref($sql); -is_deeply $res, [ 1, 7 ], "intarray as a virtual table"; +is_deeply $res, [ 1, 7 ], "IN intarray"; + +# same thing with strings +our $strings = [qw/one two three/]; +ok $dbh->do(<<""), "create vtable strarray"; + CREATE VIRTUAL TABLE strarray USING perl(str TEXT, colref="main::strings") + +$sql = "INSERT INTO strarray VALUES ('aa'), ('bb')"; +ok $dbh->do($sql), $sql; +is_deeply $strings, [qw/one two three aa bb/], "added 2 strings"; + +$sql = "SELECT a FROM vtb WHERE c IN strarray"; +$res = $dbh->selectcol_arrayref($sql); +is_deeply $res, [ 1 ], "IN strarray"; + +$sql = "SELECT a FROM vtb WHERE c IN (SELECT str FROM strarray WHERE str > 'a')"; +$res = $dbh->selectcol_arrayref($sql); +is_deeply $res, [ 1 ], "IN SELECT FROM strarray";