t/compat/ast/01.t

   1 use strict;
   2 use warnings;
   3
   4 use FindBin;
   5 use lib "$FindBin::Bin/../../lib";
   6 use SQLADumperSort;
   7
   8 use SQL::Abstract::Compat;
   9
  10 use Test::More tests => 17;
  11 use Test::Differences;
  12
  13 ok(my $visitor = SQL::Abstract::Compat->new);
  14
  15
  16 my $foo_id = { -type => 'identifier', elements => [qw/foo/] };
  17 my $bar_id = { -type => 'identifier', elements => [qw/bar/] };
  18
  19 my $foo_eq_1 = field_op_value($foo_id, '==', 1);
  20 my $bar_eq_str = field_op_value($bar_id, '==', 'some str');
  21
  22 eq_or_diff
  23   $visitor->recurse_where({ foo => 1 }),
  24   $foo_eq_1,
  25   "Single value hash";
  26
  27
  28
  29 eq_or_diff
  30   $visitor->recurse_where({ foo => 1, bar => 'some str' }),
  31   { -type => 'expr',
  32     op => 'and',
  33     args => [
  34       $bar_eq_str,
  35       $foo_eq_1,
  36     ]
  37   },
  38   "two keys in hash";
  39
  40 eq_or_diff
  41   $visitor->recurse_where({ -or => { foo => 1, bar => 'some str' } }),
  42   { -type => 'expr',
  43     op => 'or',
  44     args => [
  45       $bar_eq_str,
  46       $foo_eq_1,
  47     ]
  48   },
  49   "-or key in hash";
  50
  51
  52 eq_or_diff
  53   $visitor->recurse_where([ -and => { foo => 1, bar => 'some str' } ]),
  54   { -type => 'expr',
  55     op => 'and',
  56     args => [
  57       $bar_eq_str,
  58       $foo_eq_1,
  59     ]
  60   },
  61   "-and as first element of array";
  62
  63
  64 eq_or_diff
  65   $visitor->recurse_where([ -and => { foo => 1, bar => 'some str' }, { foo => 1} ]),
  66   { -type => 'expr',
  67     op => 'or',
  68     args => [
  69       { -type => 'expr',
  70         op => 'and',
  71         args => [
  72           $bar_eq_str,
  73           $foo_eq_1,
  74         ]
  75       },
  76       $foo_eq_1,
  77     ]
  78   },
  79   "-and as first element of array + hash";
  80
  81 eq_or_diff
  82   $visitor->recurse_where({ foo => { '!=' => 'bar' } }),
  83   field_op_value($foo_id, '!=', 'bar'),
  84   "foo => { '!=' => 'bar' }";
  85
  86 eq_or_diff
  87   $visitor->recurse_where({ foo => [ 1, 'bar' ] }),
  88   { -type => 'expr',
  89     op => 'or',
  90     args => [
  91       $foo_eq_1,
  92       field_op_value($foo_id, '==', 'bar'),
  93     ],
  94   },
  95   "foo => [ 1, 'bar' ]";
  96
  97 eq_or_diff
  98   $visitor->recurse_where({ foo => { -in => [ 1, 'bar' ] } }),
  99   { -type => 'expr',
 100     op => 'in',
 101     args => [
 102       $foo_id,
 103       { -type => 'value', value => 1 },
 104       { -type => 'value', value => 'bar' },
 105     ]
 106   },
 107   "foo => { -in => [ 1, 'bar' ] }";
 108
 109 eq_or_diff
 110   $visitor->recurse_where({ foo => { -not_in => [ 1, 'bar' ] } }),
 111   { -type => 'expr',
 112     op => 'not_in',
 113     args => [
 114       $foo_id,
 115       { -type => 'value', value => 1 },
 116       { -type => 'value', value => 'bar' },
 117     ]
 118   },
 119   "foo => { -not_in => [ 1, 'bar' ] }";
 120
 121 eq_or_diff
 122   $visitor->recurse_where({ foo => { -in => [ ] } }),
 123   { -type => 'expr',
 124     op => 'in',
 125     args => [
 126       $foo_id,
 127     ]
 128   },
 129   "foo => { -in => [ ] }";
 130
 131 my $worker_eq = sub {
 132   return {
 133     -type => 'expr',
 134     op => '==',
 135     args => [
 136       { -type => 'identifier', elements => ['worker'] },
 137       { -type => 'value', value => $_[0] },
 138     ],
 139   }
 140 };
 141
 142 eq_or_diff
 143   $visitor->recurse_where( {
 144     requestor => 'inna',
 145     worker => ['nwiger', 'rcwe', 'sfz'],
 146     status => { '!=', 'completed' }
 147   } ),
 148   { -type => 'expr',
 149     op => 'and',
 150     args => [
 151       field_op_value(qw/requestor == inna/),
 152       field_op_value(qw/status != completed/),
 153       { -type => 'expr',
 154         op => 'or',
 155         args => [
 156           field_op_value(qw/worker == nwiger/),
 157           field_op_value(qw/worker == rcwe/),
 158           field_op_value(qw/worker == sfz/),
 159         ]
 160       },
 161     ]
 162   },
 163   "complex expr 1";
 164
 165
 166 $visitor->convert('UPPER');
 167
 168 my $ticket_or_eq = {
 169   -type => 'expr',
 170   op => 'or',
 171   args => [
 172     field_op_value( upper(mk_name('ticket')), '==', upper(mk_value(11))),
 173     field_op_value( upper(mk_name('ticket')), '==', upper(mk_value(12))),
 174     field_op_value( upper(mk_name('ticket')), '==', upper(mk_value(13))),
 175   ]
 176 };
 177
 178 eq_or_diff
 179   $visitor->select_ast(
 180     'test', '*', [ { ticket => [11, 12, 13] } ]
 181   ),
 182   { -type => 'select',
 183     columns => [ { -type => 'identifier', elements => ['*'] } ],
 184     tablespec => { -type => 'identifier', elements => ['test'] },
 185     where => $ticket_or_eq
 186   },
 187   "Complex AST with convert('UPPER')";
 188
 189 my $hostname_and_ticket = {
 190   -type => 'expr',
 191   op => 'and',
 192   args => [
 193     field_op_value( upper(mk_name('hostname')),
 194                     in => [ map {
 195                       upper(mk_value($_))
 196                     } qw/ntf avd bvd 123/ ]
 197                   ),
 198     $ticket_or_eq,
 199   ]
 200 };
 201
 202 eq_or_diff
 203   $visitor->select_ast(
 204     'test', '*', [ { ticket => [11, 12, 13],
 205                      hostname => { in => ['ntf', 'avd', 'bvd', '123'] }
 206                    }
 207                  ]
 208   ),
 209   { -type => 'select',
 210     columns => [ { -type => 'identifier', elements => ['*'] } ],
 211     tablespec => { -type => 'identifier', elements => ['test'] },
 212     where => $hostname_and_ticket
 213   },
 214   "Complex AST mixing arrays+hashes with convert('UPPER')";
 215
 216 my $tack_between = {
 217   -type => 'expr',
 218   op => 'between',
 219   args => [
 220     upper(mk_name('tack')),
 221     upper(mk_value('tick')),
 222     upper(mk_value('tock')),
 223   ]
 224 };
 225
 226 eq_or_diff
 227   $visitor->select_ast(
 228     'test', '*', [ { ticket => [11, 12, 13],
 229                      hostname => { in => ['ntf', 'avd', 'bvd', '123'] }
 230                    },
 231                    { tack => { between => [qw/tick tock/] } }
 232                  ]
 233   ),
 234   { -type => 'select',
 235     columns => [ { -type => 'identifier', elements => ['*'] } ],
 236     tablespec => { -type => 'identifier', elements => ['test'] },
 237     where => {
 238       -type => 'expr',
 239       op => 'or',
 240       args => [
 241         $hostname_and_ticket,
 242         $tack_between,
 243       ]
 244     }
 245   },
 246   "Complex AST mixing [ {a => [1,2],b => 3}, { c => 4 }]";
 247
 248 my $a_or_eq = {
 249  -type => 'expr',
 250  op => 'or',
 251  args => [ map {
 252   { -type => 'expr', op => '==', args => [ upper(mk_name('a')), upper(mk_value($_)) ] }
 253  } qw/b c d/ ]
 254 };
 255
 256 my $e_ne = {
 257  -type => 'expr',
 258  op => 'or',
 259  args => [ map {
 260   { -type => 'expr', op => '!=', args => [ upper(mk_name('e')), upper(mk_value($_)) ] }
 261  } qw/f g/ ]
 262 };
 263
 264 eq_or_diff
 265   $visitor->select_ast(
 266     'test', '*', [ { ticket => [11, 12, 13],
 267                      hostname => { in => ['ntf', 'avd', 'bvd', '123'] }
 268                    },
 269                    { tack => { between => [qw/tick tock/] } },
 270                    { a => [qw/b c d/],
 271                      e => { '!=', [qw(f g)] },
 272                    }
 273                  ]
 274   ),
 275   { -type => 'select',
 276     columns => [ { -type => 'identifier', elements => ['*'] } ],
 277     tablespec => { -type => 'identifier', elements => ['test'] },
 278     where => {
 279       -type => 'expr',
 280       op => 'or',
 281       args => [
 282         $hostname_and_ticket,
 283         $tack_between,
 284         { -type => 'expr', op => 'and', args => [ $a_or_eq, $e_ne ] }
 285       ]
 286     }
 287   },
 288   "Complex AST mixing [ {a => [1,2],b => 3}, { c => 4 }, { d => [5,6,7], e => { '!=' => [8,9] } } ]";
 289
 290
 291 eq_or_diff
 292   $visitor->select_ast(
 293     'test', '*', [ { ticket => [11, 12, 13],
 294                      hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
 295                   { tack => { between => [qw/tick tock/] } },
 296                   { a => [qw/b c d/],
 297                     e => { '!=', [qw(f g)] },
 298                     q => { 'not in', [14..20] }
 299                   }
 300                  ]
 301   ),
 302   { -type => 'select',
 303     columns => [ { -type => 'identifier', elements => ['*'] } ],
 304     tablespec => { -type => 'identifier', elements => ['test'] },
 305     where => {
 306       -type => 'expr',
 307       op => 'or',
 308       args => [
 309         $hostname_and_ticket,
 310         $tack_between,
 311         { -type => 'expr', op => 'and', args => [
 312           $a_or_eq,
 313           $e_ne,
 314           { -type => 'expr',
 315             op => 'not_in',
 316             args => [
 317               upper(mk_name('q')),
 318               map { upper(mk_value($_)) } 14..20
 319             ]
 320           }
 321         ] }
 322       ]
 323     }
 324   },
 325   "Complex AST [ {a => [1,2],b => 3}, { c => 4 }, { d => [5,6,7], e => { '!=' => [8,9] }, q => {'not in' => [10,11] } } ]";
 326
 327 sub field_op_value {
 328   my ($field, $op, $value) = @_;
 329
 330   $field = ref $field eq 'HASH'
 331          ? $field
 332          : ref $field eq 'ARRAY'
 333          ? { -type => 'identifier', elements => $field }
 334          : { -type => 'identifier', elements => [$field] };
 335
 336   my @value = ref $value eq 'HASH'
 337             ? $value
 338             : ref $value eq 'ARRAY'
 339             ? @$value
 340             : { -type => 'value', value => $value };
 341
 342   return {
 343     -type => 'expr',
 344     op => $op,
 345     args => [
 346       $field,
 347       @value
 348     ]
 349   };
 350 }
 351
 352 sub upper { expr(UPPER => @_) }
 353
 354 sub expr {
 355   my ($op, @args) = @_;
 356
 357   return {
 358     -type => 'expr',
 359     op => $op,
 360     args => [@args]
 361   };
 362 }
 363
 364 sub mk_name {
 365   my ($field) = @_;
 366   $field = ref $field eq 'HASH'
 367          ? $field
 368          : ref $field eq 'ARRAY'
 369          ? { -type => 'identifier', elements => $field }
 370          : { -type => 'identifier', elements => [$field] };
 371   return $field;
 372 }
 373
 374 sub mk_value {
 375   return { -type => 'value', value => $_[0] }
 376 }