# Tests of SQL::Interpolate use strict; use warnings; use Test::More 'no_plan'; use SQL::Interpolate qw(:all); use SQL::Interpolate::Macro qw(:all); use Data::Dumper; BEGIN {require 't/lib.pl';} # test of use parameters BEGIN { use_ok('SQL::Interpolate', ':all', TRACE_SQL => 0, TRACE_FILTER => 0, FILTER => 0); # 0.3 } my $interp = new SQL::Interpolate; my $sql_interp = $interp->make_sql_interp(); my $sql_interp2 = make_sql_interp(); my $x = 5; my $y = 6; my $v0 = []; my $v = ['one', 'two']; my $v2 = ['one', sql('two')]; my $h0 = {}; my $h = {one => 1, two => 2}; my $hi = make_hash_info($h); my $var1 = sql_var(\$x); my $var2 = sql_var(\$x, type => 1); my $h2i = make_hash_info( { one => 1, two => $var2, three => sql('3') }, { one => '?', two => '?', three => '3' }, { one => [[1, sql_var(\1)]], two => [[${$var2->{value}}, $var2]] } ); # Returns structure containing info on the hash. # This info is useful in the sql_interp tests. # Note: Perl does not define an ordering on hash keys, so these tests # take care not to assume a particular order. sub make_hash_info { my ($hashref, $place_of, $bind_of) = @_; my $info = { hashref => $hashref, keys => [ keys %$hashref ], values => [ values %$hashref ], places => [ @$place_of{keys %$hashref} ], binds => [ map {defined $_ ? @$_ : ()} @$bind_of{ grep { exists $bind_of->{$_} } keys %$hashref} ] }; return $info; } # returns the values in the given hash ordered by the given keys. # Helper function for the sql_interp tests. sub order_keyed_values { my ($ordered_keys, %value_for) = @_; my @values = @value_for{@$ordered_keys}; return @values; } # trivial macro that expands identically to its parameter list { package IdentityMacro; use base 'SQL::Interpolate::Macro'; sub new { my($class, @list) = @_; return bless \@list, $class; } sub expand { return @{ $_[0] }; } } sub identity_macro { return IdentityMacro->new(@_); } #== trivial cases interp_test([], [''], 'empty'); interp_test(['SELECT * FROM mytable'], ['SELECT * FROM mytable'], 'string'); interp_test([\$x], [' ?', $x], 'scalarref'); interp_test([sql()], [''], 'sql()'); interp_test([SQL::Interpolate::SQL->new(\$x)], [' ?', $x], 'SQL::Interpolate::SQL->new(scalarref)'); # improve: call with with macros disabled # test with sql() interp_test([sql('test')], ['test'], 'sql(string))'); interp_test([sql(sql(\$x))], [' ?', $x], 'sql(sql(scalarref))'); interp_test([sql(sql(),sql())], [''], 'sql(sql(),sql())'); #== INSERT interp_test(['INSERT INTO mytable', \$x], ['INSERT INTO mytable VALUES(?)', $x], 'INSERT scalarref'); interp_test(['INSERT INTO mytable', sql($x)], ["INSERT INTO mytable $x"], # invalid 'INSERT sql(...)'); # OK in mysql interp_test(['INSERT INTO mytable', $v0], ['INSERT INTO mytable VALUES()'], 'INSERT arrayref of size = 0'); interp_test(['INSERT INTO mytable', $v], ['INSERT INTO mytable VALUES(?, ?)', @$v], 'INSERT arrayref of size > 0'); interp_test(['INSERT INTO mytable', $v2], ['INSERT INTO mytable VALUES(?, two)', 'one'], 'INSERT arrayref of size > 0 with sql()'); interp_test(['INSERT INTO mytable', [1, sql(\$x, '*', \$x)]], ['INSERT INTO mytable VALUES(?, ? * ?)', 1, $x, $x], 'INSERT arrayref of size > 0 with macro'); # OK in mysql interp_test(['INSERT INTO mytable', $h0], ['INSERT INTO mytable () VALUES()'], 'INSERT hashref of size = 0'); interp_test(['INSERT INTO mytable', $h], ["INSERT INTO mytable ($hi->{keys}[0], $hi->{keys}[1]) VALUES(?, ?)", @{$hi->{values}}], 'INSERT hashref of size > 0'); interp_test(['INSERT INTO mytable', $h2i->{hashref}], ["INSERT INTO mytable ($h2i->{keys}[0], $h2i->{keys}[1], $h2i->{keys}[2]) " . "VALUES($h2i->{places}->[0], $h2i->{places}->[1], $h2i->{places}->[2])", @{$h2i->{binds}}], 'INSERT hashref of sql_var + sql()'); interp_test(['INSERT INTO mytable', {one => 1, two => sql(\$x, '*', \$x)}], ['INSERT INTO mytable (one, two) VALUES(?, ? * ?)', 1, $x, $x], 'INSERT hashref with macro'); # mysql interp_test(['INSERT HIGH_PRIORITY IGNORE INTO mytable', $v], ['INSERT HIGH_PRIORITY IGNORE INTO mytable VALUES(?, ?)', @$v], 'INSERT [mod] arrayref of size > 0'); # IN # note: 'WHERE field in ()' NOT OK in mysql. interp_test(['WHERE field IN', \$x], ['WHERE field IN (?)', $x], 'IN scalarref'); interp_test(['WHERE field IN', sql($x)], ["WHERE field IN $x"], # invalid 'IN sql()'); interp_test(['WHERE field IN', $v0], ['WHERE 1=0'], 'IN arrayref of size = 0'); interp_test(['WHERE field IN', $v], ['WHERE field IN (?, ?)', @$v], 'IN arrayref of size > 0'); interp_test(['WHERE field IN', $v2], ['WHERE field IN (?, two)', 'one'], 'IN arrayref with sql()'); interp_test(['WHERE field IN', [1, sql(\$x, '*', \$x)]], ['WHERE field IN (?, ? * ?)', 1, $x, $x], 'IN arrayref with macro'); interp_test(['WHERE', {field => $v}], ['WHERE field IN (?, ?)', 'one', 'two'], 'hashref with arrayref'); interp_test(['WHERE', {field => $v0}], ['WHERE 1=0'], 'hashref with arrayref of size = 0'); interp_test(['WHERE', {field => [1, sql(\$x, '*', \$x)]}], ['WHERE field IN (?, ? * ?)', 1, $x, $x], 'hashref with arrayref with macro'); interp_test(['WHERE field in', $v0], ['WHERE 1=0'], 'IN lowercase'); # fails in 0.31 # SET interp_test(['UPDATE mytable SET', $h], ["UPDATE mytable SET $hi->{keys}[0]=?, $hi->{keys}[1]=?", @{$hi->{values}}], 'SET hashref'); interp_test(['UPDATE mytable SET', {one => 1, two => $var2, three => sql('3')}], ['UPDATE mytable SET three=3, one=?, two= ?', [1, sql_var(\1)], [${$var2->{value}}, $var2]], 'SET hashref of sql_var types, sql()'); #FIX--what if size of hash is zero? error? # WHERE hashref interp_test(['WHERE', $h0], ['WHERE 1=1'], 'WHERE hashref of size = 0'); interp_test(['WHERE', $h], ["WHERE ($hi->{keys}[0]=? AND $hi->{keys}[1]=?)", @{$hi->{values}}], 'WHERE hashref of size > 0'); my $h2bi = make_hash_info( {x => 1, y => sql('2')}, {x => 'x=?', y => 'y=2'}, {x => [1]} ); interp_test(['WHERE', $h2bi->{hashref}], ["WHERE ($h2bi->{places}[0] AND $h2bi->{places}[1])", @{$h2bi->{binds}}], 'WHERE hashref sql()'); my $h2ci = make_hash_info( {x => 1, y => undef}, {x => 'x=?', y => 'y IS NULL'}, {x => [1]} ); interp_test(['WHERE', $h2ci->{hashref}], ["WHERE ($h2ci->{places}[0] AND $h2ci->{places}[1])", @{$h2ci->{binds}}], 'WHERE hashref of NULL'); # WHERE x= interp_test(['WHERE x=', \$x], ['WHERE x= ?', $x], 'WHERE x=scalarref'); # sql_var interp_test(['WHERE x=', \$x, 'AND', 'y=', sql_var(\$y)], ['WHERE x= ? AND y= ?', $x, $y], 'WHERE \$x, sql_var'); interp_test(['WHERE x=', \$x, 'AND', 'y=', $var2], ['WHERE x= ? AND y= ?', [$x, sql_var(\$x)], [${$var2->{value}}, $var2]], 'WHERE \$x, sql_var typed'); interp_test(['WHERE', {x => $x, y => $var2}, 'AND z=', \$x], ['WHERE (y= ? AND x=?) AND z= ?', [${$var2->{value}}, $var2], [$x, sql_var(\$x)], [$x, sql_var(\$x)]], 'WHERE hashref of \$x, sql_var typed'); my $h5i = make_hash_info( {x => $x, y => [3, $var2]}, {x => 'x=?', y => 'y IN (?, ?)'}, {x => [[$x, sql_var(\$x)]], y => [[3, sql_var(\3)], [${$var2->{value}}, $var2]]} ); interp_test(['WHERE', $h5i->{hashref}], ["WHERE ($h5i->{places}[0] AND $h5i->{places}[1])", @{$h5i->{binds}}], 'WHERE hashref of arrayref of sql_var typed'); interp_test(['WHERE', {x => $x, y => sql('z')}], ['WHERE (y=z AND x=?)', $x], 'WHERE hashref of \$x, sql()'); # table references error_test(['FROM', []], qr/table reference has zero rows/, 'v 0'); error_test(['FROM', [[]]], qr/table reference has zero columns/, 'vv 1 0'); error_test(['', [[]]], qr/table reference has zero columns/, 'vv 1 0 (resultset)'); error_test(['FROM', [{}]], qr/table reference has zero columns/, 'vh 1 0'); error_test(['', [{}]], qr/table reference has zero columns/, 'vh 1 0 (resultset)'); interp_test(['FROM', [[1]]], ['FROM (SELECT ?) AS tbl0', 1], 'vv 1 1'); interp_test(['', [[1]]], ['(SELECT ?)', 1], 'vv 1 1 (resultset)'); interp_test(['FROM', [{a => 1}]], ['FROM (SELECT ? AS a) AS tbl0', 1], 'vh 1 1'); interp_test(['', [{a => 1}]], ['(SELECT ? AS a)', 1], 'vh 1 1 (resultset)'); interp_test(['FROM', [[1,2]]], ['FROM (SELECT ?, ?) AS tbl0', 1, 2], 'vv 1 2'); interp_test(['FROM', [$h]], ["FROM (SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1]) AS tbl0", @{$hi->{values}}], 'vh 1 2'); interp_test(['', [$h]], ["(SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1])", @{$hi->{values}}], 'vh 1 2 (resultset)'); interp_test(['FROM', [[1,2],[3,4]]], ['FROM (SELECT ?, ? UNION ALL SELECT ?, ?) AS tbl0', 1, 2, 3, 4], 'vv 2 2'); interp_test(['', [[1,2],[3,4]]], ['(SELECT ?, ? UNION ALL SELECT ?, ?)', 1, 2, 3, 4], 'vv 2 2 (resultset)'); interp_test(['FROM', [$h,$h]], ["FROM (SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1] UNION ALL SELECT ?, ?) AS tbl0", @{$hi->{values}}, @{$hi->{values}}], 'vh 2 2'); interp_test(['', [$h,$h]], ["(SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1] UNION ALL SELECT ?, ?)", @{$hi->{values}}, @{$hi->{values}}], 'vh 2 2 (resultset)'); interp_test(['FROM', [[1]], 'JOIN', [[2]]], ['FROM (SELECT ?) AS tbl0 JOIN (SELECT ?) AS tbl1', 1, 2], 'vv 1 1 join vv 1 1'); interp_test(['FROM', [[sql(1)]]], ['FROM (SELECT 1) AS tbl0'], 'vv 1 1 of sql(1)'); interp_test(['', [[sql(1)]]], ['(SELECT 1)'], 'vv 1 1 of sql(1) (resultset)'); interp_test(['FROM', [{a => sql(1)}]], ['FROM (SELECT 1 AS a) AS tbl0'], 'vh 1 1 of sql(1)'); interp_test(['FROM', [[sql(\1)]]], ['FROM (SELECT ?) AS tbl0', 1], 'vv 1 1 of sql(\1)'); interp_test(['FROM', [[sql('1=', \1)]]], ['FROM (SELECT 1= ?) AS tbl0', 1], 'vv 1 1 of sql(s,\1)'); interp_test(['FROM', [ identity_macro([1,2]) ] ], ['FROM (SELECT ?, ?) AS tbl0', 1, 2], 'v of identity_macro(v 2)'); interp_test(['FROM', [ identity_macro($h) ] ], ["FROM (SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1]) AS tbl0", @{$hi->{values}}], 'v of identity_macro(h 2)'); interp_test(['FROM', [ [identity_macro(1),2] ] ], ['FROM (SELECT ?, ?) AS tbl0', 1, 2], 'vv 1 2 of identity_macro'); interp_test(['FROM', [[1]], ' AS mytable'], ['FROM (SELECT ?) AS mytable', 1], 'vv 1 1 with alias'); interp_test(['FROM', [[undef]]], ['FROM (SELECT ?) AS tbl0', undef], 'vv 1 1 of undef'); interp_test(['FROM', [{a => undef}]], ['FROM (SELECT ? AS a) AS tbl0', undef], 'vh 1 1 of undef'); # error handling #OLD: error_test(['SELECT', []], qr/unrecognized.*array.*select/i, 'err1'); #OLD: error_test(['IN', {}], qr/unrecognized.*hash.*in/i, 'err2'); sub interp_test { my($snips, $expect, $name) = @_; # print Dumper([sql_interp @$snips], $expect); # custom filter my $func = sub { return [@_]; }; my $test = \&my_deeply; if(ref($expect) eq 'ARRAY' && @$expect > 0 && ref($expect->[0]) eq 'CODE') { $func = shift @$expect; $expect = $expect->[0]; $test = \&like; } $test->($func->(sql_interp @$snips), $expect, $name); $test->($func->($interp->sql_interp(@$snips)), $expect, "$name OO"); $test->($func->($sql_interp->(@$snips)), $expect, "$name closure"); $test->($func->($sql_interp2->(@$snips)), $expect, "$name closure2"); } sub error_test { my($list, $re, $name) = @_; eval { sql_interp @$list; }; like($@, $re, $name); }