1 package SQL::Abstract::ExtraClauses;
6 is => 'ro', init_arg => undef,
8 expand_expr render_aqt join_query_parts
13 my ($self, $method, @args) = @_;
15 local $self->{sqla} = shift;
16 $self->$method(@args, @_)
21 my ($self, @pairs) = @_;
22 my $sqla = $self->sqla;
23 while (my ($method, $cases) = splice(@pairs, 0, 2)) {
25 while (my ($name, $case) = splice(@cases, 0, 2)) {
26 $sqla->$method($name, $self->cb($case));
33 my ($self, $sqla) = @_;
34 $self = $self->new unless ref($self);
35 local $self->{sqla} = $sqla;
36 $self->register_extensions($sqla);
39 sub register_extensions {
40 my ($self, $sqla) = @_;
42 my @clauses = $sqla->clauses_of('select');
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));
52 die "Huh?" unless @before_setop;
53 $sqla->clauses_of(select => @clauses);
55 $sqla->clauses_of(update => sub {
56 my ($self, @clauses) = @_;
57 splice(@clauses, 2, 0, 'from');
61 $sqla->clauses_of(delete => sub {
62 my ($self, @clauses) = @_;
63 splice(@clauses, 1, 0, 'using');
72 (map +($_ => "_${x}_${_}"), qw(join from_list alias))
75 ), qw(expand render)),
76 binop_expander => [ as => '_expand_op_as' ],
77 renderer => [ as => '_render_as' ],
78 expander => [ cast => '_expand_cast' ],
80 "select.from", '_expand_from_list',
82 => sub { $_[0]->expand_expr({ -list => $_[2] }, -ident) },
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] }));
92 'insert.select' => sub {
93 +(from => $_[0]->expand_expr({ -select => $_[2] }));
99 $sqla->wrap_expander(select => sub {
100 $self->cb('_expand_select', $_[0], \@before_setop);
105 'select.setop' => sub { $_[0]->render_aqt($_[2]) }
108 map +($_ => '_expand_setop', "${_}_all" => '_expand_setop'), qw(union intersect except) ],
109 renderer => [ map +($_ => '_render_setop'), qw(union intersect except) ],
112 my $setop_expander = $self->cb('_expand_clause_setop');
114 $sqla->clause_expanders(
115 map +($_ => $setop_expander),
117 map +($_, "${_}_all", "${_}_distinct"),
118 qw(union intersect except)
121 foreach my $stmt (qw(select insert update delete)) {
122 $sqla->clauses_of($stmt => 'with', $sqla->clauses_of($stmt));
124 clause_expanders => [
125 "${stmt}.with" => '_expand_with',
126 "${stmt}.with_recursive" => '_expand_with',
128 clause_renderer => [ "${stmt}.with" => '_render_with' ],
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 };
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) ] };
154 my @args = ref($args) eq 'ARRAY' ? @$args : ($args);
155 while (my $entry = shift @args) {
156 if (!ref($entry) and $entry =~ /^-(.*)/) {
158 $list[-1] = $self->expand_expr({ -as => [
159 $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args)
163 $entry = { $entry => shift @args };
165 my $aqt = $self->expand_expr($entry, -ident);
166 if ($aqt->{-join} and not $aqt->{-join}{from}) {
167 $aqt->{-join}{from} = pop @list;
171 return $list[0] if @list == 1;
172 return { -from_list => \@list };
176 my ($self, undef, $args) = @_;
182 if (my $as = delete $proto{as}) {
183 $proto{to} = $self->expand_expr(
184 { -as => [ { -from_list => $proto{to} }, $as ] }
187 if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') {
189 map [ $self->expand_expr($_, -ident) ],
190 ref($using) eq 'ARRAY' ? @$using: $using
194 type => delete $proto{type},
195 to => $self->expand_expr({ -from_list => delete $proto{to} }, -ident)
198 map +($_ => $self->expand_expr($proto{$_}, -ident)),
201 return +{ -join => \%ret };
204 sub _render_from_list {
205 my ($self, undef, $list) = @_;
206 return $self->join_query_parts(', ', @$list);
210 my ($self, undef, $args) = @_;
214 { -keyword => join '_', ($args->{type}||()), 'join' },
215 (map +($_->{-ident} || $_->{-as}
217 : ('(', $self->render_aqt($_, 1), ')')),
218 map +(@{$_->{-from_list}||[]} == 1 ? $_->{-from_list}[0] : $_),
222 { -keyword => 'on' },
226 { -keyword => 'using' },
227 '(', $args->{using}, ')',
230 return $self->join_query_parts(' ', @parts);
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';
240 my @as = map $self->expand_expr($_, -ident), @vv;
241 return { -as => [ $ik, $self->expand_expr({ -alias => \@as }) ] };
245 my ($self, undef, $args) = @_;
246 my ($thing, $alias) = @$args;
247 return $self->join_query_parts(
250 { -keyword => 'as' },
256 my ($self, undef, $args) = @_;
257 my ($as, @cols) = @$args;
259 ? $self->join_query_parts('',
262 $self->join_query_parts(
268 : $self->render_aqt($as)
272 sub _expand_update_clause_target {
273 my ($self, undef, $target) = @_;
274 +(target => $self->_expand_from_list(undef, $target));
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),
288 my ($self, undef, $args) = @_;
289 if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) {
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 };
299 my ($self, $name, $with) = @_;
300 my (undef, $type) = split '_', $name;
301 if (ref($with) eq 'HASH') {
306 $self->expand_expr({ -alias => $_->[0] }, -ident),
307 $self->expand_expr($_->[1]),
308 ], @{$with->{queries}}
314 while (my ($alias, $query) = splice @with, 0, 2) {
316 $self->expand_expr({ -alias => $alias }, -ident),
317 $self->expand_expr($query)
320 return +(with => { ($type ? (type => $type) : ()), queries => \@exp });
324 my ($self, undef, $with) = @_;
325 my $q_part = $self->join_query_parts(', ',
327 my ($alias, $query) = @$_;
328 $self->join_query_parts(' ',
330 { -keyword => 'as' },
333 } @{$with->{queries}}
335 return $self->join_query_parts(' ',
336 { -keyword => join '_', 'with', ($with->{type}||'') },
342 my ($self, $setop, $args) = @_;
343 my $is_all = $setop =~ s/_all$//;
345 ($is_all ? (type => 'all') : ()),
346 (ref($args) eq 'ARRAY'
347 ? (queries => [ map $self->expand_expr($_), @$args ])
350 queries => [ map $self->expand_expr($_), @{$args->{queries}} ]
357 my ($self, $setop, $args) = @_;
358 $self->join_query_parts(
359 { -keyword => ' '.join('_', $setop, ($args->{type}||())).' ' },
364 sub _expand_clause_setop {
365 my ($self, $setop, $args) = @_;
366 my ($op, $type) = split '_', $setop;
367 +(setop => $self->expand_expr({
369 ($type ? (type => $type) : ()),
370 queries => (ref($args) eq 'ARRAY' ? $args : [ $args ])
381 SQL::Abstract::ExtraClauses - new/experimental additions to L<SQL::Abstract>
385 my $sqla = SQL::Abstract->new;
386 SQL::Abstract::ExtraClauses->apply_to($sqla);
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.
397 Applies the plugin to an L<SQL::Abstract> object.
399 =head2 register_extensions
401 Registers the extensions described below
405 For plugin authors, creates a callback to call a method on the plugin.
409 For plugin authors, registers callbacks more easily.
413 Available only during plugin callback executions, contains the currently
414 active L<SQL::Abstract> object.
420 Represents a table alias. Expands name and column names with ident as default.
423 { -alias => [ 't', 'x', 'y', 'z' ] }
427 { -ident => [ 't' ] }, { -ident => [ 'x' ] },
428 { -ident => [ 'y' ] }, { -ident => [ 'z' ] },
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.
441 { foo => { -as => 'bar' } }
444 { -as => [ { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] }
451 { -as => [ { -select => { _ => 'blah' } }, 't', 'blah' ] }
456 { select => { -op => [ ',', { -ident => [ 'blah' ] } ] } }
458 { -alias => [ { -ident => [ 't' ] }, { -ident => [ 'blah' ] } ] },
462 (SELECT blah) AS t(blah)
468 { -cast => [ { -ident => 'birthday' }, 'date' ] }
473 -as => [ { -ident => [ 'birthday' ] }, { -ident => [ 'date' ] } ]
478 CAST(birthday AS date)
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.
486 Given a hashref, the 'as' key is if presented expanded to wrap the 'to'.
488 If present the 'using' key is expanded as a list of idents.
490 Known keys are: 'from' (the left hand side), 'type' ('left', 'right', or
491 nothing), 'to' (the right hand side), 'on' and 'using'.
496 on => { 'lft.bloo' => { '>' => 'rgt.blee' } },
503 from => { -ident => [ 'lft' ] },
505 '>', { -ident => [ 'lft', 'bloo' ] },
506 { -ident => [ 'rgt', 'blee' ] },
508 to => { -ident => [ 'rgt' ] },
513 lft LEFT JOIN rgt ON lft.bloo > rgt.blee
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:
523 't1', -as => 'table_one', -join =>
524 [ 't2', 'on', { 'table_one.x' => 't2.x' } ],
531 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
534 '=', { -ident => [ 'table_one', 'x' ] },
535 { -ident => [ 't2', 'x' ] },
537 to => { -ident => [ 't2' ] },
542 t1 AS table_one JOIN t2 ON table_one.x = t2.x
549 [ 't1', -as => 'table_one', -join => [ 't2', 'using', [ 'x' ] ] ]
556 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
558 to => { -ident => [ 't2' ] },
561 { -op => [ 'or', { -op => [ 'or', { -ident => [ 'x' ] } ] } ] },
565 t1 AS table_one JOIN t2 USING ( x )
573 [ [ 'y', -join => [ 'z', 'type', 'left' ] ], 'type', 'left' ],
578 from => { -ident => [ 'x' ] },
580 from => { -ident => [ 'y' ] },
581 to => { -ident => [ 'z' ] },
588 x LEFT JOIN ( y LEFT JOIN z )
593 Expanders are provided for union, union_all, intersect, intersect_all,
594 except and except_all, and each takes an arrayref of queries:
598 { -select => { _ => { -value => 1 } } },
599 { -select => { _ => { -value => 2 } } },
603 { -union => { queries => [
605 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
608 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
613 (SELECT ?) UNION (SELECT ?)
618 { -select => { _ => { -value => 1 } } },
619 { -select => { _ => { -value => 2 } } },
620 { -select => { _ => { -value => 1 } } },
627 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
630 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
633 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
640 (SELECT ?) UNION ALL (SELECT ?) UNION ALL (SELECT ?)
643 =head1 STATEMENT EXTENSIONS
645 =head2 group by clause for select
647 Expanded as a list with an ident default:
650 { -select => { group_by => [ 'foo', 'bar' ] } }
653 { -select => { group_by =>
655 -op => [ ',', { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ]
663 =head2 having clause for select
665 Basic expr, just like where, given having is pretty much post-group-by
670 { having => { '>' => [ { -count => { -ident => 'foo' } }, 3 ] } }
674 { -select => { having => { -op => [
675 '>', { -func => [ 'count', { -ident => [ 'foo' ] } ] },
676 { -bind => [ undef, 3 ] },
680 HAVING COUNT(foo) > ?
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:
696 -select => { _ => '*', from => 'bar', where => { thing => 1 } }
698 where => { thing => 1 },
703 order_by => { -op => [ ',', { -ident => [ 'baz' ] } ] },
704 setop => { -union => { queries => [
706 from => { -ident => [ 'foo' ] },
707 select => { -op => [ ',', { -ident => [ '*' ] } ] },
709 '=', { -ident => [ 'thing' ] },
710 { -bind => [ 'thing', 1 ] },
714 from => { -ident => [ 'bar' ] },
715 select => { -op => [ ',', { -ident => [ '*' ] } ] },
717 '=', { -ident => [ 'thing' ] },
718 { -bind => [ 'thing', 1 ] },
724 (SELECT * FROM foo WHERE thing = ?) UNION (
725 SELECT * FROM bar WHERE thing = ?
730 =head2 update from clause
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.
740 set => { sales_count => { sales_count => { '+' => \1 } } },
742 'accounts.name' => { '=' => \"'Acme Corporation'" },
743 'employees.id' => { -ident => 'accounts.sales_person' },
749 from => { -ident => [ 'accounts' ] },
752 '=', { -ident => [ 'sales_count' ] }, { -op => [
753 '+', { -ident => [ 'sales_count' ] },
754 { -literal => [ 1 ] },
758 target => { -ident => [ 'employees' ] },
761 '=', { -ident => [ 'accounts', 'name' ] },
762 { -literal => [ "'Acme Corporation'" ] },
764 '=', { -ident => [ 'employees', 'id' ] },
765 { -ident => [ 'accounts', 'sales_person' ] },
771 UPDATE employees SET sales_count = sales_count + 1 FROM accounts
773 accounts.name = 'Acme Corporation'
774 AND employees.id = accounts.sales_person
778 =head2 delete using clause
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.
788 where => { 'x.id' => { -ident => 'y.x_id' } },
793 target => { -op => [ ',', { -ident => [ 'x' ] } ] },
794 using => { -ident => [ 'y' ] },
796 '=', { -ident => [ 'x', 'id' ] },
797 { -ident => [ 'y', 'x_id' ] },
802 DELETE FROM x USING y WHERE x.id = y.x_id
805 =head2 insert rowvalues and select clauses
807 rowvalues and select are shorthand for
809 { from => { -select ... } }
813 { from => { -values ... } }
819 { into => 'numbers', rowvalues => [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] }
824 from => { -values => [
826 [ { -bind => [ undef, 1 ] }, { -bind => [ undef, 2 ] } ]
829 [ { -bind => [ undef, 3 ] }, { -bind => [ undef, 4 ] } ]
832 [ { -bind => [ undef, 5 ] }, { -bind => [ undef, 6 ] } ]
835 target => { -ident => [ 'numbers' ] },
839 INSERT INTO numbers VALUES (?, ?), (?, ?), (?, ?)
844 { into => 'numbers', select => { _ => '*', from => 'old_numbers' } }
849 from => { -select => {
850 from => { -ident => [ 'old_numbers' ] },
851 select => { -op => [ ',', { -ident => [ '*' ] } ] },
853 target => { -ident => [ 'numbers' ] },
857 INSERT INTO numbers SELECT * FROM old_numbers
860 =head2 with and with_recursive clauses
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
866 The value should be an arrayref of name/query pairs:
872 with => [ 'foo', { -select => { select => \1 } } ],
877 from => { -ident => [ 'foo' ] },
878 select => { -op => [ ',', { -ident => [ '*' ] } ] },
879 with => { queries => [ [
880 { -ident => [ 'foo' ] }, { -select =>
881 { select => { -op => [ ',', { -literal => [ 1 ] } ] } }
887 WITH foo AS (SELECT 1) SELECT * FROM foo
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
898 'tree_table', -join => {
900 on => { 'tree.id' => 'tree_with_path.id' },
902 from => 'tree_with_path',
905 [ 'tree_with_path', 'id', 'parent_id', 'path' ],
908 'id', 'parent_id', { -as => [
909 { -cast => { -as => [ 'id', 'char', 255 ] } },
912 from => 'tree_table',
913 union_all => { -select => {
915 't.id', 't.parent_id', { -as => [
916 { -concat => [ 'r.path', \"'/'", 't.id' ] },
921 'tree_table', -as => 't', -join => {
923 on => { 't.parent_id' => 'r.id' },
924 to => 'tree_with_path',
928 where => { parent_id => undef },
934 set => { path => { -ident => [ 'tree', 'path' ] } },
942 tree_with_path(id, parent_id, path) AS (
944 SELECT id, parent_id, CAST(id AS char(255)) AS path
945 FROM tree_table WHERE parent_id IS NULL
947 SELECT t.id, t.parent_id, CONCAT(r.path, '/', t.id) AS path
949 tree_table AS t JOIN tree_with_path AS r ON
953 SELECT * FROM tree_with_path
955 ON tree.id = tree_with_path.id