rename DBIC::Storage::PP and get ready to re-release
[dbsrgits/SQL-Abstract.git] / t / 04modifiers.t
CommitLineData
e5360be4 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;
fdfbbc65 10use Storable qw/dclone/;
e5360be4 11use SQL::Abstract;
12
13=begin
01a01e57 14Test -and -or and -nest modifiers, assuming the following:
e5360be4 15
6c8ac65d 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
e5360be4 23
24=cut
25
05a05fd1 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
a8b90cb7 35my @and_or_tests = (
05a05fd1 36 # basic tests
a8b90cb7 37 {
38 where => { -and => [a => 1, b => 2] },
05a05fd1 39 %{$and_or_args->{and}},
a8b90cb7 40 },
41 {
42 where => [ -and => [a => 1, b => 2] ],
05a05fd1 43 %{$and_or_args->{and}},
a8b90cb7 44 },
45 {
46 where => { -or => [a => 1, b => 2] },
05a05fd1 47 %{$and_or_args->{or}},
a8b90cb7 48 },
49 {
50 where => [ -or => [a => 1, b => 2] ],
05a05fd1 51 %{$and_or_args->{or}},
52 },
53
6c8ac65d 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
05a05fd1 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
6c8ac65d 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)
64385831 148 {
149 where => { x => { '!=' => [ -and => (1 .. 3) ] } },
150 stmt => 'WHERE x != ? AND x != ? AND x != ?',
151 bind => [1..3],
152 },
6c8ac65d 153
154 # the -or should affect only the inner hashref, as we are not in an outer arrayref
05a05fd1 155 {
156 where => { x => {
157 -or => { '!=', 1, '>=', 2 }, -like => 'x%'
158 }},
25e4c693 159 stmt => 'WHERE x LIKE ? AND ( x != ? OR x >= ? )',
eb49170d 160 bind => [qw/x% 1 2/],
05a05fd1 161 },
6c8ac65d 162
163 # the -and should affect the OUTER arrayref, while the internal structures remain intact
05a05fd1 164 {
165 where => { x => [
166 -and => [ 1, 2 ], { -like => 'x%' }
167 ]},
6c8ac65d 168 stmt => 'WHERE (x = ? OR x = ?) AND x LIKE ?',
05a05fd1 169 bind => [qw/1 2 x%/],
a8b90cb7 170 },
6c8ac65d 171
a8b90cb7 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 },
6c8ac65d 177
a8b90cb7 178 {
179 where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } },
106c861e 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/],
a8b90cb7 182 },
e5360be4 183
a8b90cb7 184 {
a8b90cb7 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 },
e5360be4 189
a8b90cb7 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 },
6c8ac65d 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] } } },
106c861e 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/],
6c8ac65d 202 },
203
a8b90cb7 204 {
6c8ac65d 205 # flip logic in arrays except where excplicitly requested otherwise
a8b90cb7 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 },
05a05fd1 211
6c8ac65d 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
05a05fd1 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'} ],
6c8ac65d 243 [ {'!=' => 'toto', '=' => 'koko'} ],
05a05fd1 244 ] },
6c8ac65d 245 stmt => 'WHERE (foo LIKE ? OR foo > ?) AND (foo LIKE ? AND foo < ?) AND (foo LIKE ? OR foo LIKE ?) AND (foo != ? AND foo = ?)',
05a05fd1 246 bind => [qw/foo% moo %bar baz %alpha %beta toto koko/],
247 },
6c8ac65d 248
05a05fd1 249 {
6c8ac65d 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}] ],
05a05fd1 262 stmt => 'WHERE foo = ? AND bar = ? AND baz = ?',
6c8ac65d 263 bind => [1 .. 3],
05a05fd1 264 },
265 {
6c8ac65d 266 where => [-and => [{foo => 1}, {bar => 2}, -or => {baz => 3, woz => 4} ] ],
267 stmt => 'WHERE foo = ? AND bar = ? AND (baz = ? OR woz = ?)',
05a05fd1 268 bind => [1 .. 4],
269 },
270
6c8ac65d 271 # -and has only 1 following element, thus all still ORed
05a05fd1 272 {
6c8ac65d 273 where => { col => [ -and => [{'<' => 123}, {'>' => 456 }, {'!=' => 789}] ] },
05a05fd1 274 stmt => 'WHERE col < ? OR col > ? OR col != ?',
275 bind => [qw/123 456 789/],
276 },
277
6c8ac65d 278 # flipping array logic affects both column value and condition arrays
05a05fd1 279 {
6c8ac65d 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/],
05a05fd1 299 },
a8b90cb7 300);
e5360be4 301
403e50d1 302# modN and mod_N were a bad design decision - they go away in SQLA2, warn now
01a01e57 303my @numbered_mods = (
403e50d1 304 {
305 backcompat => {
01a01e57 306 -and => [a => 10, b => 11],
307 -and2 => [ c => 20, d => 21 ],
403e50d1 308 -nest => [ x => 1 ],
309 -nest2 => [ y => 2 ],
01a01e57 310 -or => { m => 7, n => 8 },
311 -or2 => { m => 17, n => 18 },
403e50d1 312 },
313 correct => { -and => [
314 -and => [a => 10, b => 11],
315 -and => [ c => 20, d => 21 ],
01a01e57 316 -nest => [ x => 1 ],
317 -nest => [ y => 2 ],
403e50d1 318 -or => { m => 7, n => 8 },
319 -or => { m => 17, n => 18 },
320 ] },
321 },
322 {
323 backcompat => {
01a01e57 324 -and2 => [a => 10, b => 11],
325 -and_3 => [ c => 20, d => 21 ],
403e50d1 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 ],
01a01e57 334 -nest => [ x => 1 ],
335 -nest => [ y => 2 ],
403e50d1 336 -or => { m => 7, n => 8 },
337 -or => { m => 17, n => 18 },
338 ] ],
339 },
340);
a8b90cb7 341
01a01e57 342my @nest_tests = (
2f641e1f 343 {
01a01e57 344 where => {a => 1, -nest => [b => 2, c => 3]},
2f641e1f 345 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )',
346 bind => [qw/2 3 1/],
347 },
348 {
01a01e57 349 where => {a => 1, -nest => {b => 2, c => 3}},
2f641e1f 350 stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )',
351 bind => [qw/2 3 1/],
352 },
353 {
01a01e57 354 where => {a => 1, -or => {-nest => {b => 2, c => 3}}},
2f641e1f 355 stmt => 'WHERE ( ( (b = ? AND c = ?) AND a = ? ) )',
356 bind => [qw/2 3 1/],
357 },
358 {
01a01e57 359 where => {a => 1, -or => {-nest => [b => 2, c => 3]}},
2f641e1f 360 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )',
361 bind => [qw/2 3 1/],
362 },
363 {
01a01e57 364 where => {a => 1, -nest => {-or => {b => 2, c => 3}}},
106c861e 365 stmt => 'WHERE ( ( (b = ? OR c = ?) AND a = ? ) )',
366 bind => [qw/2 3 1/],
2f641e1f 367 },
3a8b7db0 368 {
01a01e57 369 where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]],
c592e251 370 stmt => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )',
3a8b7db0 371 bind => [qw/1 2 3 4 5/],
372 },
2f641e1f 373);
374
ce261791 375plan tests => @and_or_tests*4 + @numbered_mods*4 + @nest_tests*2;
a8b90cb7 376
377for my $case (@and_or_tests) {
ef8c0c94 378 TODO: {
379 local $TODO = $case->{todo} if $case->{todo};
380
e5360be4 381 local $Data::Dumper::Terse = 1;
a8b90cb7 382
383 my @w;
384 local $SIG{__WARN__} = sub { push @w, @_ };
ce261791 385
a8b90cb7 386 my $sql = SQL::Abstract->new ($case->{args} || {});
fdfbbc65 387 my $where_copy = dclone($case->{where});
ce261791 388
e5360be4 389 lives_ok (sub {
a8b90cb7 390 my ($stmt, @bind) = $sql->where($case->{where});
403e50d1 391 is_same_sql_bind(
392 $stmt,
393 \@bind,
394 $case->{stmt},
395 $case->{bind},
396 )
e5360be4 397 || diag "Search term:\n" . Dumper $case->{where};
398 });
a8b90cb7 399 is (@w, 0, 'No warnings within and-or tests')
400 || diag join "\n", 'Emitted warnings:', @w;
ce261791 401
402 is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged');
ef8c0c94 403 }
e5360be4 404}
403e50d1 405
01a01e57 406for my $case (@nest_tests) {
2f641e1f 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
01a01e57 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) {
2f641e1f 431 TODO: {
432 local $TODO = $case->{todo} if $case->{todo};
433
403e50d1 434 local $Data::Dumper::Terse = 1;
435
01a01e57 436 my @w;
437 local $SIG{__WARN__} = sub { push @w, @_ };
403e50d1 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
01a01e57 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;
2f641e1f 461 }
403e50d1 462}
463