t/04modifiers.t

   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
  13 Test -and -or and -nest modifiers, assuming the following:
  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
  25 # no warnings (the -or/-and => { } warning is silly, there is nothing wrong with such usage)
  26 my $and_or_args = {
  27   and => { stmt => 'WHERE a = ? AND b = ?', bind => [qw/1 2/] },
  28   or => { stmt => 'WHERE a = ? OR b = ?', bind => [qw/1 2/] },
  29   or_and => { stmt => 'WHERE ( foo = ? OR bar = ? ) AND baz = ? ', bind => [qw/1 2 3/] },
  30   or_or => { stmt => 'WHERE foo = ? OR bar = ? OR baz = ?', bind => [qw/1 2 3/] },
  31   and_or => { stmt => 'WHERE ( foo = ? AND bar = ? ) OR baz = ?', bind => [qw/1 2 3/] },
  32 };
  33
  34 my @and_or_tests = (
  35   # basic tests
  36   {
  37     where => { -and => [a => 1, b => 2] },
  38     %{$and_or_args->{and}},
  39   },
  40   {
  41     where => [ -and => [a => 1, b => 2] ],
  42     %{$and_or_args->{and}},
  43   },
  44   {
  45     where => { -or => [a => 1, b => 2] },
  46     %{$and_or_args->{or}},
  47   },
  48   {
  49     where => [ -or => [a => 1, b => 2] ],
  50     %{$and_or_args->{or}},
  51   },
  52
  53   # test modifiers within hashrefs
  54   {
  55     where => { -or => [
  56       [ foo => 1, bar => 2 ],
  57       baz => 3,
  58     ]},
  59     %{$and_or_args->{or_or}},
  60   },
  61   {
  62     where => { -and => [
  63       [ foo => 1, bar => 2 ],
  64       baz => 3,
  65     ]},
  66     %{$and_or_args->{or_and}},
  67   },
  68
  69   # test modifiers within arrayrefs
  70   {
  71     where => [ -or => [
  72       [ foo => 1, bar => 2 ],
  73       baz => 3,
  74     ]],
  75     %{$and_or_args->{or_or}},
  76   },
  77   {
  78     where => [ -and => [
  79       [ foo => 1, bar => 2 ],
  80       baz => 3,
  81     ]],
  82     %{$and_or_args->{or_and}},
  83   },
  84
  85   # test ambiguous modifiers within hashrefs (op extends to to immediate RHS only)
  86   {
  87     where => { -and => [ -or =>
  88       [ foo => 1, bar => 2 ],
  89       baz => 3,
  90     ]},
  91     %{$and_or_args->{or_and}},
  92   },
  93   {
  94     where => { -or => [ -and =>
  95       [ foo => 1, bar => 2 ],
  96       baz => 3,
  97     ]},
  98     %{$and_or_args->{and_or}},
  99   },
 100
 101   # test ambiguous modifiers within arrayrefs (op extends to to immediate RHS only)
 102   {
 103     where => [ -and => [ -or =>
 104       [ foo => 1, bar => 2 ],
 105       baz => 3,
 106     ]],
 107     %{$and_or_args->{or_and}},
 108   },
 109   {
 110     where => [ -or => [ -and =>
 111       [ foo => 1, bar => 2 ],
 112       baz => 3
 113     ]],
 114     %{$and_or_args->{and_or}},
 115   },
 116
 117   # the -or should affect only the next element
 118   {
 119     where => { x => {
 120       -or => { '!=', 1, '>=', 2 }, -like => 'x%'
 121     }},
 122     stmt => 'WHERE (x != ? OR x >= ?) AND x LIKE ?',
 123     bind => [qw/1 2 x%/],
 124   },
 125   # the -and should affect only the next element
 126   {
 127     where => { x => [
 128       -and => [ 1, 2 ], { -like => 'x%' }
 129     ]},
 130     stmt => 'WHERE (x = ? AND x = ?) OR x LIKE ?',
 131     bind => [qw/1 2 x%/],
 132   },
 133   {
 134     where => { -and => [a => 1, b => 2], x => 9, -or => { c => 3, d => 4 } },
 135     stmt => 'WHERE a = ? AND b = ? AND ( c = ? OR d = ? ) AND x = ?',
 136     bind => [qw/1 2 3 4 9/],
 137   },
 138   {
 139     where => { -and => [a => 1, b => 2, k => [11, 12] ], x => 9, -or => { c => 3, d => 4, l => { '=' => [21, 22] } } },
 140     stmt => 'WHERE a = ? AND b = ? AND (k = ? OR k = ?) AND ( l = ? OR l = ? OR c = ? OR d = ? ) AND x = ?',
 141     bind => [qw/1 2 11 12 21 22 3 4 9/],
 142   },
 143   {
 144     where => { -or => [a => 1, b => 2, k => [11, 12] ], x => 9, -and => { c => 3, d => 4, l => { '=' => [21, 22] } } },
 145     stmt => 'WHERE c = ? AND d = ? AND ( l = ? OR l = ?) AND (a = ? OR b = ? OR k = ? OR k = ?) AND x = ?',
 146     bind => [qw/3 4 21 22 1 2 11 12 9/],
 147   },
 148
 149   {
 150     # flip logic except where excplicitly requested otherwise
 151     args => { logic => 'or' },
 152     where => { -or => [a => 1, b => 2, k => [11, 12] ], x => 9, -and => { c => 3, d => 4, l => { '=' => [21, 22] } } },
 153     stmt => 'WHERE c = ? AND d = ? AND ( l = ? OR l = ?) AND (a = ? OR b = ? OR k = ? OR k = ?) AND x = ?',
 154     bind => [qw/3 4 21 22 1 2 11 12 9/],
 155   },
 156
 157   {
 158     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 }],
 159     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 = ?)',
 160     bind => [1 .. 13],
 161   },
 162   {
 163     # flip logic except where excplicitly requested otherwise
 164     args => { logic => 'and' },
 165     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 }],
 166     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 = ?',
 167     bind => [1 .. 13],
 168   },
 169
 170   ##########
 171   # some corner cases by ldami (some produce useless SQL, just for clarification on 1.5 direction)
 172   #
 173
 174   {
 175     where => { foo => [
 176       -and => [ { -like => 'foo%'}, {'>' => 'moo'} ],
 177       { -like => '%bar', '<' => 'baz'},
 178       [ {-like => '%alpha'}, {-like => '%beta'} ],
 179       -or => { '!=' => 'toto', '=' => 'koko' }
 180     ] },
 181     stmt => 'WHERE (foo LIKE ? AND foo > ?) OR (foo LIKE ? AND foo < ?) OR (foo LIKE ? OR foo LIKE ?) OR (foo != ? OR foo = ?)',
 182     bind => [qw/foo% moo %bar baz %alpha %beta toto koko/],
 183   },
 184   {
 185     where => [-and => [{foo => 1}, {bar => 2}, -or => {baz => 3 }] ],
 186     stmt => 'WHERE foo = ? AND bar = ? AND baz = ?',
 187     bind => [qw/1 2 3/],
 188   },
 189   {
 190     where => [-and => [{foo => 1}, {bar => 2}, -or => {baz => 3, boz => 4} ] ],
 191     stmt => 'WHERE foo = ? AND bar = ? AND (baz = ? OR boz = ?)',
 192     bind => [1 .. 4],
 193   },
 194
 195   # -and affects only the first {} thus a noop
 196   {
 197     where => { col => [ -and => {'<' => 123}, {'>' => 456 }, {'!=' => 789} ] },
 198     stmt => 'WHERE col < ? OR col > ? OR col != ?',
 199     bind => [qw/123 456 789/],
 200   },
 201
 202   # -and affects the entire inner [], thus 3 ANDs
 203   {
 204     where => { col => [ -and => [{'<' => 123}, {'>' => 456 }, {'!=' => 789}] ] },
 205     stmt => 'WHERE col < ? AND col > ? AND col != ?',
 206     bind => [qw/123 456 789/],
 207   },
 208 );
 209
 210 # modN and mod_N were a bad design decision - they go away in SQLA2, warn now
 211 my @numbered_mods = (
 212   {
 213     backcompat => {
 214       -and => [a => 10, b => 11],
 215       -and2 => [ c => 20, d => 21 ],
 216       -nest => [ x => 1 ],
 217       -nest2 => [ y => 2 ],
 218       -or => { m => 7, n => 8 },
 219       -or2 => { m => 17, n => 18 },
 220     },
 221     correct => { -and => [
 222       -and => [a => 10, b => 11],
 223       -and => [ c => 20, d => 21 ],
 224       -nest => [ x => 1 ],
 225       -nest => [ y => 2 ],
 226       -or => { m => 7, n => 8 },
 227       -or => { m => 17, n => 18 },
 228     ] },
 229   },
 230   {
 231     backcompat => {
 232       -and2 => [a => 10, b => 11],
 233       -and_3 => [ c => 20, d => 21 ],
 234       -nest2 => [ x => 1 ],
 235       -nest_3 => [ y => 2 ],
 236       -or2 => { m => 7, n => 8 },
 237       -or_3 => { m => 17, n => 18 },
 238     },
 239     correct => [ -and => [
 240       -and => [a => 10, b => 11],
 241       -and => [ c => 20, d => 21 ],
 242       -nest => [ x => 1 ],
 243       -nest => [ y => 2 ],
 244       -or => { m => 7, n => 8 },
 245       -or => { m => 17, n => 18 },
 246     ] ],
 247   },
 248 );
 249
 250 #can not be verified via is_same_sql_bind - need exact matching (parenthesis and all)
 251 my @nest_tests = ();
 252
 253 plan tests => @and_or_tests*3 + @numbered_mods*4;
 254
 255 for my $case (@and_or_tests) {
 256     local $Data::Dumper::Terse = 1;
 257
 258     my @w;
 259     local $SIG{__WARN__} = sub { push @w, @_ };
 260     my $sql = SQL::Abstract->new ($case->{args} || {});
 261     lives_ok (sub {
 262       my ($stmt, @bind) = $sql->where($case->{where});
 263       is_same_sql_bind(
 264         $stmt,
 265         \@bind,
 266         $case->{stmt},
 267         $case->{bind},
 268       )
 269         || diag "Search term:\n" . Dumper $case->{where};
 270     });
 271     is (@w, 0, 'No warnings within and-or tests')
 272       || diag join "\n", 'Emitted warnings:', @w;
 273 }
 274
 275 for my $case (@numbered_mods) {
 276     local $Data::Dumper::Terse = 1;
 277
 278     my @w;
 279     local $SIG{__WARN__} = sub { push @w, @_ };
 280     my $sql = SQL::Abstract->new ($case->{args} || {});
 281     lives_ok (sub {
 282       my ($old_s, @old_b) = $sql->where($case->{backcompat});
 283       my ($new_s, @new_b) = $sql->where($case->{correct});
 284       is_same_sql_bind(
 285         $old_s, \@old_b,
 286         $new_s, \@new_b,
 287         'Backcompat and the correct(tm) syntax result in identical statements',
 288       ) || diag "Search terms:\n" . Dumper {
 289           backcompat => $case->{backcompat},
 290           correct => $case->{correct},
 291         };
 292     });
 293
 294     ok (@w, 'Warnings were emitted about a mod_N construct');
 295
 296     my @non_match;
 297     for (@w) {
 298       push @non_match, $_
 299         if ($_ !~ /\Q
 300           Use of [and|or|nest]_N modifiers deprecated,
 301           instead use ...-and => [ mod => { }, mod => [] ... ]
 302         \E/x);
 303     }
 304
 305     is (@non_match, 0, 'All warnings match the deprecation message')
 306       || diag join "\n", 'Rogue warnings:', @non_match;
 307 }
 308