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