1#!/usr/bin/perl 2 3use strict; 4use warnings; 5use Test::More; 6use Test::Exception; 7use SQL::Abstract::Test import => ['is_same_sql_bind']; 8 9use Data::Dumper; 10use SQL::Abstract; 11use Clone; 12 13=begin 14Test -and -or and -nest modifiers, assuming the following: 15 16 * Modifiers are respected in both hashrefs and arrayrefs (with the obvious 17 limitation of one modifier type per hahsref) 18 * When in condition context i.e. where => { -or { a = 1 } }, each modifier 19 affects only the immediate element following it. 20 * When in column multi-condition context i.e. 21 where => { x => { '!=', [-and, [qw/1 2 3/]] } }, a modifier affects the 22 OUTER ARRAYREF if and only if it is the first element of said ARRAYREF 23 24=cut 25 26# no warnings (the -or/-and => { } warning is silly, there is nothing wrong with such usage) 27my $and_or_args = { 28 and => { stmt => 'WHERE a = ? AND b = ?', bind => [qw/1 2/] }, 29 or => { stmt => 'WHERE a = ? OR b = ?', bind => [qw/1 2/] }, 30 or_and => { stmt => 'WHERE ( foo = ? OR bar = ? ) AND baz = ? ', bind => [qw/1 2 3/] }, 31 or_or => { stmt => 'WHERE foo = ? OR bar = ? OR baz = ?', bind => [qw/1 2 3/] }, 32 and_or => { stmt => 'WHERE ( foo = ? AND bar = ? ) OR baz = ?', bind => [qw/1 2 3/] }, 33}; 34 35my @and_or_tests = ( 36 # basic tests 37 { 38 where => { -and => [a => 1, b => 2] }, 39 %{$and_or_args->{and}}, 40 }, 41 { 42 where => [ -and => [a => 1, b => 2] ], 43 %{$and_or_args->{and}}, 44 }, 45 { 46 where => { -or => [a => 1, b => 2] }, 47 %{$and_or_args->{or}}, 48 }, 49 { 50 where => [ -or => [a => 1, b => 2] ], 51 %{$and_or_args->{or}}, 52 }, 53 54 { 55 where => { -and => {a => 1, b => 2} }, 56 %{$and_or_args->{and}}, 57 }, 58 { 59 where => [ -and => {a => 1, b => 2} ], 60 %{$and_or_args->{and}}, 61 }, 62 { 63 where => { -or => {a => 1, b => 2} }, 64 %{$and_or_args->{or}}, 65 }, 66 { 67 where => [ -or => {a => 1, b => 2} ], 68 %{$and_or_args->{or}}, 69 }, 70 71 # test modifiers within hashrefs 72 { 73 where => { -or => [ 74 [ foo => 1, bar => 2 ], 75 baz => 3, 76 ]}, 77 %{$and_or_args->{or_or}}, 78 }, 79 { 80 where => { -and => [ 81 [ foo => 1, bar => 2 ], 82 baz => 3, 83 ]}, 84 %{$and_or_args->{or_and}}, 85 }, 86 87 # test modifiers within arrayrefs 88 { 89 where => [ -or => [ 90 [ foo => 1, bar => 2 ], 91 baz => 3, 92 ]], 93 %{$and_or_args->{or_or}}, 94 }, 95 { 96 where => [ -and => [ 97 [ foo => 1, bar => 2 ], 98 baz => 3, 99 ]], 100 %{$and_or_args->{or_and}}, 101 }, 102 103 # test ambiguous modifiers within hashrefs (op extends to to immediate RHS only) 104 { 105 where => { -and => [ -or => 106 [ foo => 1, bar => 2 ], 107 baz => 3, 108 ]}, 109 %{$and_or_args->{or_and}}, 110 }, 111 { 112 where => { -or => [ -and => 113 [ foo => 1, bar => 2 ], 114 baz => 3, 115 ]}, 116 %{$and_or_args->{and_or}}, 117 }, 118 119 # test ambiguous modifiers within arrayrefs (op extends to to immediate RHS only) 120 { 121 where => [ -and => [ -or => 122 [ foo => 1, bar => 2 ], 123 baz => 3, 124 ]], 125 %{$and_or_args->{or_and}}, 126 }, 127 { 128 where => [ -or => [ -and => 129 [ foo => 1, bar => 2 ], 130 baz => 3 131 ]], 132 %{$and_or_args->{and_or}}, 133 }, 134 135 # test column multi-cond in arrayref (useless example) 136 { 137 where => { x => [ -and => (1 .. 3) ] }, 138 stmt => 'WHERE x = ? AND x = ? AND x = ?', 139 bind => [1..3], 140 }, 141 # test column multi-cond in arrayref (more useful) 142 { 143 where => { x => [ -and => {'!=' => 1}, {'!=' => 2}, {'!=' => 3} ] }, 144 stmt => 'WHERE x != ? AND x != ? AND x != ?', 145 bind => [1..3], 146 }, 147 # test column multi-cond in arrayref (even more useful) 148 { 149 where => { x => { '!=' => [ -and => (1 .. 3) ] } }, 150 stmt => 'WHERE x != ? AND x != ? AND x != ?', 151 bind => [1..3], 152 }, 153 154 # the -or should affect only the inner hashref, as we are not in an outer arrayref 155 { 156 where => { x => { 157 -or => { '!=', 1, '>=', 2 }, -like => 'x%' 158 }}, 159 stmt => 'WHERE x LIKE ? AND ( x != ? OR x >= ? )', 160 bind => [qw/x% 1 2/], 161 }, 162 163 # the -and should affect the OUTER arrayref, while the internal structures remain intact 164 { 165 where => { x => [ 166 -and => [ 1, 2 ], { -like => 'x%' } 167 ]}, 168 stmt => 'WHERE (x = ? OR x = ?) AND x LIKE ?', 169 bind => [qw/1 2 x%/], 170 }, 171 172 { 173 where => { -and => [a => 1, b => 2], x => 9, -or => { c => 3, d => 4 } }, 174 stmt => 'WHERE a = ? AND b = ? AND ( c = ? OR d = ? ) AND x = ?', 175 bind => [qw/1 2 3 4 9/], 176 }, 177 178 { 179 where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } }, 180 stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND (c = ? OR d = ? OR (l = ? OR l = ?) ) AND x = ?', 181 bind => [qw/1 2 11 12 3 4 21 22 9/], 182 }, 183 184 { 185 where => { -or => [a => 1, b => 2, k => [11, 12] ], x => 9, -and => { c => 3, d => 4, l => { '=' => [21, 22] } } }, 186 stmt => 'WHERE c = ? AND d = ? AND ( l = ? OR l = ?) AND (a = ? OR b = ? OR k = ? OR k = ?) AND x = ?', 187 bind => [qw/3 4 21 22 1 2 11 12 9/], 188 }, 189 190 { 191 where => [ -or => [a => 1, b => 2], -or => { c => 3, d => 4}, e => 5, -and => [ f => 6, g => 7], [ h => 8, i => 9, -and => [ k => 10, l => 11] ], { m => 12, n => 13 }], 192 stmt => 'WHERE a = ? OR b = ? OR c = ? OR d = ? OR e = ? OR ( f = ? AND g = ?) OR h = ? OR i = ? OR ( k = ? AND l = ? ) OR (m = ? AND n = ?)', 193 bind => [1 .. 13], 194 }, 195 196 { 197 # explicit OR logic in arrays should leave everything intact 198 args => { logic => 'or' }, 199 where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } }, 200 stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ( c = ? OR d = ? OR l = ? OR l = ? ) AND x = ? ', 201 bind => [qw/1 2 11 12 3 4 21 22 9/], 202 }, 203 204 { 205 # flip logic in arrays except where excplicitly requested otherwise 206 args => { logic => 'and' }, 207 where => [ -or => [a => 1, b => 2], -or => { c => 3, d => 4}, e => 5, -and => [ f => 6, g => 7], [ h => 8, i => 9, -and => [ k => 10, l => 11] ], { m => 12, n => 13 }], 208 stmt => 'WHERE (a = ? OR b = ?) AND (c = ? OR d = ?) AND e = ? AND f = ? AND g = ? AND h = ? AND i = ? AND k = ? AND l = ? AND m = ? AND n = ?', 209 bind => [1 .. 13], 210 }, 211 212 # 1st -and is in column mode, thus flips the entire array, whereas the 213 # 2nd one is just a condition modifier 214 { 215 where => [ 216 col => [ -and => {'<' => 123}, {'>' => 456 }, {'!=' => 789} ], 217 -and => [ 218 col2 => [ -or => { -like => 'crap' }, { -like => 'crop' } ], 219 col3 => [ -and => { -like => 'chap' }, { -like => 'chop' } ], 220 ], 221 ], 222 stmt => 'WHERE 223 (col < ? AND col > ? AND col != ?) 224 OR 225 ( 226 ( col2 LIKE ? OR col2 LIKE ? ) 227 AND 228 ( col3 LIKE ? AND col3 LIKE ? ) 229 ) 230 ', 231 bind => [qw/123 456 789 crap crop chap chop/], 232 }, 233 234 ########## 235 # some corner cases by ldami (some produce useless SQL, just for clarification on 1.5 direction) 236 # 237 238 { 239 where => { foo => [ 240 -and => [ { -like => 'foo%'}, {'>' => 'moo'} ], 241 { -like => '%bar', '<' => 'baz'}, 242 [ {-like => '%alpha'}, {-like => '%beta'} ], 243 [ {'!=' => 'toto', '=' => 'koko'} ], 244 ] }, 245 stmt => 'WHERE (foo LIKE ? OR foo > ?) AND (foo LIKE ? AND foo < ?) AND (foo LIKE ? OR foo LIKE ?) AND (foo != ? AND foo = ?)', 246 bind => [qw/foo% moo %bar baz %alpha %beta toto koko/], 247 }, 248 249 { 250 where => [ 251 -and => [a => 1, b => 2], 252 -or => [c => 3, d => 4], 253 e => [-and => {-like => 'foo%'}, {-like => '%bar'} ], 254 ], 255 stmt => 'WHERE (a = ? AND b = ?) OR c = ? OR d = ? OR (e LIKE ? AND e LIKE ?)', 256 bind => [qw/1 2 3 4 foo% %bar/], 257 }, 258 259 # -or has nothing to flip 260 { 261 where => [-and => [{foo => 1}, {bar => 2}, -or => {baz => 3}] ], 262 stmt => 'WHERE foo = ? AND bar = ? AND baz = ?', 263 bind => [1 .. 3], 264 }, 265 { 266 where => [-and => [{foo => 1}, {bar => 2}, -or => {baz => 3, woz => 4} ] ], 267 stmt => 'WHERE foo = ? AND bar = ? AND (baz = ? OR woz = ?)', 268 bind => [1 .. 4], 269 }, 270 271 # -and has only 1 following element, thus all still ORed 272 { 273 where => { col => [ -and => [{'<' => 123}, {'>' => 456 }, {'!=' => 789}] ] }, 274 stmt => 'WHERE col < ? OR col > ? OR col != ?', 275 bind => [qw/123 456 789/], 276 }, 277 278 # flipping array logic affects both column value and condition arrays 279 { 280 args => { logic => 'and' }, 281 where => [ col => [ {'<' => 123}, {'>' => 456 }, {'!=' => 789} ], col2 => 0 ], 282 stmt => 'WHERE col < ? AND col > ? AND col != ? AND col2 = ?', 283 bind => [qw/123 456 789 0/], 284 }, 285 286 # flipping array logic with explicit -and works 287 { 288 args => { logic => 'and' }, 289 where => [ col => [ -and => {'<' => 123}, {'>' => 456 }, {'!=' => 789} ], col2 => 0 ], 290 stmt => 'WHERE col < ? AND col > ? AND col != ? AND col2 = ?', 291 bind => [qw/123 456 789 0/], 292 }, 293 # flipping array logic with explicit -or flipping it back 294 { 295 args => { logic => 'and' }, 296 where => [ col => [ -or => {'<' => 123}, {'>' => 456 }, {'!=' => 789} ], col2 => 0 ], 297 stmt => 'WHERE (col < ? OR col > ? OR col != ?) AND col2 = ?', 298 bind => [qw/123 456 789 0/], 299 }, 300); 301 302# modN and mod_N were a bad design decision - they go away in SQLA2, warn now 303my @numbered_mods = ( 304 { 305 backcompat => { 306 -and => [a => 10, b => 11], 307 -and2 => [ c => 20, d => 21 ], 308 -nest => [ x => 1 ], 309 -nest2 => [ y => 2 ], 310 -or => { m => 7, n => 8 }, 311 -or2 => { m => 17, n => 18 }, 312 }, 313 correct => { -and => [ 314 -and => [a => 10, b => 11], 315 -and => [ c => 20, d => 21 ], 316 -nest => [ x => 1 ], 317 -nest => [ y => 2 ], 318 -or => { m => 7, n => 8 }, 319 -or => { m => 17, n => 18 }, 320 ] }, 321 }, 322 { 323 backcompat => { 324 -and2 => [a => 10, b => 11], 325 -and_3 => [ c => 20, d => 21 ], 326 -nest2 => [ x => 1 ], 327 -nest_3 => [ y => 2 ], 328 -or2 => { m => 7, n => 8 }, 329 -or_3 => { m => 17, n => 18 }, 330 }, 331 correct => [ -and => [ 332 -and => [a => 10, b => 11], 333 -and => [ c => 20, d => 21 ], 334 -nest => [ x => 1 ], 335 -nest => [ y => 2 ], 336 -or => { m => 7, n => 8 }, 337 -or => { m => 17, n => 18 }, 338 ] ], 339 }, 340); 341 342my @nest_tests = ( 343 { 344 where => {a => 1, -nest => [b => 2, c => 3]}, 345 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', 346 bind => [qw/2 3 1/], 347 }, 348 { 349 where => {a => 1, -nest => {b => 2, c => 3}}, 350 stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )', 351 bind => [qw/2 3 1/], 352 }, 353 { 354 where => {a => 1, -or => {-nest => {b => 2, c => 3}}}, 355 stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )', 356 bind => [qw/2 3 1/], 357 }, 358 { 359 where => {a => 1, -or => {-nest => [b => 2, c => 3]}}, 360 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', 361 bind => [qw/2 3 1/], 362 }, 363 { 364 where => {a => 1, -nest => {-or => {b => 2, c => 3}}}, 365 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )', 366 bind => [qw/2 3 1/], 367 }, 368 { 369 where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]], 370 stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )', 371 bind => [qw/1 2 3 4 5/], 372 }, 373); 374 375plan tests => @and_or_tests*4 + @numbered_mods*4 + @nest_tests*2; 376 377for my $case (@and_or_tests) { 378 TODO: { 379 local $TODO = $case->{todo} if $case->{todo}; 380 381 local $Data::Dumper::Terse = 1; 382 383 my @w; 384 local $SIG{__WARN__} = sub { push @w, @_ }; 385 386 my $sql = SQL::Abstract->new ($case->{args} || {}); 387 my $where_copy = Clone::clone ($case->{where}); 388 389 lives_ok (sub { 390 my ($stmt, @bind) = $sql->where($case->{where}); 391 is_same_sql_bind( 392 $stmt, 393 \@bind, 394 $case->{stmt}, 395 $case->{bind}, 396 ) 397 || diag "Search term:\n" . Dumper $case->{where}; 398 }); 399 is (@w, 0, 'No warnings within and-or tests') 400 || diag join "\n", 'Emitted warnings:', @w; 401 402 is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged'); 403 } 404} 405 406for my $case (@nest_tests) { 407 TODO: { 408 local $TODO = $case->{todo} if $case->{todo}; 409 410 local $SQL::Abstract::Test::parenthesis_significant = 1; 411 local $Data::Dumper::Terse = 1; 412 413 my $sql = SQL::Abstract->new ($case->{args} || {}); 414 lives_ok (sub { 415 my ($stmt, @bind) = $sql->where($case->{where}); 416 is_same_sql_bind( 417 $stmt, 418 \@bind, 419 $case->{stmt}, 420 $case->{bind}, 421 ) 422 || diag "Search term:\n" . Dumper $case->{where}; 423 }); 424 } 425} 426 427 428 429my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E"; 430for my $case (@numbered_mods) { 431 TODO: { 432 local $TODO = $case->{todo} if $case->{todo}; 433 434 local $Data::Dumper::Terse = 1; 435 436 my @w; 437 local $SIG{__WARN__} = sub { push @w, @_ }; 438 my $sql = SQL::Abstract->new ($case->{args} || {}); 439 lives_ok (sub { 440 my ($old_s, @old_b) = $sql->where($case->{backcompat}); 441 my ($new_s, @new_b) = $sql->where($case->{correct}); 442 is_same_sql_bind( 443 $old_s, \@old_b, 444 $new_s, \@new_b, 445 'Backcompat and the correct(tm) syntax result in identical statements', 446 ) || diag "Search terms:\n" . Dumper { 447 backcompat => $case->{backcompat}, 448 correct => $case->{correct}, 449 }; 450 }); 451 452 ok (@w, 'Warnings were emitted about a mod_N construct'); 453 454 my @non_match; 455 for (@w) { 456 push @non_match, $_ if ($_ !~ /$w_str/); 457 } 458 459 is (@non_match, 0, 'All warnings match the deprecation message') 460 || diag join "\n", 'Rogue warnings:', @non_match; 461 } 462} 463 464