#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok $sqlite_call has_sqlite/;
use Test::More;
use Test::NoWarnings;
# tests that the MATCH operator does not allow code injection
my @interpolation_attempts = (
'@{[die -1]}',
'(foobar', # will die - incorrect regex
'(?{die 999})', # will die - Eval-group not allowed at runtime
'$foobar',
'$self->{row_ix}',
'$main::ARGV[ die 999 ]',
'@main::ARGV',
'$0',
'$self',
);
# sample data
our $perl_rows = [
[1, 2, 'three'],
[4, undef, 'six' ],
[7, 8, undef ],
[10, undef, '}'],
[11, undef, '\}'],
[12, undef, "data\nhas\tspaces"],
];
my $tests = 14;
$tests += 1 if has_sqlite('3.6.19');
plan tests => 4 + 2 * $tests + @interpolation_attempts + 9;
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_call(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');
# the match operator only works on the virtual table
test_match_operator($dbh, 'vtb');
sub test_table {
my ($dbh, $table) = @_;
my $sql = "SELECT rowid, * FROM $table";
my $res = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$res), scalar(@$perl_rows), "$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_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, 10, 11, 12], $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, 10, 11, 12], $sql;
$sql = "SELECT a FROM $table WHERE c = ?";
$res = $dbh->selectcol_arrayref($sql, {}, '}');
is_deeply $res, [10], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '\}');
is_deeply $res, [11], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '\\');
is_deeply $res, [], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '{');
is_deeply $res, [], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, undef);
is_deeply $res, [], $sql;
if (has_sqlite('3.6.19')) {
$sql = "SELECT a FROM $table WHERE c IS ?";
$res = $dbh->selectcol_arrayref($sql, {}, undef);
is_deeply $res, [7], $sql;
}
}
sub test_match_operator {
my ($dbh, $table) = @_;
my $sql = "SELECT c FROM $table WHERE c MATCH '^.i' ORDER BY c";
my $res = $dbh->selectcol_arrayref($sql);
is_deeply $res, [qw/six/], $sql;
$sql = "SELECT c FROM $table WHERE c MATCH ? ORDER BY c";
is_deeply $dbh->selectcol_arrayref($sql, {}, $_) => [], $_
foreach @interpolation_attempts;
$sql = "SELECT a FROM $table WHERE c MATCH ?";
$res = $dbh->selectcol_arrayref($sql, {}, '}');
is_deeply $res, [10, 11], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '\}');
is_deeply $res, [10, 11], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '\\\\}');
is_deeply $res, [11], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '\\\\');
is_deeply $res, [11], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, "\n");
is_deeply $res, [12], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, "\t");
is_deeply $res, [12], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '{');
is_deeply $res, [], $sql;
$res = $dbh->selectcol_arrayref($sql, {}, '$x[$y]');
is_deeply $res, [], $sql;
}