Commit | Line | Data |
e5360be4 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Test::More; |
6 | use Test::Exception; |
7 | use SQL::Abstract::Test import => ['is_same_sql_bind']; |
8 | |
9 | use Data::Dumper; |
10 | use SQL::Abstract; |
11 | |
12 | =begin |
a8b90cb7 |
13 | Test -and -or and -nest modifiers, assuming the following: |
e5360be4 |
14 | |
15 | * Modifiers are respected in both hashrefs and arrayrefs (with the obvious limitation of one modifier type per hahsref) |
16 | * Each modifier affects only the immediate element following it |
17 | * In the case of -nestX simply wrap whatever the next element is in a pair of (), regardless of type |
18 | * In the case of -or/-and explicitly setting the logic within a following hashref or arrayref, |
19 | without imposing the logic on any sub-elements of the affected structure |
20 | * Ignore (maybe throw exception?) of the -or/-and modifier if the following element is missing, |
21 | or is of a type other than hash/arrayref |
22 | |
23 | =cut |
24 | |
a8b90cb7 |
25 | # no warnings |
26 | my @and_or_tests = ( |
27 | { |
28 | where => { -and => [a => 1, b => 2] }, |
29 | stmt => 'WHERE a = ? AND b = ?', |
30 | bind => [qw/1 2/], |
31 | }, |
32 | { |
33 | where => [ -and => [a => 1, b => 2] ], |
34 | stmt => 'WHERE a = ? AND b = ?', |
35 | bind => [qw/1 2/], |
36 | }, |
37 | { |
38 | where => { -or => [a => 1, b => 2] }, |
39 | stmt => 'WHERE a = ? OR b = ?', |
40 | bind => [qw/1 2/], |
41 | }, |
42 | { |
43 | where => [ -or => [a => 1, b => 2] ], |
44 | stmt => 'WHERE a = ? OR b = ?', |
45 | bind => [qw/1 2/], |
46 | }, |
47 | { |
48 | where => { -and => [a => 1, b => 2], x => 9, -or => { c => 3, d => 4 } }, |
49 | stmt => 'WHERE a = ? AND b = ? AND ( c = ? OR d = ? ) AND x = ?', |
50 | bind => [qw/1 2 3 4 9/], |
51 | }, |
52 | { |
53 | where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } }, |
54 | stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ( l = ? OR l = ? OR c = ? OR d = ? ) AND x = ?', |
55 | bind => [qw/1 2 11 12 21 22 3 4 9/], |
56 | }, |
57 | { |
58 | where => { -or => [a => 1, b => 2, k => [11, 12] ], x => 9, -and => { c => 3, d => 4, l => { '=' => [21, 22] } } }, |
59 | stmt => 'WHERE c = ? AND d = ? AND ( l = ? OR l = ?) AND (a = ? OR b = ? OR k = ? OR k = ?) AND x = ?', |
60 | bind => [qw/3 4 21 22 1 2 11 12 9/], |
61 | }, |
e5360be4 |
62 | |
a8b90cb7 |
63 | { |
64 | # things should remain the same as above, hashrefs not affected |
65 | args => { logic => 'or' }, |
66 | where => { -or => [a => 1, b => 2, k => [11, 12] ], x => 9, -and => { c => 3, d => 4, l => { '=' => [21, 22] } } }, |
67 | stmt => 'WHERE c = ? AND d = ? AND ( l = ? OR l = ?) AND (a = ? OR b = ? OR k = ? OR k = ?) AND x = ?', |
68 | bind => [qw/3 4 21 22 1 2 11 12 9/], |
69 | }, |
e5360be4 |
70 | |
a8b90cb7 |
71 | { |
72 | 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 }], |
73 | 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 = ?)', |
74 | bind => [1 .. 13], |
75 | }, |
76 | { |
77 | # while the arrayref logic should flip, except when requested otherwise |
78 | args => { logic => 'and' }, |
79 | 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 }], |
80 | 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 = ?', |
81 | bind => [1 .. 13], |
82 | }, |
83 | ); |
e5360be4 |
84 | |
a8b90cb7 |
85 | my @nest_tests = (); #can not be verified via is_same_sql_bind - need exact matching (parenthesis and all) |
86 | |
87 | my @numbered_tests = (); #need tests making sure warnings are emitted for modifierN (will go away in SQLA2) |
88 | |
89 | plan tests => @and_or_tests * 3; |
90 | |
91 | for my $case (@and_or_tests) { |
e5360be4 |
92 | local $Data::Dumper::Terse = 1; |
a8b90cb7 |
93 | |
94 | my @w; |
95 | local $SIG{__WARN__} = sub { push @w, @_ }; |
96 | my $sql = SQL::Abstract->new ($case->{args} || {}); |
e5360be4 |
97 | lives_ok (sub { |
a8b90cb7 |
98 | my ($stmt, @bind) = $sql->where($case->{where}); |
e5360be4 |
99 | is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind}) |
100 | || diag "Search term:\n" . Dumper $case->{where}; |
101 | }); |
a8b90cb7 |
102 | is (@w, 0, 'No warnings within and-or tests') |
103 | || diag join "\n", 'Emitted warnings:', @w; |
e5360be4 |
104 | } |