lib/SQL/Abstract/ExtraClauses.pm

   1 package SQL::Abstract::ExtraClauses;
   2
   3 use Moo;
   4
   5 has sqla => (
   6   is => 'ro', init_arg => undef,
   7   handles => [ qw(
   8     expand_expr render_aqt join_query_parts
   9   ) ],
  10 );
  11
  12 sub cb {
  13   my ($self, $method, @args) = @_;
  14   return sub {
  15     local $self->{sqla} = shift;
  16     $self->$method(@args, @_)
  17   };
  18 }
  19
  20 sub register {
  21   my ($self, @pairs) = @_;
  22   my $sqla = $self->sqla;
  23   while (my ($method, $cases) = splice(@pairs, 0, 2)) {
  24     my @cases = @$cases;
  25     while (my ($name, $case) = splice(@cases, 0, 2)) {
  26       $sqla->$method($name, $self->cb($case));
  27     }
  28   }
  29   return $self;
  30 }
  31
  32 sub apply_to {
  33   my ($self, $sqla) = @_;
  34   $self = $self->new unless ref($self);
  35   local $self->{sqla} = $sqla;
  36   $self->register_extensions($sqla);
  37 }
  38
  39 sub register_extensions {
  40   my ($self, $sqla) = @_;
  41
  42   my @clauses = $sqla->clauses_of('select');
  43   my @before_setop;
  44   CLAUSE: foreach my $idx (0..$#clauses) {
  45     if ($clauses[$idx] eq 'order_by') {
  46       @before_setop = @clauses[0..$idx-1];
  47       splice(@clauses, $idx, 0, qw(setop group_by having));
  48       last CLAUSE;
  49     }
  50   }
  51
  52   die "Huh?" unless @before_setop;
  53   $sqla->clauses_of(select => @clauses);
  54
  55   $sqla->clauses_of(update => sub {
  56     my ($self, @clauses) = @_;
  57     splice(@clauses, 2, 0, 'from');
  58     @clauses;
  59   });
  60
  61   $sqla->clauses_of(delete => sub {
  62     my ($self, @clauses) = @_;
  63     splice(@clauses, 1, 0, 'using');
  64     @clauses;
  65   });
  66
  67   $self->register(
  68     (map +(
  69       "${_}er" => [
  70         do {
  71           my $x = $_;
  72           (map +($_ => "_${x}_${_}"), qw(join from_list alias))
  73         }
  74        ]
  75     ), qw(expand render)),
  76     binop_expander => [ as => '_expand_op_as' ],
  77     renderer => [ as => '_render_as' ],
  78     expander => [ cast => '_expand_cast' ],
  79     clause_expanders => [
  80       "select.from", '_expand_from_list',
  81       'select.group_by'
  82         => sub { $_[0]->expand_expr({ -list => $_[2] }, -ident) },
  83       'select.having'
  84         => sub { $_[0]->expand_expr($_[2]) },
  85       'update.from' => '_expand_from_list',
  86       "update.target", '_expand_update_clause_target',
  87       "update.update", '_expand_update_clause_target',
  88       'delete.using' => '_expand_from_list',
  89       'insert.rowvalues' => sub {
  90         +(from => $_[0]->expand_expr({ -values => $_[2] }));
  91       },
  92       'insert.select' => sub {
  93         +(from => $_[0]->expand_expr({ -select => $_[2] }));
  94       },
  95     ],
  96   );
  97
  98   # set ops
  99   $sqla->wrap_expander(select => sub {
 100     $self->cb('_expand_select', $_[0], \@before_setop);
 101   });
 102
 103   $self->register(
 104     clause_renderer => [
 105       'select.setop' => sub { $_[0]->render_aqt($_[2]) }
 106     ],
 107     expander => [
 108       map +($_ => '_expand_setop', "${_}_all" => '_expand_setop'), qw(union intersect except) ],
 109     renderer => [ map +($_ => '_render_setop'), qw(union intersect except) ],
 110   );
 111
 112   my $setop_expander = $self->cb('_expand_clause_setop');
 113
 114   $sqla->clause_expanders(
 115     map +($_ => $setop_expander),
 116       map "select.${_}",
 117         map +($_, "${_}_all", "${_}_distinct"),
 118           qw(union intersect except)
 119   );
 120
 121   foreach my $stmt (qw(select insert update delete)) {
 122     $sqla->clauses_of($stmt => 'with', $sqla->clauses_of($stmt));
 123     $self->register(
 124       clause_expanders => [
 125         "${stmt}.with" => '_expand_with',
 126         "${stmt}.with_recursive" => '_expand_with',
 127       ],
 128       clause_renderer => [ "${stmt}.with" => '_render_with' ],
 129     );
 130   }
 131
 132   return $sqla;
 133 }
 134
 135 sub _expand_select {
 136   my ($self, $orig, $before_setop, @args) = @_;
 137   my $exp = $self->sqla->$orig(@args);
 138   return $exp unless my $setop = (my $sel = $exp->{-select})->{setop};
 139   if (my @keys = grep $sel->{$_}, @$before_setop) {
 140     my %inner; @inner{@keys} = delete @{$sel}{@keys};
 141     unshift @{(values(%$setop))[0]{queries}},
 142       { -select => \%inner };
 143   }
 144   return $exp;
 145 }
 146
 147 sub _expand_from_list {
 148   my ($self, undef, $args) = @_;
 149   if (ref($args) eq 'HASH') {
 150     return $args if $args->{-from_list};
 151     return { -from_list => [ $self->expand_expr($args) ] };
 152   }
 153   my @list;
 154   my @args = ref($args) eq 'ARRAY' ? @$args : ($args);
 155   while (my $entry = shift @args) {
 156     if (!ref($entry) and $entry =~ /^-(.*)/) {
 157       if ($1 eq 'as') {
 158         $list[-1] = $self->expand_expr({ -as => [
 159           $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args)
 160         ]});
 161         next;
 162       }
 163       $entry = { $entry => shift @args };
 164     }
 165     my $aqt = $self->expand_expr($entry, -ident);
 166     if ($aqt->{-join} and not $aqt->{-join}{from}) {
 167       $aqt->{-join}{from} = pop @list;
 168     }
 169     push @list, $aqt;
 170   }
 171   return $list[0] if @list == 1;
 172   return { -from_list => \@list };
 173 }
 174
 175 sub _expand_join {
 176   my ($self, undef, $args) = @_;
 177   my %proto = (
 178     ref($args) eq 'HASH'
 179       ? %$args
 180       : (to => @$args)
 181   );
 182   if (my $as = delete $proto{as}) {
 183     $proto{to} = $self->expand_expr(
 184                    { -as => [ { -from_list => $proto{to} }, $as ] }
 185                  );
 186   }
 187   if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') {
 188     $proto{using} = [
 189       map [ $self->expand_expr($_, -ident) ],
 190         ref($using) eq 'ARRAY' ? @$using: $using
 191     ];
 192   }
 193   my %ret = (
 194     type => delete $proto{type},
 195     to => $self->expand_expr({ -from_list => delete $proto{to} }, -ident)
 196   );
 197   %ret = (%ret,
 198     map +($_ => $self->expand_expr($proto{$_}, -ident)),
 199       sort keys %proto
 200   );
 201   return +{ -join => \%ret };
 202 }
 203
 204 sub _render_from_list {
 205   my ($self, undef, $list) = @_;
 206   return $self->join_query_parts(', ', @$list);
 207 }
 208
 209 sub _render_join {
 210   my ($self, undef, $args) = @_;
 211
 212   my @parts = (
 213     $args->{from},
 214     { -keyword => join '_', ($args->{type}||()), 'join' },
 215     (map +($_->{-ident} || $_->{-as}
 216       ? $_
 217       : ('(', $self->render_aqt($_, 1), ')')),
 218         map +(@{$_->{-from_list}||[]} == 1 ? $_->{-from_list}[0] : $_),
 219           $args->{to}
 220     ),
 221     ($args->{on} ? (
 222       { -keyword => 'on' },
 223       $args->{on},
 224     ) : ()),
 225     ($args->{using} ? (
 226       { -keyword => 'using' },
 227       '(', $args->{using}, ')',
 228     ) : ()),
 229   );
 230   return $self->join_query_parts(' ', @parts);
 231 }
 232
 233 sub _expand_op_as {
 234   my ($self, undef, $vv, $k) = @_;
 235   my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv);
 236   my $ik = $self->expand_expr($k, -ident);
 237   return +{ -as => [ $ik, $self->expand_expr($vv[0], -ident) ] }
 238     if @vv == 1 and ref($vv[0]) eq 'HASH';
 239
 240   my @as = map $self->expand_expr($_, -ident), @vv;
 241   return { -as => [ $ik, $self->expand_expr({ -alias => \@as }) ] };
 242 }
 243
 244 sub _render_as {
 245   my ($self, undef, $args) = @_;
 246   my ($thing, $alias) = @$args;
 247   return $self->join_query_parts(
 248     ' ',
 249     $thing,
 250     { -keyword => 'as' },
 251     $alias,
 252   );
 253 }
 254
 255 sub _render_alias {
 256   my ($self, undef, $args) = @_;
 257   my ($as, @cols) = @$args;
 258   return (@cols
 259     ? $self->join_query_parts('',
 260          $as,
 261          '(',
 262          $self->join_query_parts(
 263            ', ',
 264            @cols
 265          ),
 266          ')',
 267       )
 268     : $self->render_aqt($as)
 269   );
 270 }
 271
 272 sub _expand_update_clause_target {
 273   my ($self, undef, $target) = @_;
 274   +(target => $self->_expand_from_list(undef, $target));
 275 }
 276
 277 sub _expand_cast {
 278   my ($self, undef, $thing) = @_;
 279   return { -func => [ cast => $thing ] } if ref($thing) eq 'HASH';
 280   my ($cast, $to) = @{$thing};
 281   +{ -func => [ cast => { -as => [
 282     $self->expand_expr($cast),
 283     $self->expand_expr($to, -ident),
 284   ] } ] };
 285 }
 286
 287 sub _expand_alias {
 288   my ($self, undef, $args) = @_;
 289   if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) {
 290     $args = $alias;
 291   }
 292   my @parts = map $self->expand_expr($_, -ident),
 293                 ref($args) eq 'ARRAY' ? @{$args} : $args;
 294   return $parts[0] if @parts == 1;
 295   return { -alias => \@parts };
 296 }
 297
 298 sub _expand_with {
 299   my ($self, $name, $with) = @_;
 300   my (undef, $type) = split '_', $name;
 301   if (ref($with) eq 'HASH') {
 302     return +{
 303       %$with,
 304       queries => [
 305         map +[
 306           $self->expand_expr({ -alias => $_->[0] }, -ident),
 307           $self->expand_expr($_->[1]),
 308         ], @{$with->{queries}}
 309       ]
 310     }
 311   }
 312   my @with = @$with;
 313   my @exp;
 314   while (my ($alias, $query) = splice @with, 0, 2) {
 315     push @exp, [
 316       $self->expand_expr({ -alias => $alias }, -ident),
 317       $self->expand_expr($query)
 318     ];
 319   }
 320   return +(with => { ($type ? (type => $type) : ()), queries => \@exp });
 321 }
 322
 323 sub _render_with {
 324   my ($self, undef, $with) = @_;
 325   my $q_part = $self->join_query_parts(', ',
 326     map {
 327       my ($alias, $query) = @$_;
 328       $self->join_query_parts(' ',
 329           $alias,
 330           { -keyword => 'as' },
 331           $query,
 332       )
 333     } @{$with->{queries}}
 334   );
 335   return $self->join_query_parts(' ',
 336     { -keyword => join '_', 'with', ($with->{type}||'') },
 337     $q_part,
 338   );
 339 }
 340
 341 sub _expand_setop {
 342   my ($self, $setop, $args) = @_;
 343   my $is_all = $setop =~ s/_all$//;
 344   +{ "-${setop}" => {
 345        ($is_all ? (type => 'all') : ()),
 346        (ref($args) eq 'ARRAY'
 347           ? (queries => [ map $self->expand_expr($_), @$args ])
 348           : (
 349               %$args,
 350               queries => [ map $self->expand_expr($_), @{$args->{queries}} ]
 351             )
 352        ),
 353   } };
 354 }
 355
 356 sub _render_setop {
 357   my ($self, $setop, $args) = @_;
 358   $self->join_query_parts(
 359     { -keyword => ' '.join('_', $setop, ($args->{type}||())).' ' },
 360     @{$args->{queries}}
 361   );
 362 }
 363
 364 sub _expand_clause_setop {
 365   my ($self, $setop, $args) = @_;
 366   my ($op, $type) = split '_', $setop;
 367   +(setop => $self->expand_expr({
 368     "-${op}" => {
 369       ($type ? (type => $type) : ()),
 370       queries => (ref($args) eq 'ARRAY' ? $args : [ $args ])
 371     }
 372   }));
 373 }
 374
 375 1;
 376
 377 __END__
 378
 379 =head1 NAME
 380
 381 SQL::Abstract::ExtraClauses - new/experimental additions to L<SQL::Abstract>
 382
 383 =head1 SYNOPSIS
 384
 385   my $sqla = SQL::Abstract->new;
 386   SQL::Abstract::ExtraClauses->apply_to($sqla);
 387
 388 =head1 WARNING
 389
 390 This module is basically a nursery for things that seem like a good idea
 391 to live in until we figure out if we were right about that.
 392
 393 =head1 METHODS
 394
 395 =head2 apply_to
 396
 397 Applies the plugin to an L<SQL::Abstract> object.
 398
 399 =head2 register_extensions
 400
 401 Registers the extensions described below
 402
 403 =head2 cb
 404
 405 For plugin authors, creates a callback to call a method on the plugin.
 406
 407 =head2 register
 408
 409 For plugin authors, registers callbacks more easily.
 410
 411 =head2 sqla
 412
 413 Available only during plugin callback executions, contains the currently
 414 active L<SQL::Abstract> object.
 415
 416 =head1 NODE TYPES
 417
 418 =head2 alias
 419
 420 Represents a table alias. Expands name and column names with ident as default.
 421
 422   # expr
 423   { -alias => [ 't', 'x', 'y', 'z' ] }
 424
 425   # aqt
 426   { -alias => [
 427       { -ident => [ 't' ] }, { -ident => [ 'x' ] },
 428       { -ident => [ 'y' ] }, { -ident => [ 'z' ] },
 429   ] }
 430
 431   # query
 432   t(x, y, z)
 433   []
 434
 435 =head2 as
 436
 437 Represents an sql AS. LHS is expanded with ident as default, RHS is treated
 438 as a list of arguments for the alias node.
 439
 440   # expr
 441   { foo => { -as => 'bar' } }
 442
 443   # aqt
 444   { -as => [ { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] }
 445
 446   # query
 447   foo AS bar
 448   []
 449
 450   # expr
 451   { -as => [ { -select => { _ => 'blah' } }, 't', 'blah' ] }
 452
 453   # aqt
 454   { -as => [
 455       { -select =>
 456           { select => { -op => [ ',', { -ident => [ 'blah' ] } ] } }
 457       },
 458       { -alias => [ { -ident => [ 't' ] }, { -ident => [ 'blah' ] } ] },
 459   ] }
 460
 461   # query
 462   (SELECT blah) AS t(blah)
 463   []
 464
 465 =head2 cast
 466
 467   # expr
 468   { -cast => [ { -ident => 'birthday' }, 'date' ] }
 469
 470   # aqt
 471   { -func => [
 472       'cast', {
 473         -as => [ { -ident => [ 'birthday' ] }, { -ident => [ 'date' ] } ]
 474       },
 475   ] }
 476
 477   # query
 478   CAST(birthday AS date)
 479   []
 480
 481 =head2 join
 482
 483 If given an arrayref, pretends it was given a hashref with the first
 484 element of the arrayref as the value for 'to' and the remaining pairs copied.
 485
 486 Given a hashref, the 'as' key is if presented expanded to wrap the 'to'.
 487
 488 If present the 'using' key is expanded as a list of idents.
 489
 490 Known keys are: 'from' (the left hand side), 'type' ('left', 'right', or
 491 nothing), 'to' (the right hand side), 'on' and 'using'.
 492
 493   # expr
 494   { -join => {
 495       from => 'lft',
 496       on => { 'lft.bloo' => { '>' => 'rgt.blee' } },
 497       to => 'rgt',
 498       type => 'left',
 499   } }
 500
 501   # aqt
 502   { -join => {
 503       from => { -ident => [ 'lft' ] },
 504       on => { -op => [
 505           '>', { -ident => [ 'lft', 'bloo' ] },
 506           { -ident => [ 'rgt', 'blee' ] },
 507       ] },
 508       to => { -ident => [ 'rgt' ] },
 509       type => 'left',
 510   } }
 511
 512   # query
 513   lft LEFT JOIN rgt ON lft.bloo > rgt.blee
 514   []
 515
 516 =head2 from_list
 517
 518 List of components of the FROM clause; -foo type elements indicate a pair
 519 with the next element; this is easiest if I show you:
 520
 521   # expr
 522   { -from_list => [
 523       't1', -as => 'table_one', -join =>
 524       [ 't2', 'on', { 'table_one.x' => 't2.x' } ],
 525   ] }
 526
 527   # aqt
 528   { -join => {
 529       from =>
 530         {
 531           -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
 532         },
 533       on => { -op => [
 534           '=', { -ident => [ 'table_one', 'x' ] },
 535           { -ident => [ 't2', 'x' ] },
 536       ] },
 537       to => { -ident => [ 't2' ] },
 538       type => undef,
 539   } }
 540
 541   # query
 542   t1 AS table_one JOIN t2 ON table_one.x = t2.x
 543   []
 544
 545 Or with using:
 546
 547   # expr
 548   { -from_list =>
 549       [ 't1', -as => 'table_one', -join => [ 't2', 'using', [ 'x' ] ] ]
 550   }
 551
 552   # aqt
 553   { -join => {
 554       from =>
 555         {
 556           -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
 557         },
 558       to => { -ident => [ 't2' ] },
 559       type => undef,
 560       using =>
 561         { -op => [ 'or', { -op => [ 'or', { -ident => [ 'x' ] } ] } ] },
 562   } }
 563
 564   # query
 565   t1 AS table_one JOIN t2 USING ( x )
 566   []
 567
 568 With oddities:
 569
 570   # expr
 571   { -from_list => [
 572       'x', -join =>
 573       [ [ 'y', -join => [ 'z', 'type', 'left' ] ], 'type', 'left' ],
 574   ] }
 575
 576   # aqt
 577   { -join => {
 578       from => { -ident => [ 'x' ] },
 579       to => { -join => {
 580           from => { -ident => [ 'y' ] },
 581           to => { -ident => [ 'z' ] },
 582           type => 'left',
 583       } },
 584       type => 'left',
 585   } }
 586
 587   # query
 588   x LEFT JOIN ( y LEFT JOIN z )
 589   []
 590
 591 =head2 setops
 592
 593 Expanders are provided for union, union_all, intersect, intersect_all,
 594 except and except_all, and each takes an arrayref of queries:
 595
 596   # expr
 597   { -union => [
 598       { -select => { _ => { -value => 1 } } },
 599       { -select => { _ => { -value => 2 } } },
 600   ] }
 601
 602   # aqt
 603   { -union => { queries => [
 604         { -select =>
 605             { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
 606         },
 607         { -select =>
 608             { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
 609         },
 610   ] } }
 611
 612   # query
 613   (SELECT ?) UNION (SELECT ?)
 614   [ 1, 2 ]
 615
 616   # expr
 617   { -union_all => [
 618       { -select => { _ => { -value => 1 } } },
 619       { -select => { _ => { -value => 2 } } },
 620       { -select => { _ => { -value => 1 } } },
 621   ] }
 622
 623   # aqt
 624   { -union => {
 625       queries => [
 626         { -select =>
 627             { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
 628         },
 629         { -select =>
 630             { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
 631         },
 632         { -select =>
 633             { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
 634         },
 635       ],
 636       type => 'all',
 637   } }
 638
 639   # query
 640   (SELECT ?) UNION ALL (SELECT ?) UNION ALL (SELECT ?)
 641   [ 1, 2, 1 ]
 642
 643 =head1 STATEMENT EXTENSIONS
 644
 645 =head2 group by clause for select
 646
 647 Expanded as a list with an ident default:
 648
 649   # expr
 650   { -select => { group_by => [ 'foo', 'bar' ] } }
 651
 652   # aqt
 653   { -select => { group_by =>
 654         {
 655           -op => [ ',', { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ]
 656         }
 657   } }
 658
 659   # query
 660   GROUP BY foo, bar
 661   []
 662
 663 =head2 having clause for select
 664
 665 Basic expr, just like where, given having is pretty much post-group-by
 666 where clause:
 667
 668   # expr
 669   { -select =>
 670       { having => { '>' => [ { -count => { -ident => 'foo' } }, 3 ] } }
 671   }
 672
 673   # aqt
 674   { -select => { having => { -op => [
 675           '>', { -func => [ 'count', { -ident => [ 'foo' ] } ] },
 676           { -bind => [ undef, 3 ] },
 677   ] } } }
 678
 679   # query
 680   HAVING COUNT(foo) > ?
 681   [ 3 ]
 682
 683 =head2 setop clauses
 684
 685 If a select query contains a clause matching any of the setop node types,
 686 clauses that appear before the setop would in the resulting query are
 687 gathered together and moved into an inner select node:
 688
 689   # expr
 690   { -select => {
 691       _ => '*',
 692       from => 'foo',
 693       order_by => 'baz',
 694       union =>
 695         {
 696           -select => { _ => '*', from => 'bar', where => { thing => 1 } }
 697         },
 698       where => { thing => 1 },
 699   } }
 700
 701   # aqt
 702   { -select => {
 703       order_by => { -op => [ ',', { -ident => [ 'baz' ] } ] },
 704       setop => { -union => { queries => [
 705             { -select => {
 706                 from => { -ident => [ 'foo' ] },
 707                 select => { -op => [ ',', { -ident => [ '*' ] } ] },
 708                 where => { -op => [
 709                     '=', { -ident => [ 'thing' ] },
 710                     { -bind => [ 'thing', 1 ] },
 711                 ] },
 712             } },     ] },
 713             { -select => {
 714                 from => { -ident => [ 'bar' ] },
 715                 select => { -op => [ ',', { -ident => [ '*' ] } ] },
 716                 where => { -op => [
 717                     '=', { -ident => [ 'thing' ] },
 718                     { -bind => [ 'thing', 1 ] },
 719             } },
 720       ] } },
 721   } }
 722
 723   # query
 724   (SELECT * FROM foo WHERE thing = ?) UNION (
 725     SELECT * FROM bar WHERE thing = ?
 726   )
 727   ORDER BY baz
 728   [ 1, 1 ]
 729
 730 =head2 update from clause
 731
 732 Some databases allow an additional FROM clause to reference other tables
 733 for the data to update; this clause is expanded as a normal from list, check
 734 your database for what is and isn't allowed in practice.
 735
 736   # expr
 737   { -update => {
 738       _ => 'employees',
 739       from => 'accounts',
 740       set => { sales_count => { sales_count => { '+' => \1 } } },
 741       where => {
 742         'accounts.name' => { '=' => \"'Acme Corporation'" },
 743         'employees.id' => { -ident => 'accounts.sales_person' },
 744       },
 745   } }
 746
 747   # aqt
 748   { -update => {
 749       from => { -ident => [ 'accounts' ] },
 750       set => { -op => [
 751           ',', { -op => [
 752               '=', { -ident => [ 'sales_count' ] }, { -op => [
 753                   '+', { -ident => [ 'sales_count' ] },
 754                   { -literal => [ 1 ] },
 755               ] },
 756           ] },
 757       ] },
 758       target => { -ident => [ 'employees' ] },
 759       where => { -op => [
 760           'and', { -op => [
 761               '=', { -ident => [ 'accounts', 'name' ] },
 762               { -literal => [ "'Acme Corporation'" ] },
 763           ] }, { -op => [
 764               '=', { -ident => [ 'employees', 'id' ] },
 765               { -ident => [ 'accounts', 'sales_person' ] },
 766           ] },
 767       ] },
 768   } }
 769
 770   # query
 771   UPDATE employees SET sales_count = sales_count + 1 FROM accounts
 772   WHERE (
 773     accounts.name = 'Acme Corporation'
 774     AND employees.id = accounts.sales_person
 775   )
 776   []
 777
 778 =head2 delete using clause
 779
 780 Some databases allow an additional USING clause to reference other tables
 781 for the data to update; this clause is expanded as a normal from list, check
 782 your database for what is and isn't allowed in practice.
 783
 784   # expr
 785   { -delete => {
 786       from => 'x',
 787       using => 'y',
 788       where => { 'x.id' => { -ident => 'y.x_id' } },
 789   } }
 790
 791   # aqt
 792   { -delete => {
 793       target => { -op => [ ',', { -ident => [ 'x' ] } ] },
 794       using => { -ident => [ 'y' ] },
 795       where => { -op => [
 796           '=', { -ident => [ 'x', 'id' ] },
 797           { -ident => [ 'y', 'x_id' ] },
 798       ] },
 799   } }
 800
 801   # query
 802   DELETE FROM x USING y WHERE x.id = y.x_id
 803   []
 804
 805 =head2 insert rowvalues and select clauses
 806
 807 rowvalues and select are shorthand for
 808
 809   { from => { -select ... } }
 810
 811 and
 812
 813   { from => { -values ... } }
 814
 815 respectively:
 816
 817   # expr
 818   { -insert =>
 819       { into => 'numbers', rowvalues => [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] }
 820   }
 821
 822   # aqt
 823   { -insert => {
 824       from => { -values => [
 825           { -row =>
 826               [ { -bind => [ undef, 1 ] }, { -bind => [ undef, 2 ] } ]
 827           },
 828           { -row =>
 829               [ { -bind => [ undef, 3 ] }, { -bind => [ undef, 4 ] } ]
 830           },
 831           { -row =>
 832               [ { -bind => [ undef, 5 ] }, { -bind => [ undef, 6 ] } ]
 833           },
 834       ] },
 835       target => { -ident => [ 'numbers' ] },
 836   } }
 837
 838   # query
 839   INSERT INTO numbers VALUES (?, ?), (?, ?), (?, ?)
 840   [ 1, 2, 3, 4, 5, 6 ]
 841
 842   # expr
 843   { -insert =>
 844       { into => 'numbers', select => { _ => '*', from => 'old_numbers' } }
 845   }
 846
 847   # aqt
 848   { -insert => {
 849       from => { -select => {
 850           from => { -ident => [ 'old_numbers' ] },
 851           select => { -op => [ ',', { -ident => [ '*' ] } ] },
 852       } },
 853       target => { -ident => [ 'numbers' ] },
 854   } }
 855
 856   # query
 857   INSERT INTO numbers SELECT * FROM old_numbers
 858   []
 859
 860 =head2 with and with_recursive clauses
 861
 862 These clauses are available on select/insert/update/delete queries; check
 863 your database for applicability (e.g. mysql supports all four but mariadb
 864 only select).
 865
 866 The value should be an arrayref of name/query pairs:
 867
 868   # expr
 869   { -select => {
 870       from => 'foo',
 871       select => '*',
 872       with => [ 'foo', { -select => { select => \1 } } ],
 873   } }
 874
 875   # aqt
 876   { -select => {
 877       from => { -ident => [ 'foo' ] },
 878       select => { -op => [ ',', { -ident => [ '*' ] } ] },
 879       with => { queries => [ [
 880             { -ident => [ 'foo' ] }, { -select =>
 881                 { select => { -op => [ ',', { -literal => [ 1 ] } ] } }
 882             },
 883       ] ] },
 884   } }
 885
 886   # query
 887   WITH foo AS (SELECT 1) SELECT * FROM foo
 888   []
 889
 890 A more complete example (designed for mariadb, (ab)using the fact that
 891 mysqloids materialise subselects in FROM into an unindexed temp table to
 892 circumvent the restriction that you can't select from the table you're
 893 currently updating:
 894
 895   # expr
 896   { -update => {
 897       _ => [
 898         'tree_table', -join => {
 899           as => 'tree',
 900           on => { 'tree.id' => 'tree_with_path.id' },
 901           to => { -select => {
 902               from => 'tree_with_path',
 903               select => '*',
 904               with_recursive => [
 905                 [ 'tree_with_path', 'id', 'parent_id', 'path' ],
 906                 { -select => {
 907                     _ => [
 908                       'id', 'parent_id', { -as => [
 909                           { -cast => { -as => [ 'id', 'char', 255 ] } },
 910                           'path',
 911                       ] } ],
 912                     from => 'tree_table',
 913                     union_all => { -select => {
 914                         _ => [
 915                           't.id', 't.parent_id', { -as => [
 916                               { -concat => [ 'r.path', \"'/'", 't.id' ] },
 917                               'path',
 918                           ] },
 919                         ],
 920                         from => [
 921                           'tree_table', -as => 't', -join => {
 922                             as => 'r',
 923                             on => { 't.parent_id' => 'r.id' },
 924                             to => 'tree_with_path',
 925                           },
 926                         ],
 927                     } },
 928                     where => { parent_id => undef },
 929                 } },
 930               ],
 931           } },
 932         },
 933       ],
 934       set => { path => { -ident => [ 'tree', 'path' ] } },
 935   } }
 936
 937   # query
 938   UPDATE
 939     tree_table JOIN
 940     (
 941       WITH RECURSIVE
 942         tree_with_path(id, parent_id, path) AS (
 943           (
 944             SELECT id, parent_id, CAST(id AS char(255)) AS path
 945             FROM tree_table WHERE parent_id IS NULL
 946           ) UNION ALL (
 947             SELECT t.id, t.parent_id, CONCAT(r.path, '/', t.id) AS path
 948             FROM
 949               tree_table AS t JOIN tree_with_path AS r ON
 950               t.parent_id = r.id
 951           )
 952         )
 953       SELECT * FROM tree_with_path
 954     ) AS tree
 955     ON tree.id = tree_with_path.id
 956   SET path = tree.path
 957   []
 958
 959 =cut