diff --git a/dbdimp_virtual_table.inc b/dbdimp_virtual_table.inc index 3f87619..518de0b 100644 --- a/dbdimp_virtual_table.inc +++ b/dbdimp_virtual_table.inc @@ -47,6 +47,44 @@ static int _call_perl_vtab_method(sqlite3_vtab *pVTab, } +/* RT-124941: it seems better to prefer PV where appropriate */ +static void +sqlite_set_result_for_vtable(pTHX_ sqlite3_context *context, SV *result, int is_error) +{ + STRLEN len; + char *s; + sqlite3_int64 iv; + + if ( is_error ) { + s = SvPV(result, len); + sqlite3_result_error( context, s, len ); + return; + } + + /* warn("result: %s\n", SvPV_nolen(result)); */ + if ( !SvOK(result) ) { + sqlite3_result_null( context ); + } else if ( SvPOK(result) ) { + s = SvPV(result, len); + sqlite3_result_text( context, s, len, SQLITE_TRANSIENT ); + } else if( SvIOK_UV(result) ) { + if ((UV)(sqlite3_int64)UV_MAX == UV_MAX) + sqlite3_result_int64( context, (sqlite3_int64)SvUV(result)); + else { + s = SvPV(result, len); + sqlite3_result_text( context, s, len, SQLITE_TRANSIENT ); + } + } else if ( !_sqlite_atoi64(SvPV(result, len), &iv) ) { + sqlite3_result_int64( context, iv ); + } else if ( SvNOK(result) && ( sizeof(NV) == sizeof(double) || SvNVX(result) == (double) SvNVX(result) ) ) { + sqlite3_result_double( context, SvNV(result)); + } else { + s = SvPV(result, len); + sqlite3_result_text( context, s, len, SQLITE_TRANSIENT ); + } +} + + static int perl_vt_New(const char *method, sqlite3 *db, void *pAux, @@ -499,7 +537,7 @@ static int perl_vt_Column(sqlite3_vtab_cursor *pVtabCursor, } else { SV *result = POPs; - sqlite_set_result(aTHX_ context, result, 0 ); + sqlite_set_result_for_vtable(aTHX_ context, result, 0 ); rc = SQLITE_OK; } diff --git a/t/virtual_table/rt_124941.t b/t/virtual_table/rt_124941.t new file mode 100644 index 0000000..5221ab5 --- /dev/null +++ b/t/virtual_table/rt_124941.t @@ -0,0 +1,95 @@ +#!/usr/bin/perl +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use lib "t/lib"; +use SQLiteTest qw/connect_ok $sqlite_call has_sqlite/; +use Test::More tests => 6; +use Test::NoWarnings; + +my $dbh = connect_ok(sqlite_trace => 2); +# register the module and declare the virtual table +$dbh->sqlite_create_module(perl => "DBD::SQLite::VirtualTable::PerlData"); + +# create a table, reference_values, with 2 columns +# ref_value - a text column which will have strings and numeric data (as text) +# our_id - a numeric column with integers +$dbh->do('DROP TABLE IF EXISTS reference_values'); +$dbh->do('CREATE TABLE reference_values(ref_value text, our_id int)'); + +my @data_to_insert = ( + [ 'aaaa', 1 ], + [ 'bbbb', 2 ], + [ 'cccc', 3 ], + [ 'xxxx', 4 ], + [ 'yyyy', 5 ], + [ '0003', 6 ], + [ '1000', 7 ], + [ '2222', 8 ], + [ '3000', 9 ], + [ '4000', 10 ], + [ '5abc', 11 ], + [ 'a6cd', 12 ], + [ 'ab7d', 13 ], + [ 'abc8', 14 ], + [ '9aaa', 15 ], +); + +my $sth = $dbh->prepare('INSERT INTO reference_values VALUES (?, ?)'); +foreach my $data_aref (@data_to_insert) { + $sth->execute(@$data_aref) or die "Couldn't insert data row:" . $dbh->errstr; +} + +# these are data sets that will be used by the virtual perldata function +# we'll add these as a virtual table then do an inner join on our reference_value +# table to find matching values +my $text_column_search_sets = { + strings_only => [ qw( aaaa abcd bbbb bcde cccc yyyy ) ], + mixed => [ qw( aaaa 0003 z8z8 6666 cccc 1000 zzzz 7777 ) ], + initial_digit => [ qw( 1aaa 2bbb 5abc 6abc 9aaa 3aaa 1aaa 2aaa ) ], + numbers_only => [ qw( 0001 0003 9999 1000 5555 3000 6666 4000 ) ] , +}; + +my $expected_answers = { + strings_only => + [ [ 'aaaa', 1 ], [ 'bbbb', 2 ], [ 'cccc', 3 ], [ 'yyyy', 5 ] ], + mixed => [ [ 'aaaa', 1 ], [ 'cccc', 3 ], [ '0003', 6 ], [ '1000', 7 ] ], + initial_digit => [ [ '5abc', 11 ], [ '9aaa', 15 ] ], + numbers_only => + [ [ '0003', 6 ], [ '1000', 7 ], [ '3000', 9 ], [ '4000', 10 ] ] +}; + +our $search_value_set; +my $temp_table_number = 0; + +my @test_order = qw(strings_only mixed initial_digit numbers_only ); + +foreach my $test_desc (@test_order) { + + $temp_table_number++; + my $temp_table_name = 'temp.lookup_values_' . $temp_table_number; + $search_value_set = $text_column_search_sets->{$test_desc}; +note explain $search_value_set; + + my $virt_table_sql =<< "EOT"; + CREATE VIRTUAL TABLE $temp_table_name + USING perl(lookup_value text, colref="main::search_value_set") +EOT + + $dbh->do($virt_table_sql); + + my $lookup_sql =<< "EOT"; + select ref_value, our_id from reference_values + inner join $temp_table_name + on $temp_table_name.lookup_value = reference_values.ref_value + order by our_id +EOT + + my $got_aref = $dbh->selectall_arrayref($lookup_sql); + my $expected_aref = $expected_answers->{$test_desc}; + + is_deeply($got_aref, $expected_aref, $test_desc); +}