1 package SQL::Abstract::Plugin::ExtraClauses;
5 with 'SQL::Abstract::Role::Plugin';
7 sub register_extensions {
8 my ($self, $sqla) = @_;
10 my @clauses = $sqla->clauses_of('select');
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));
20 die "Huh?" unless @before_setop;
21 $sqla->clauses_of(select => @clauses);
23 $sqla->clauses_of(update => sub {
24 my ($self, @clauses) = @_;
25 splice(@clauses, 2, 0, 'from');
29 $sqla->clauses_of(delete => sub {
30 my ($self, @clauses) = @_;
31 splice(@clauses, 1, 0, 'using');
40 (map +($_ => "_${x}_${_}"), qw(join from_list alias))
43 ), qw(expand render)),
44 binop_expander => [ as => '_expand_op_as' ],
45 renderer => [ as => '_render_as' ],
46 expander => [ cast => '_expand_cast' ],
49 => sub { $_[0]->expand_expr({ -list => $_[2] }, -ident) },
51 => sub { $_[0]->expand_expr($_[2]) },
52 'update.from' => '_expand_from_list',
53 "update.target", '_expand_update_clause_target',
54 "update.update", '_expand_update_clause_target',
55 'delete.using' => '_expand_from_list',
56 'insert.rowvalues' => sub {
57 +(from => $_[0]->expand_expr({ -values => $_[2] }));
59 'insert.select' => sub {
60 +(from => $_[0]->expand_expr({ -select => $_[2] }));
65 $sqla->expander(old_from => $sqla->clause_expander('select.from'));
66 $sqla->wrap_clause_expander('select.from', sub {
69 my ($sqla, undef, $args) = @_;
70 if (ref($args) eq 'HASH') {
71 return $self->_expand_from_list(undef, $args);
75 and grep { !ref($_) and $_ =~ /^-/ } @$args
77 return $self->_expand_from_list(undef, $args);
79 return $sqla->$orig(undef, $args);
84 $sqla->wrap_expander(select => sub {
85 $self->cb('_expand_select', $_[0], \@before_setop);
90 'select.setop' => sub { $_[0]->render_aqt($_[2]) }
93 map +($_ => '_expand_setop', "${_}_all" => '_expand_setop'), qw(union intersect except) ],
94 renderer => [ map +($_ => '_render_setop'), qw(union intersect except) ],
97 my $setop_expander = $self->cb('_expand_clause_setop');
99 $sqla->clause_expanders(
100 map +($_ => $setop_expander),
102 map +($_, "${_}_all", "${_}_distinct"),
103 qw(union intersect except)
106 foreach my $stmt (qw(select insert update delete)) {
107 $sqla->clauses_of($stmt => 'with', $sqla->clauses_of($stmt));
109 clause_expanders => [
110 "${stmt}.with" => '_expand_with',
111 "${stmt}.with_recursive" => '_expand_with',
113 clause_renderer => [ "${stmt}.with" => '_render_with' ],
121 my ($self, $orig, $before_setop, @args) = @_;
122 my $exp = $self->sqla->$orig(@args);
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};
126 unshift @{(values(%$setop))[0]->{queries}},
127 { -select => \%inner };
132 sub _expand_from_list {
133 my ($self, undef, $args) = @_;
134 if (ref($args) eq 'HASH') {
135 return $args if $args->{-from_list};
136 return { -from_list => [ $self->expand_expr($args) ] };
139 my @args = ref($args) eq 'ARRAY' ? @$args : ($args);
140 while (my $entry = shift @args) {
141 if (!ref($entry) and $entry =~ /^-(.*)/) {
143 $list[-1] = $self->expand_expr({ -as => [
144 $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args)
148 $entry = { $entry => shift @args };
150 my $aqt = $self->expand_expr($entry, -ident);
151 if ($aqt->{-join} and not $aqt->{-join}{from}) {
152 $aqt->{-join}{from} = pop @list;
156 return $list[0] if @list == 1;
157 return { -from_list => \@list };
161 my ($self, undef, $args) = @_;
167 if (my $as = delete $proto{as}) {
168 $proto{to} = $self->expand_expr(
169 { -as => [ { -from_list => $proto{to} }, $as ] }
172 if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') {
174 map [ $self->expand_expr($_, -ident) ],
175 ref($using) eq 'ARRAY' ? @$using: $using
179 type => delete $proto{type},
180 to => $self->expand_expr({ -from_list => delete $proto{to} }, -ident)
183 map +($_ => $self->expand_expr($proto{$_}, -ident)),
186 return +{ -join => \%ret };
189 sub _render_from_list {
190 my ($self, undef, $list) = @_;
191 return $self->join_query_parts(', ', @$list);
195 my ($self, undef, $args) = @_;
199 { -keyword => join '_', ($args->{type}||()), 'join' },
200 (map +($_->{-ident} || $_->{-as}
202 : ('(', $self->render_aqt($_, 1), ')')),
203 map +(@{$_->{-from_list}||[]} == 1 ? $_->{-from_list}[0] : $_),
207 { -keyword => 'on' },
211 { -keyword => 'using' },
212 '(', $args->{using}, ')',
215 return $self->join_query_parts(' ', @parts);
219 my ($self, undef, $vv, $k) = @_;
220 my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv);
221 my $ik = $self->expand_expr($k, -ident);
222 return +{ -as => [ $ik, $self->expand_expr($vv[0], -ident) ] }
223 if @vv == 1 and ref($vv[0]) eq 'HASH';
225 my @as = map $self->expand_expr($_, -ident), @vv;
226 return { -as => [ $ik, $self->expand_expr({ -alias => \@as }) ] };
230 my ($self, undef, $args) = @_;
231 my ($thing, $alias) = @$args;
232 return $self->join_query_parts(
235 { -keyword => 'as' },
241 my ($self, undef, $args) = @_;
242 my ($as, @cols) = @$args;
244 ? $self->join_query_parts('',
247 $self->join_query_parts(
253 : $self->render_aqt($as)
257 sub _expand_update_clause_target {
258 my ($self, undef, $target) = @_;
259 +(target => $self->_expand_from_list(undef, $target));
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),
273 my ($self, undef, $args) = @_;
274 if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) {
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 };
284 my ($self, $name, $with) = @_;
285 my (undef, $type) = split '_', $name;
286 if (ref($with) eq 'HASH') {
291 $self->expand_expr({ -alias => $_->[0] }, -ident),
292 $self->expand_expr($_->[1]),
293 ], @{$with->{queries}}
299 while (my ($alias, $query) = splice @with, 0, 2) {
301 $self->expand_expr({ -alias => $alias }, -ident),
302 $self->expand_expr($query)
305 return +(with => { ($type ? (type => $type) : ()), queries => \@exp });
309 my ($self, undef, $with) = @_;
310 my $q_part = $self->join_query_parts(', ',
312 my ($alias, $query) = @$_;
313 $self->join_query_parts(' ',
315 { -keyword => 'as' },
318 } @{$with->{queries}}
320 return $self->join_query_parts(' ',
321 { -keyword => join '_', 'with', ($with->{type}||'') },
327 my ($self, $setop, $args) = @_;
328 my $is_all = $setop =~ s/_all$//;
330 ($is_all ? (type => 'all') : ()),
331 (ref($args) eq 'ARRAY'
332 ? (queries => [ map $self->expand_expr($_), @$args ])
335 queries => [ map $self->expand_expr($_), @{$args->{queries}} ]
342 my ($self, $setop, $args) = @_;
343 $self->join_query_parts(
344 { -keyword => ' '.join('_', $setop, ($args->{type}||())).' ' },
349 sub _expand_clause_setop {
350 my ($self, $setop, $args) = @_;
351 my ($op, $type) = split '_', $setop;
352 +(setop => $self->expand_expr({
354 ($type ? (type => $type) : ()),
355 queries => (ref($args) eq 'ARRAY' ? $args : [ $args ])
366 SQL::Abstract::ExtraClauses - new/experimental additions to L<SQL::Abstract>
370 my $sqla = SQL::Abstract->new;
371 SQL::Abstract::ExtraClauses->apply_to($sqla);
375 This module is basically a nursery for things that seem like a good idea
376 to live in until we figure out if we were right about that.
382 Applies the plugin to an L<SQL::Abstract> object.
384 =head2 register_extensions
386 Registers the extensions described below
390 For plugin authors, creates a callback to call a method on the plugin.
394 For plugin authors, registers callbacks more easily.
398 Available only during plugin callback executions, contains the currently
399 active L<SQL::Abstract> object.
405 Represents a table alias. Expands name and column names with ident as default.
408 { -alias => [ 't', 'x', 'y', 'z' ] }
412 { -ident => [ 't' ] }, { -ident => [ 'x' ] },
413 { -ident => [ 'y' ] }, { -ident => [ 'z' ] },
422 Represents an sql AS. LHS is expanded with ident as default, RHS is treated
423 as a list of arguments for the alias node.
426 { foo => { -as => 'bar' } }
429 { -as => [ { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] }
436 { -as => [ { -select => { _ => 'blah' } }, 't', 'blah' ] }
441 { select => { -op => [ ',', { -ident => [ 'blah' ] } ] } }
443 { -alias => [ { -ident => [ 't' ] }, { -ident => [ 'blah' ] } ] },
447 (SELECT blah) AS t(blah)
453 { -cast => [ { -ident => 'birthday' }, 'date' ] }
458 -as => [ { -ident => [ 'birthday' ] }, { -ident => [ 'date' ] } ]
463 CAST(birthday AS date)
468 If given an arrayref, pretends it was given a hashref with the first
469 element of the arrayref as the value for 'to' and the remaining pairs copied.
471 Given a hashref, the 'as' key is if presented expanded to wrap the 'to'.
473 If present the 'using' key is expanded as a list of idents.
475 Known keys are: 'from' (the left hand side), 'type' ('left', 'right', or
476 nothing), 'to' (the right hand side), 'on' and 'using'.
481 on => { 'lft.bloo' => { '>' => 'rgt.blee' } },
488 from => { -ident => [ 'lft' ] },
490 '>', { -ident => [ 'lft', 'bloo' ] },
491 { -ident => [ 'rgt', 'blee' ] },
493 to => { -ident => [ 'rgt' ] },
498 lft LEFT JOIN rgt ON lft.bloo > rgt.blee
503 List of components of the FROM clause; -foo type elements indicate a pair
504 with the next element; this is easiest if I show you:
508 't1', -as => 'table_one', -join =>
509 [ 't2', 'on', { 'table_one.x' => 't2.x' } ],
516 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
519 '=', { -ident => [ 'table_one', 'x' ] },
520 { -ident => [ 't2', 'x' ] },
522 to => { -ident => [ 't2' ] },
527 t1 AS table_one JOIN t2 ON table_one.x = t2.x
534 [ 't1', -as => 'table_one', -join => [ 't2', 'using', [ 'x' ] ] ]
541 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
543 to => { -ident => [ 't2' ] },
546 { -op => [ 'or', { -op => [ 'or', { -ident => [ 'x' ] } ] } ] },
550 t1 AS table_one JOIN t2 USING ( x )
558 [ [ 'y', -join => [ 'z', 'type', 'left' ] ], 'type', 'left' ],
563 from => { -ident => [ 'x' ] },
565 from => { -ident => [ 'y' ] },
566 to => { -ident => [ 'z' ] },
573 x LEFT JOIN ( y LEFT JOIN z )
578 Expanders are provided for union, union_all, intersect, intersect_all,
579 except and except_all, and each takes an arrayref of queries:
583 { -select => { _ => { -value => 1 } } },
584 { -select => { _ => { -value => 2 } } },
588 { -union => { queries => [
590 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
593 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
598 (SELECT ?) UNION (SELECT ?)
603 { -select => { _ => { -value => 1 } } },
604 { -select => { _ => { -value => 2 } } },
605 { -select => { _ => { -value => 1 } } },
612 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
615 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
618 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
625 (SELECT ?) UNION ALL (SELECT ?) UNION ALL (SELECT ?)
628 =head1 STATEMENT EXTENSIONS
630 =head2 group by clause for select
632 Expanded as a list with an ident default:
635 { -select => { group_by => [ 'foo', 'bar' ] } }
638 { -select => { group_by =>
640 -op => [ ',', { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ]
648 =head2 having clause for select
650 Basic expr, just like where, given having is pretty much post-group-by
655 { having => { '>' => [ { -count => { -ident => 'foo' } }, 3 ] } }
659 { -select => { having => { -op => [
660 '>', { -func => [ 'count', { -ident => [ 'foo' ] } ] },
661 { -bind => [ undef, 3 ] },
665 HAVING COUNT(foo) > ?
670 If a select query contains a clause matching any of the setop node types,
671 clauses that appear before the setop would in the resulting query are
672 gathered together and moved into an inner select node:
681 -select => { _ => '*', from => 'bar', where => { thing => 1 } }
683 where => { thing => 1 },
688 order_by => { -op => [ ',', { -ident => [ 'baz' ] } ] },
689 setop => { -union => { queries => [
691 from => { -ident => [ 'foo' ] },
692 select => { -op => [ ',', { -ident => [ '*' ] } ] },
694 '=', { -ident => [ 'thing' ] },
695 { -bind => [ 'thing', 1 ] },
699 from => { -ident => [ 'bar' ] },
700 select => { -op => [ ',', { -ident => [ '*' ] } ] },
702 '=', { -ident => [ 'thing' ] },
703 { -bind => [ 'thing', 1 ] },
709 (SELECT * FROM foo WHERE thing = ?) UNION (
710 SELECT * FROM bar WHERE thing = ?
715 =head2 update from clause
717 Some databases allow an additional FROM clause to reference other tables
718 for the data to update; this clause is expanded as a normal from list, check
719 your database for what is and isn't allowed in practice.
725 set => { sales_count => { sales_count => { '+' => \1 } } },
727 'accounts.name' => { '=' => \"'Acme Corporation'" },
728 'employees.id' => { -ident => 'accounts.sales_person' },
734 from => { -ident => [ 'accounts' ] },
737 '=', { -ident => [ 'sales_count' ] }, { -op => [
738 '+', { -ident => [ 'sales_count' ] },
739 { -literal => [ 1 ] },
743 target => { -ident => [ 'employees' ] },
746 '=', { -ident => [ 'accounts', 'name' ] },
747 { -literal => [ "'Acme Corporation'" ] },
749 '=', { -ident => [ 'employees', 'id' ] },
750 { -ident => [ 'accounts', 'sales_person' ] },
756 UPDATE employees SET sales_count = sales_count + 1 FROM accounts
758 accounts.name = 'Acme Corporation'
759 AND employees.id = accounts.sales_person
763 =head2 delete using clause
765 Some databases allow an additional USING clause to reference other tables
766 for the data to update; this clause is expanded as a normal from list, check
767 your database for what is and isn't allowed in practice.
773 where => { 'x.id' => { -ident => 'y.x_id' } },
778 target => { -op => [ ',', { -ident => [ 'x' ] } ] },
779 using => { -ident => [ 'y' ] },
781 '=', { -ident => [ 'x', 'id' ] },
782 { -ident => [ 'y', 'x_id' ] },
787 DELETE FROM x USING y WHERE x.id = y.x_id
790 =head2 insert rowvalues and select clauses
792 rowvalues and select are shorthand for
794 { from => { -select ... } }
798 { from => { -values ... } }
804 { into => 'numbers', rowvalues => [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] }
809 from => { -values => [
811 [ { -bind => [ undef, 1 ] }, { -bind => [ undef, 2 ] } ]
814 [ { -bind => [ undef, 3 ] }, { -bind => [ undef, 4 ] } ]
817 [ { -bind => [ undef, 5 ] }, { -bind => [ undef, 6 ] } ]
820 target => { -ident => [ 'numbers' ] },
824 INSERT INTO numbers VALUES (?, ?), (?, ?), (?, ?)
829 { into => 'numbers', select => { _ => '*', from => 'old_numbers' } }
834 from => { -select => {
835 from => { -ident => [ 'old_numbers' ] },
836 select => { -op => [ ',', { -ident => [ '*' ] } ] },
838 target => { -ident => [ 'numbers' ] },
842 INSERT INTO numbers SELECT * FROM old_numbers
845 =head2 with and with_recursive clauses
847 These clauses are available on select/insert/update/delete queries; check
848 your database for applicability (e.g. mysql supports all four but mariadb
851 The value should be an arrayref of name/query pairs:
857 with => [ 'foo', { -select => { select => \1 } } ],
862 from => { -ident => [ 'foo' ] },
863 select => { -op => [ ',', { -ident => [ '*' ] } ] },
864 with => { queries => [ [
865 { -ident => [ 'foo' ] }, { -select =>
866 { select => { -op => [ ',', { -literal => [ 1 ] } ] } }
872 WITH foo AS (SELECT 1) SELECT * FROM foo
875 A more complete example (designed for mariadb, (ab)using the fact that
876 mysqloids materialise subselects in FROM into an unindexed temp table to
877 circumvent the restriction that you can't select from the table you're
883 'tree_table', -join => {
885 on => { 'tree.id' => 'tree_with_path.id' },
887 from => 'tree_with_path',
890 [ 'tree_with_path', 'id', 'parent_id', 'path' ],
893 'id', 'parent_id', { -as => [
894 { -cast => { -as => [ 'id', 'char', 255 ] } },
897 from => 'tree_table',
898 union_all => { -select => {
900 't.id', 't.parent_id', { -as => [
901 { -concat => [ 'r.path', \"'/'", 't.id' ] },
906 'tree_table', -as => 't', -join => {
908 on => { 't.parent_id' => 'r.id' },
909 to => 'tree_with_path',
913 where => { parent_id => undef },
919 set => { path => { -ident => [ 'tree', 'path' ] } },
927 tree_with_path(id, parent_id, path) AS (
929 SELECT id, parent_id, CAST(id AS char(255)) AS path
930 FROM tree_table WHERE parent_id IS NULL
932 SELECT t.id, t.parent_id, CONCAT(r.path, '/', t.id) AS path
934 tree_table AS t JOIN tree_with_path AS r ON
938 SELECT * FROM tree_with_path
940 ON tree.id = tree_with_path.id