diff --git a/MANIFEST b/MANIFEST index 070eea5..cd65896 100644 --- a/MANIFEST +++ b/MANIFEST @@ -121,6 +121,7 @@ t/virtual_table/10_filecontent.t t/virtual_table/11_filecontent_fulltext.t t/virtual_table/20_perldata.t t/virtual_table/21_perldata_charinfo.t +t/virtual_table/rt_99748.t typemap util/getsqlite.pl xt/meta.t diff --git a/lib/DBD/SQLite/VirtualTable/PerlData.pm b/lib/DBD/SQLite/VirtualTable/PerlData.pm index e7937e4..b09824a 100644 --- a/lib/DBD/SQLite/VirtualTable/PerlData.pm +++ b/lib/DBD/SQLite/VirtualTable/PerlData.pm @@ -95,8 +95,8 @@ sub BEST_INDEX { $optype = $self->{optypes}[$col]; } my $op = $SQLOP2PERLOP{$constraint->{op}}[$optype]; - my $quote = $op eq '=~' ? 'qr' : 'q'; - push @conditions, "($member $op ${quote}{%s})"; + my $quote = $op eq '=~' ? 'm' : 'q'; + push @conditions, "(defined($member) && $member $op ${quote}{%s})"; # info passed back to the SQLite core -- see vtab.html in sqlite doc $constraint->{argvIndex} = $ix++; @@ -125,7 +125,8 @@ sub _build_new_row { my $opts = $self->{options}; return $opts->{arrayrefs} ? $values - : $opts->{hashrefs} ? { map {$self->{headers}->[$_], $values->[$_]} (0 .. @{$self->{headers}} - 1) } + : $opts->{hashrefs} ? { map {$self->{headers}->[$_], $values->[$_]} + (0 .. @{$self->{headers}} - 1) } : $opts->{colref} ? $values->[0] : die "corrupted data in ->{options}"; } @@ -191,7 +192,7 @@ sub FILTER { . sprintf($idxStr, @values) . '}'; - # print STDERR $perl_code, "\n"; + # print STDERR "PERL COODE:\n", $perl_code, "\n"; $self->{is_wanted_row} = eval $perl_code or die "couldn't eval q{$perl_code} : $@"; @@ -232,7 +233,7 @@ sub COLUMN { sub ROWID { my ($self) = @_; - return $self->{row_ix}; + return $self->{row_ix} + 1; # rowids start at 1 in SQLite } @@ -421,7 +422,7 @@ Here is how such a program would look like : # 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; + our $values = \@ARGV; # register the module and declare the virtual table $dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData"); diff --git a/t/virtual_table/20_perldata.t b/t/virtual_table/20_perldata.t index 3043f64..e96b4d9 100644 --- a/t/virtual_table/20_perldata.t +++ b/t/virtual_table/20_perldata.t @@ -48,7 +48,7 @@ is $res->[1]{a}, 1, 'got 1 in second a'; $sql = "SELECT rowid FROM vtb WHERE c = 'six'"; $res = $dbh->selectall_arrayref($sql, {Slice => {}}); -is_deeply $res, [{rowid => 1}], $sql; +is_deeply $res, [{rowid => 2}], $sql; $sql = "SELECT c FROM vtb WHERE c MATCH '^.i' ORDER BY c"; $res = $dbh->selectcol_arrayref($sql); diff --git a/t/virtual_table/rt_99748.t b/t/virtual_table/rt_99748.t new file mode 100644 index 0000000..441fa5c --- /dev/null +++ b/t/virtual_table/rt_99748.t @@ -0,0 +1,101 @@ +#!/usr/bin/perl +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + + +use t::lib::Test qw/connect_ok/; +use Test::More; +use Test::NoWarnings; + +# sample data +our $perl_rows = [ + [1, 2, 'three'], + [4, undef, 'six' ], + [7, 8, undef ], +]; + +# tests for security holes. All of these fail when compiling the regex +my @interpolation_attempts = ( + '@[{die -1}]', + '$foobar', + '$self->{row_ix}', + '(?{die 999})', + '(?[die 999])', + ); + +# unfortunately the examples below don't fail, but I don't know how to +# prevent variable interpolation (that we don't want) while keeping +# character interpolation like \n, \t, etc. (that we do want) + # '@main::ARGV', + # '$0', + # '$self', + +plan tests => 25 + @interpolation_attempts; + +my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 ); + +# create a regular table so that we can compare results with the virtual table +$dbh->do("CREATE TABLE rtb(a INT, b INT, c TEXT)"); +my $sth = $dbh->prepare("INSERT INTO rtb(a, b, c) VALUES (?, ?, ?)"); +$sth->execute(@$_) foreach @$perl_rows; + +# create the virtual table +ok $dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData"), + "create_module"; +ok $dbh->do(<<""), "create vtable"; + CREATE VIRTUAL TABLE vtb USING perl(a INT, b INT, c TEXT, + arrayrefs="main::perl_rows") + +# run same tests on both the regular and the virtual table +test_table($dbh, 'rtb'); +test_table($dbh, 'vtb', 1); + + + +sub test_table { + my ($dbh, $table, $should_test_match) = @_; + + my $sql = "SELECT rowid, * FROM $table"; + my $res = $dbh->selectall_arrayref($sql, {Slice => {}}); + is scalar(@$res), 3, "$sql: got 3 rows"; + is $res->[0]{a}, 1, 'got 1 in a'; + is $res->[0]{b}, 2, 'got undef in b'; + + $sql = "SELECT a FROM $table WHERE b < 8 ORDER BY a"; + $res = $dbh->selectcol_arrayref($sql); + is scalar(@$res), 1, "$sql: got 1 row"; + is_deeply $res, [1], "got 1 in a"; + + $sql = "SELECT rowid FROM $table WHERE c = 'six'"; + $res = $dbh->selectall_arrayref($sql, {Slice => {}}); + is_deeply $res, [{rowid => 2}], $sql; + + $sql = "SELECT a FROM $table WHERE b IS NULL ORDER BY a"; + $res = $dbh->selectcol_arrayref($sql); + is_deeply $res, [4], $sql; + + $sql = "SELECT a FROM $table WHERE b IS NOT NULL ORDER BY a"; + $res = $dbh->selectcol_arrayref($sql); + is_deeply $res, [1, 7], $sql; + + $sql = "SELECT a FROM $table WHERE c IS NULL ORDER BY a"; + $res = $dbh->selectcol_arrayref($sql); + is_deeply $res, [7], $sql; + + $sql = "SELECT a FROM $table WHERE c IS NOT NULL ORDER BY a"; + $res = $dbh->selectcol_arrayref($sql); + is_deeply $res, [1, 4], $sql; + + if ($should_test_match) { + $sql = "SELECT c FROM $table WHERE c MATCH '^.i' ORDER BY c"; + $res = $dbh->selectcol_arrayref($sql); + is_deeply $res, [qw/six/], $sql; + + $sql = "SELECT c FROM $table WHERE c MATCH ? ORDER BY c"; + ok !eval{$dbh->selectcol_arrayref($sql, {}, $_); 1}, $_ # "$_ : $@" + foreach @interpolation_attempts; + } +}