1# Tests of SQL::Interp 2 3use strict; 4use warnings; 5use Test::More 'no_plan'; 6use SQL::Interp ':all'; 7use Data::Dumper; 8BEGIN {require 't/lib.pl';} 9 10# test of use parameters 11BEGIN { 12 use_ok('SQL::Interp', 13 ':all' ); # 0.3 14} 15 16my $interp = SQL::Interp->new; 17 18my $x = 5; 19my $y = 6; 20my $v0 = []; 21my $v = ['one', 'two']; 22my $v2 = ['one', sql('two')]; 23my $h0 = {}; 24 25my $h = {one => 1, two => 2}; 26my $hi = make_hash_info($h); 27 28my $var1 = sql_type(\$x); 29my $var2 = sql_type(\$x, type => 1); 30 31my $h2i = make_hash_info( 32 { one => 1, two => $var2, three => sql('3') }, 33 { one => '?', two => '?', three => '3' }, 34 { one => [[1, sql_type(\1)]], two => [[${$var2->{value}}, $var2]] } 35); 36 37# Returns structure containing info on the hash. 38# This info is useful in the sql_interp tests. 39# Note: Perl does not define an ordering on hash keys, so these tests 40# take care not to assume a particular order. 41sub make_hash_info { 42 my ($hashref, $place_of, $bind_of) = @_; 43 my $info = { 44 hashref => $hashref, 45 keys => [ sort keys %$hashref ], 46 values => [ map { $hashref->{$_} } sort keys %$hashref ], 47 places => [ @$place_of{sort keys %$hashref} ], 48 binds => [ map {defined $_ ? @$_ : ()} 49 @$bind_of{ grep { exists $bind_of->{$_} } sort keys %$hashref} ] 50 }; 51 return $info; 52} 53 54# returns the values in the given hash ordered by the given keys. 55# Helper function for the sql_interp tests. 56sub order_keyed_values { 57 my ($ordered_keys, %value_for) = @_; 58 my @values = @value_for{@$ordered_keys}; 59 return @values; 60} 61 62#== trivial cases 63interp_test([], 64 [''], 65 'empty'); 66interp_test(['SELECT * FROM mytable'], 67 ['SELECT * FROM mytable'], 68 'string'); 69interp_test([\$x], 70 [' ?', $x], 71 'scalarref'); 72interp_test([sql()], 73 [''], 74 'sql()'); 75interp_test([SQL::Interp::SQL->new(\$x)], 76 [' ?', $x], 77 'SQL::Interp::SQL->new(scalarref)'); 78 79# improve: call with with macros disabled 80 81# test with sql() 82interp_test([sql('test')], 83 ['test'], 84 'sql(string))'); 85interp_test([sql(sql(\$x))], 86 [' ?', $x], 87 'sql(sql(scalarref))'); 88interp_test([sql(sql(),sql())], 89 [''], 90 'sql(sql(),sql())'); 91 92#== SELECT 93interp_test(['SELECT', \$x], 94 ['SELECT ?', $x], 95 'SELECT scalarref'); 96interp_test(['SELECT 1 IS DISTINCT FROM', \$x], 97 ['SELECT 1 IS DISTINCT FROM ?', $x], 98 'SELECT DISTINCT FROM'); 99 100#== INSERT 101interp_test(['INSERT INTO mytable', \$x], 102 ['INSERT INTO mytable VALUES(?)', $x], 103 'INSERT scalarref'); 104interp_test(['REPLACE INTO mytable', \$x], 105 ['REPLACE INTO mytable VALUES(?)', $x], 106 'REPLACE INTO'); 107interp_test(['INSERT INTO mytable', sql($x)], 108 ["INSERT INTO mytable $x"], # invalid 109 'INSERT sql(...)'); 110interp_test(['INSERT INTO `My Table`', \$x], 111 ['INSERT INTO `My Table` VALUES(?)', $x], 112 'INSERT backtick-quotes'); 113interp_test(['INSERT INTO "My Table"', \$x], 114 ['INSERT INTO "My Table" VALUES(?)', $x], 115 'INSERT double-quotes'); 116# OK in mysql 117interp_test(['INSERT INTO mytable', $v0], 118 ['INSERT INTO mytable VALUES()'], 119 'INSERT arrayref of size = 0'); 120interp_test(['INSERT INTO mytable', $v], 121 ['INSERT INTO mytable VALUES(?, ?)', @$v], 122 'INSERT arrayref of size > 0'); 123interp_test(['INSERT INTO mytable', $v2], 124 ['INSERT INTO mytable VALUES(?, two)', 'one'], 125 'INSERT arrayref of size > 0 with sql()'); 126interp_test(['INSERT INTO mytable', [1, sql(\$x, '*', \$x)]], 127 ['INSERT INTO mytable VALUES(?, ? * ?)', 1, $x, $x], 128 'INSERT arrayref of size > 0 with macro'); 129# OK in mysql 130interp_test(['INSERT INTO mytable', $h0], 131 ['INSERT INTO mytable () VALUES()'], 132 'INSERT hashref of size = 0'); 133interp_test(['INSERT INTO mytable', $h], 134 ["INSERT INTO mytable ($hi->{keys}[0], $hi->{keys}[1]) VALUES(?, ?)", 135 @{$hi->{values}}], 136 'INSERT hashref of size > 0'); 137interp_test(['INSERT INTO mytable', $h2i->{hashref}], 138 ["INSERT INTO mytable ($h2i->{keys}[0], $h2i->{keys}[1], $h2i->{keys}[2]) " . 139 "VALUES($h2i->{places}->[0], $h2i->{places}->[1], $h2i->{places}->[2])", 140 @{$h2i->{binds}}], 141 'INSERT hashref of sql_type + sql()'); 142interp_test(['INSERT INTO mytable', {one => 1, two => sql(\$x, '*', \$x)}], 143 ['INSERT INTO mytable (one, two) VALUES(?, ? * ?)', 1, $x, $x], 144 'INSERT hashref with macro'); 145# mysql 146interp_test(['INSERT HIGH_PRIORITY IGNORE INTO mytable', $v], 147 ['INSERT HIGH_PRIORITY IGNORE INTO mytable VALUES(?, ?)', @$v], 148 'INSERT [mod] arrayref of size > 0'); 149 150# IN 151# note: 'WHERE field in ()' NOT OK in mysql. 152interp_test(['WHERE field IN', \$x], 153 ['WHERE field IN (?)', $x], 154 'IN scalarref'); 155 156my $maybe_array = [1,2]; 157interp_test(['WHERE field IN', \$maybe_array], 158 ['WHERE field IN (?, ?)', @$maybe_array], 159 'IN maybe_array turns out to be an array'); 160 161interp_test(['WHERE field IN', sql($x)], 162 ["WHERE field IN $x"], # invalid 163 'IN sql()'); 164interp_test(['WHERE field IN', $v0], 165 ['WHERE 1=0'], 166 'IN arrayref of size = 0'); 167interp_test(['WHERE table.field IN', $v0], 168 ['WHERE 1=0'], 169 'IN qualified field name'); 170interp_test(['WHERE `My Field` IN', $v0], 171 ['WHERE 1=0'], 172 'IN backtick-quotes'); 173interp_test(['WHERE "My Field" IN', $v0], 174 ['WHERE 1=0'], 175 'IN double-quotes'); 176 177interp_test(['WHERE field NOT IN', $v0], 178 ['WHERE 1=1'], 179 'NOT IN arrayref of size = 0'); 180 181 182interp_test(['WHERE field IN', $v], 183 ['WHERE field IN (?, ?)', @$v], 184 'IN arrayref of size > 0'); 185interp_test(['WHERE field IN', $v2], 186 ['WHERE field IN (?, two)', 'one'], 187 'IN arrayref with sql()'); 188interp_test(['WHERE field IN', [1, sql(\$x, '*', \$x)]], 189 ['WHERE field IN (?, ? * ?)', 1, $x, $x], 190 'IN arrayref with macro'); 191interp_test(['WHERE', {field => $v}], 192 ['WHERE field IN (?, ?)', 'one', 'two'], 193 'hashref with arrayref'); 194interp_test(['WHERE', {field => $v0}], 195 ['WHERE 1=0'], 196 'hashref with arrayref of size = 0'); 197interp_test(['WHERE', {field => [1, sql(\$x, '*', \$x)]}], 198 ['WHERE field IN (?, ? * ?)', 1, $x, $x], 199 'hashref with arrayref with macro'); 200interp_test(['WHERE field in', $v0], 201 ['WHERE 1=0'], 202 'IN lowercase'); # fails in 0.31 203 204# ARRAY 205interp_test(['SELECT ARRAY', $maybe_array], 206 ['SELECT ARRAY[?, ?]', @$maybe_array], 207 'ARRAY'); 208interp_test(['SELECT ARRAY', \$maybe_array], 209 ['SELECT ARRAY[?, ?]', @$maybe_array], 210 'ARRAY ref'); 211interp_test(['SELECT ARRAY', \$v0], 212 ['SELECT ARRAY[]'], 213 'ARRAY empty'); 214interp_test(['SELECT ARRAY', \$x], 215 ['SELECT ARRAY[?]', $x], 216 'ARRAY scalar'); 217 218# SET 219interp_test(['UPDATE mytable SET', $h], 220 ["UPDATE mytable SET $hi->{keys}[0]=?, $hi->{keys}[1]=?", @{$hi->{values}}], 221 'SET hashref'); 222interp_test(['UPDATE mytable SET', 223 {one => 1, two => $var2, three => sql('3')}], 224 ['UPDATE mytable SET one=?, three=3, two= ?', 225 [1, sql_type(\1)], [${$var2->{value}}, $var2]], 226 'SET hashref of sql_type types, sql()'); 227#FIX--what if size of hash is zero? error? 228 229# WHERE hashref 230interp_test(['WHERE', $h0], 231 ['WHERE 1=1'], 232 'WHERE hashref of size = 0'); 233interp_test(['WHERE', $h], 234 ["WHERE ($hi->{keys}[0]=? AND $hi->{keys}[1]=?)", @{$hi->{values}}], 235 'WHERE hashref of size > 0'); 236my $h2bi = make_hash_info( 237 {x => 1, y => sql('2')}, 238 {x => 'x=?', y => 'y=2'}, 239 {x => [1]} 240); 241interp_test(['WHERE', $h2bi->{hashref}], 242 ["WHERE ($h2bi->{places}[0] AND $h2bi->{places}[1])", @{$h2bi->{binds}}], 243 'WHERE hashref sql()'); 244my $h2ci = make_hash_info( 245 {x => 1, y => undef}, 246 {x => 'x=?', y => 'y IS NULL'}, 247 {x => [1]} 248); 249interp_test(['WHERE', $h2ci->{hashref}], 250 ["WHERE ($h2ci->{places}[0] AND $h2ci->{places}[1])", @{$h2ci->{binds}}], 251 'WHERE hashref of NULL'); 252 253# WHERE x= 254interp_test(['WHERE x=', \$x], 255 ['WHERE x= ?', $x], 256 'WHERE x=scalarref'); 257 258# sql_type 259interp_test(['WHERE x=', \$x, 'AND', 'y=', sql_type(\$y)], 260 ['WHERE x= ? AND y= ?', $x, $y], 261 'WHERE \$x, sql_type'); 262interp_test(['WHERE x=', \$x, 'AND', 'y=', $var2], 263 ['WHERE x= ? AND y= ?', [$x, sql_type(\$x)], [${$var2->{value}}, $var2]], 264 'WHERE \$x, sql_type typed'); 265interp_test(['WHERE', {x => $x, y => $var2}, 'AND z=', \$x], 266 ['WHERE (x=? AND y= ?) AND z= ?', 267 [$x, sql_type(\$x)], [${$var2->{value}}, $var2], [$x, sql_type(\$x)]], 268 'WHERE hashref of \$x, sql_type typed'); 269my $h5i = make_hash_info( 270 {x => $x, y => [3, $var2]}, 271 {x => 'x=?', y => 'y IN (?, ?)'}, 272 {x => [[$x, sql_type(\$x)]], y => [[3, sql_type(\3)], [${$var2->{value}}, $var2]]} 273); 274interp_test(['WHERE', $h5i->{hashref}], 275 ["WHERE ($h5i->{places}[0] AND $h5i->{places}[1])", @{$h5i->{binds}}[0,1,2]], 276 'WHERE hashref of arrayref of sql_type typed'); 277interp_test(['WHERE', {x => $x, y => sql('z')}], 278 ['WHERE (x=? AND y=z)', $x], 279 'WHERE hashref of \$x, sql()'); 280 281# table references 282error_test(['FROM', []], qr/table reference has zero rows/, 'v 0'); 283error_test(['FROM', [[]]], qr/table reference has zero columns/, 'vv 1 0'); 284error_test(['', [[]]], qr/table reference has zero columns/, 'vv 1 0 (resultset)'); 285error_test(['FROM', [{}]], qr/table reference has zero columns/, 'vh 1 0'); 286error_test(['', [{}]], qr/table reference has zero columns/, 'vh 1 0 (resultset)'); 287interp_test(['FROM', [[1]]], ['FROM (SELECT ?) AS tbl0', 1], 'vv 1 1'); 288interp_test(['', [[1]]], ['(SELECT ?)', 1], 'vv 1 1 (resultset)'); 289interp_test(['FROM', [{a => 1}]], ['FROM (SELECT ? AS a) AS tbl0', 1], 'vh 1 1'); 290interp_test(['', [{a => 1}]], ['(SELECT ? AS a)', 1], 'vh 1 1 (resultset)'); 291interp_test(['FROM', [[1,2]]], ['FROM (SELECT ?, ?) AS tbl0', 1, 2], 'vv 1 2'); 292interp_test(['FROM', [$h]], ["FROM (SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1]) AS tbl0", 293 @{$hi->{values}}], 'vh 1 2'); 294interp_test(['', [$h]], ["(SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1])", 295 @{$hi->{values}}], 'vh 1 2 (resultset)'); 296interp_test(['FROM', [[1,2],[3,4]]], 297 ['FROM (SELECT ?, ? UNION ALL SELECT ?, ?) AS tbl0', 1, 2, 3, 4], 'vv 2 2'); 298interp_test(['', [[1,2],[3,4]]], 299 ['(SELECT ?, ? UNION ALL SELECT ?, ?)', 1, 2, 3, 4], 'vv 2 2 (resultset)'); 300interp_test(['FROM', [$h,$h]], 301 ["FROM (SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1] UNION ALL SELECT ?, ?) AS tbl0", 302 @{$hi->{values}}, @{$hi->{values}}], 'vh 2 2'); 303interp_test(['', [$h,$h]], 304 ["(SELECT ? AS $hi->{keys}[0], ? AS $hi->{keys}[1] UNION ALL SELECT ?, ?)", 305 @{$hi->{values}}, @{$hi->{values}}], 'vh 2 2 (resultset)'); 306interp_test(['FROM', [[1]], 'JOIN', [[2]]], 307 ['FROM (SELECT ?) AS tbl0 JOIN (SELECT ?) AS tbl1', 1, 2], 'vv 1 1 join vv 1 1'); 308interp_test(['FROM', [[sql(1)]]], ['FROM (SELECT 1) AS tbl0'], 'vv 1 1 of sql(1)'); 309interp_test(['', [[sql(1)]]], ['(SELECT 1)'], 'vv 1 1 of sql(1) (resultset)'); 310interp_test(['FROM', [{a => sql(1)}]], ['FROM (SELECT 1 AS a) AS tbl0'], 'vh 1 1 of sql(1)'); 311interp_test(['FROM', [[sql(\1)]]], ['FROM (SELECT ?) AS tbl0', 1], 'vv 1 1 of sql(\1)'); 312interp_test(['FROM', [[sql('1=', \1)]]], 313 ['FROM (SELECT 1= ?) AS tbl0', 1], 'vv 1 1 of sql(s,\1)'); 314interp_test(['FROM', [[1]], ' AS mytable'], 315 ['FROM (SELECT ?) AS mytable', 1], 'vv 1 1 with alias'); 316interp_test(['FROM', [[undef]]], 317 ['FROM (SELECT ?) AS tbl0', undef], 'vv 1 1 of undef'); 318interp_test(['FROM', [{a => undef}]], 319 ['FROM (SELECT ? AS a) AS tbl0', undef], 'vh 1 1 of undef'); 320 321# error handling 322#OLD: error_test(['SELECT', []], qr/unrecognized.*array.*select/i, 'err1'); 323#OLD: error_test(['IN', {}], qr/unrecognized.*hash.*in/i, 'err2'); 324 325sub interp_test 326{ 327 my($snips, $expect, $name) = @_; 328# print Dumper([sql_interp @$snips], $expect); 329 330 # custom filter 331 my $func = sub { return [@_]; }; 332 my $test = \&my_deeply; 333 if(ref($expect) eq 'ARRAY' && @$expect > 0 && ref($expect->[0]) eq 'CODE') { 334 $func = shift @$expect; 335 $expect = $expect->[0]; 336 $test = \&like; 337 } 338 339 $test->($func->(sql_interp @$snips), $expect, $name); 340 $test->($func->($interp->sql_interp(@$snips)), $expect, "$name OO"); 341} 342 343sub error_test 344{ 345 my($list, $re, $name) = @_; 346 eval { 347 sql_interp @$list; 348 }; 349 like($@, $re, $name); 350} 351