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' ],
48 "select.from", '_expand_from_list',
50 => sub { $_[0]->expand_expr({ -list => $_[2] }, -ident) },
52 => sub { $_[0]->expand_expr($_[2]) },
53 'update.from' => '_expand_from_list',
54 "update.target", '_expand_update_clause_target',
55 "update.update", '_expand_update_clause_target',
56 'delete.using' => '_expand_from_list',
57 'insert.rowvalues' => sub {
58 +(from => $_[0]->expand_expr({ -values => $_[2] }));
60 'insert.select' => sub {
61 +(from => $_[0]->expand_expr({ -select => $_[2] }));
67 $sqla->wrap_expander(select => sub {
68 $self->cb('_expand_select', $_[0], \@before_setop);
73 'select.setop' => sub { $_[0]->render_aqt($_[2]) }
76 map +($_ => '_expand_setop', "${_}_all" => '_expand_setop'), qw(union intersect except) ],
77 renderer => [ map +($_ => '_render_setop'), qw(union intersect except) ],
80 my $setop_expander = $self->cb('_expand_clause_setop');
82 $sqla->clause_expanders(
83 map +($_ => $setop_expander),
85 map +($_, "${_}_all", "${_}_distinct"),
86 qw(union intersect except)
89 foreach my $stmt (qw(select insert update delete)) {
90 $sqla->clauses_of($stmt => 'with', $sqla->clauses_of($stmt));
93 "${stmt}.with" => '_expand_with',
94 "${stmt}.with_recursive" => '_expand_with',
96 clause_renderer => [ "${stmt}.with" => '_render_with' ],
104 my ($self, $orig, $before_setop, @args) = @_;
105 my $exp = $self->sqla->$orig(@args);
106 return $exp unless my $setop = (my $sel = $exp->{-select})->{setop};
107 if (my @keys = grep $sel->{$_}, @$before_setop) {
108 my %inner; @inner{@keys} = delete @{$sel}{@keys};
109 unshift @{(values(%$setop))[0]{queries}},
110 { -select => \%inner };
115 sub _expand_from_list {
116 my ($self, undef, $args) = @_;
117 if (ref($args) eq 'HASH') {
118 return $args if $args->{-from_list};
119 return { -from_list => [ $self->expand_expr($args) ] };
122 my @args = ref($args) eq 'ARRAY' ? @$args : ($args);
123 while (my $entry = shift @args) {
124 if (!ref($entry) and $entry =~ /^-(.*)/) {
126 $list[-1] = $self->expand_expr({ -as => [
127 $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args)
131 $entry = { $entry => shift @args };
133 my $aqt = $self->expand_expr($entry, -ident);
134 if ($aqt->{-join} and not $aqt->{-join}{from}) {
135 $aqt->{-join}{from} = pop @list;
139 return $list[0] if @list == 1;
140 return { -from_list => \@list };
144 my ($self, undef, $args) = @_;
150 if (my $as = delete $proto{as}) {
151 $proto{to} = $self->expand_expr(
152 { -as => [ { -from_list => $proto{to} }, $as ] }
155 if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') {
157 map [ $self->expand_expr($_, -ident) ],
158 ref($using) eq 'ARRAY' ? @$using: $using
162 type => delete $proto{type},
163 to => $self->expand_expr({ -from_list => delete $proto{to} }, -ident)
166 map +($_ => $self->expand_expr($proto{$_}, -ident)),
169 return +{ -join => \%ret };
172 sub _render_from_list {
173 my ($self, undef, $list) = @_;
174 return $self->join_query_parts(', ', @$list);
178 my ($self, undef, $args) = @_;
182 { -keyword => join '_', ($args->{type}||()), 'join' },
183 (map +($_->{-ident} || $_->{-as}
185 : ('(', $self->render_aqt($_, 1), ')')),
186 map +(@{$_->{-from_list}||[]} == 1 ? $_->{-from_list}[0] : $_),
190 { -keyword => 'on' },
194 { -keyword => 'using' },
195 '(', $args->{using}, ')',
198 return $self->join_query_parts(' ', @parts);
202 my ($self, undef, $vv, $k) = @_;
203 my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv);
204 my $ik = $self->expand_expr($k, -ident);
205 return +{ -as => [ $ik, $self->expand_expr($vv[0], -ident) ] }
206 if @vv == 1 and ref($vv[0]) eq 'HASH';
208 my @as = map $self->expand_expr($_, -ident), @vv;
209 return { -as => [ $ik, $self->expand_expr({ -alias => \@as }) ] };
213 my ($self, undef, $args) = @_;
214 my ($thing, $alias) = @$args;
215 return $self->join_query_parts(
218 { -keyword => 'as' },
224 my ($self, undef, $args) = @_;
225 my ($as, @cols) = @$args;
227 ? $self->join_query_parts('',
230 $self->join_query_parts(
236 : $self->render_aqt($as)
240 sub _expand_update_clause_target {
241 my ($self, undef, $target) = @_;
242 +(target => $self->_expand_from_list(undef, $target));
246 my ($self, undef, $thing) = @_;
247 return { -func => [ cast => $thing ] } if ref($thing) eq 'HASH';
248 my ($cast, $to) = @{$thing};
249 +{ -func => [ cast => { -as => [
250 $self->expand_expr($cast),
251 $self->expand_expr($to, -ident),
256 my ($self, undef, $args) = @_;
257 if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) {
260 my @parts = map $self->expand_expr($_, -ident),
261 ref($args) eq 'ARRAY' ? @{$args} : $args;
262 return $parts[0] if @parts == 1;
263 return { -alias => \@parts };
267 my ($self, $name, $with) = @_;
268 my (undef, $type) = split '_', $name;
269 if (ref($with) eq 'HASH') {
274 $self->expand_expr({ -alias => $_->[0] }, -ident),
275 $self->expand_expr($_->[1]),
276 ], @{$with->{queries}}
282 while (my ($alias, $query) = splice @with, 0, 2) {
284 $self->expand_expr({ -alias => $alias }, -ident),
285 $self->expand_expr($query)
288 return +(with => { ($type ? (type => $type) : ()), queries => \@exp });
292 my ($self, undef, $with) = @_;
293 my $q_part = $self->join_query_parts(', ',
295 my ($alias, $query) = @$_;
296 $self->join_query_parts(' ',
298 { -keyword => 'as' },
301 } @{$with->{queries}}
303 return $self->join_query_parts(' ',
304 { -keyword => join '_', 'with', ($with->{type}||'') },
310 my ($self, $setop, $args) = @_;
311 my $is_all = $setop =~ s/_all$//;
313 ($is_all ? (type => 'all') : ()),
314 (ref($args) eq 'ARRAY'
315 ? (queries => [ map $self->expand_expr($_), @$args ])
318 queries => [ map $self->expand_expr($_), @{$args->{queries}} ]
325 my ($self, $setop, $args) = @_;
326 $self->join_query_parts(
327 { -keyword => ' '.join('_', $setop, ($args->{type}||())).' ' },
332 sub _expand_clause_setop {
333 my ($self, $setop, $args) = @_;
334 my ($op, $type) = split '_', $setop;
335 +(setop => $self->expand_expr({
337 ($type ? (type => $type) : ()),
338 queries => (ref($args) eq 'ARRAY' ? $args : [ $args ])
349 SQL::Abstract::ExtraClauses - new/experimental additions to L<SQL::Abstract>
353 my $sqla = SQL::Abstract->new;
354 SQL::Abstract::ExtraClauses->apply_to($sqla);
358 This module is basically a nursery for things that seem like a good idea
359 to live in until we figure out if we were right about that.
365 Applies the plugin to an L<SQL::Abstract> object.
367 =head2 register_extensions
369 Registers the extensions described below
373 For plugin authors, creates a callback to call a method on the plugin.
377 For plugin authors, registers callbacks more easily.
381 Available only during plugin callback executions, contains the currently
382 active L<SQL::Abstract> object.
388 Represents a table alias. Expands name and column names with ident as default.
391 { -alias => [ 't', 'x', 'y', 'z' ] }
395 { -ident => [ 't' ] }, { -ident => [ 'x' ] },
396 { -ident => [ 'y' ] }, { -ident => [ 'z' ] },
405 Represents an sql AS. LHS is expanded with ident as default, RHS is treated
406 as a list of arguments for the alias node.
409 { foo => { -as => 'bar' } }
412 { -as => [ { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] }
419 { -as => [ { -select => { _ => 'blah' } }, 't', 'blah' ] }
424 { select => { -op => [ ',', { -ident => [ 'blah' ] } ] } }
426 { -alias => [ { -ident => [ 't' ] }, { -ident => [ 'blah' ] } ] },
430 (SELECT blah) AS t(blah)
436 { -cast => [ { -ident => 'birthday' }, 'date' ] }
441 -as => [ { -ident => [ 'birthday' ] }, { -ident => [ 'date' ] } ]
446 CAST(birthday AS date)
451 If given an arrayref, pretends it was given a hashref with the first
452 element of the arrayref as the value for 'to' and the remaining pairs copied.
454 Given a hashref, the 'as' key is if presented expanded to wrap the 'to'.
456 If present the 'using' key is expanded as a list of idents.
458 Known keys are: 'from' (the left hand side), 'type' ('left', 'right', or
459 nothing), 'to' (the right hand side), 'on' and 'using'.
464 on => { 'lft.bloo' => { '>' => 'rgt.blee' } },
471 from => { -ident => [ 'lft' ] },
473 '>', { -ident => [ 'lft', 'bloo' ] },
474 { -ident => [ 'rgt', 'blee' ] },
476 to => { -ident => [ 'rgt' ] },
481 lft LEFT JOIN rgt ON lft.bloo > rgt.blee
486 List of components of the FROM clause; -foo type elements indicate a pair
487 with the next element; this is easiest if I show you:
491 't1', -as => 'table_one', -join =>
492 [ 't2', 'on', { 'table_one.x' => 't2.x' } ],
499 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
502 '=', { -ident => [ 'table_one', 'x' ] },
503 { -ident => [ 't2', 'x' ] },
505 to => { -ident => [ 't2' ] },
510 t1 AS table_one JOIN t2 ON table_one.x = t2.x
517 [ 't1', -as => 'table_one', -join => [ 't2', 'using', [ 'x' ] ] ]
524 -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ]
526 to => { -ident => [ 't2' ] },
529 { -op => [ 'or', { -op => [ 'or', { -ident => [ 'x' ] } ] } ] },
533 t1 AS table_one JOIN t2 USING ( x )
541 [ [ 'y', -join => [ 'z', 'type', 'left' ] ], 'type', 'left' ],
546 from => { -ident => [ 'x' ] },
548 from => { -ident => [ 'y' ] },
549 to => { -ident => [ 'z' ] },
556 x LEFT JOIN ( y LEFT JOIN z )
561 Expanders are provided for union, union_all, intersect, intersect_all,
562 except and except_all, and each takes an arrayref of queries:
566 { -select => { _ => { -value => 1 } } },
567 { -select => { _ => { -value => 2 } } },
571 { -union => { queries => [
573 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
576 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
581 (SELECT ?) UNION (SELECT ?)
586 { -select => { _ => { -value => 1 } } },
587 { -select => { _ => { -value => 2 } } },
588 { -select => { _ => { -value => 1 } } },
595 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
598 { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } }
601 { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } }
608 (SELECT ?) UNION ALL (SELECT ?) UNION ALL (SELECT ?)
611 =head1 STATEMENT EXTENSIONS
613 =head2 group by clause for select
615 Expanded as a list with an ident default:
618 { -select => { group_by => [ 'foo', 'bar' ] } }
621 { -select => { group_by =>
623 -op => [ ',', { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ]
631 =head2 having clause for select
633 Basic expr, just like where, given having is pretty much post-group-by
638 { having => { '>' => [ { -count => { -ident => 'foo' } }, 3 ] } }
642 { -select => { having => { -op => [
643 '>', { -func => [ 'count', { -ident => [ 'foo' ] } ] },
644 { -bind => [ undef, 3 ] },
648 HAVING COUNT(foo) > ?
653 If a select query contains a clause matching any of the setop node types,
654 clauses that appear before the setop would in the resulting query are
655 gathered together and moved into an inner select node:
664 -select => { _ => '*', from => 'bar', where => { thing => 1 } }
666 where => { thing => 1 },
671 order_by => { -op => [ ',', { -ident => [ 'baz' ] } ] },
672 setop => { -union => { queries => [
674 from => { -ident => [ 'foo' ] },
675 select => { -op => [ ',', { -ident => [ '*' ] } ] },
677 '=', { -ident => [ 'thing' ] },
678 { -bind => [ 'thing', 1 ] },
682 from => { -ident => [ 'bar' ] },
683 select => { -op => [ ',', { -ident => [ '*' ] } ] },
685 '=', { -ident => [ 'thing' ] },
686 { -bind => [ 'thing', 1 ] },
692 (SELECT * FROM foo WHERE thing = ?) UNION (
693 SELECT * FROM bar WHERE thing = ?
698 =head2 update from clause
700 Some databases allow an additional FROM clause to reference other tables
701 for the data to update; this clause is expanded as a normal from list, check
702 your database for what is and isn't allowed in practice.
708 set => { sales_count => { sales_count => { '+' => \1 } } },
710 'accounts.name' => { '=' => \"'Acme Corporation'" },
711 'employees.id' => { -ident => 'accounts.sales_person' },
717 from => { -ident => [ 'accounts' ] },
720 '=', { -ident => [ 'sales_count' ] }, { -op => [
721 '+', { -ident => [ 'sales_count' ] },
722 { -literal => [ 1 ] },
726 target => { -ident => [ 'employees' ] },
729 '=', { -ident => [ 'accounts', 'name' ] },
730 { -literal => [ "'Acme Corporation'" ] },
732 '=', { -ident => [ 'employees', 'id' ] },
733 { -ident => [ 'accounts', 'sales_person' ] },
739 UPDATE employees SET sales_count = sales_count + 1 FROM accounts
741 accounts.name = 'Acme Corporation'
742 AND employees.id = accounts.sales_person
746 =head2 delete using clause
748 Some databases allow an additional USING clause to reference other tables
749 for the data to update; this clause is expanded as a normal from list, check
750 your database for what is and isn't allowed in practice.
756 where => { 'x.id' => { -ident => 'y.x_id' } },
761 target => { -op => [ ',', { -ident => [ 'x' ] } ] },
762 using => { -ident => [ 'y' ] },
764 '=', { -ident => [ 'x', 'id' ] },
765 { -ident => [ 'y', 'x_id' ] },
770 DELETE FROM x USING y WHERE x.id = y.x_id
773 =head2 insert rowvalues and select clauses
775 rowvalues and select are shorthand for
777 { from => { -select ... } }
781 { from => { -values ... } }
787 { into => 'numbers', rowvalues => [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] }
792 from => { -values => [
794 [ { -bind => [ undef, 1 ] }, { -bind => [ undef, 2 ] } ]
797 [ { -bind => [ undef, 3 ] }, { -bind => [ undef, 4 ] } ]
800 [ { -bind => [ undef, 5 ] }, { -bind => [ undef, 6 ] } ]
803 target => { -ident => [ 'numbers' ] },
807 INSERT INTO numbers VALUES (?, ?), (?, ?), (?, ?)
812 { into => 'numbers', select => { _ => '*', from => 'old_numbers' } }
817 from => { -select => {
818 from => { -ident => [ 'old_numbers' ] },
819 select => { -op => [ ',', { -ident => [ '*' ] } ] },
821 target => { -ident => [ 'numbers' ] },
825 INSERT INTO numbers SELECT * FROM old_numbers
828 =head2 with and with_recursive clauses
830 These clauses are available on select/insert/update/delete queries; check
831 your database for applicability (e.g. mysql supports all four but mariadb
834 The value should be an arrayref of name/query pairs:
840 with => [ 'foo', { -select => { select => \1 } } ],
845 from => { -ident => [ 'foo' ] },
846 select => { -op => [ ',', { -ident => [ '*' ] } ] },
847 with => { queries => [ [
848 { -ident => [ 'foo' ] }, { -select =>
849 { select => { -op => [ ',', { -literal => [ 1 ] } ] } }
855 WITH foo AS (SELECT 1) SELECT * FROM foo
858 A more complete example (designed for mariadb, (ab)using the fact that
859 mysqloids materialise subselects in FROM into an unindexed temp table to
860 circumvent the restriction that you can't select from the table you're
866 'tree_table', -join => {
868 on => { 'tree.id' => 'tree_with_path.id' },
870 from => 'tree_with_path',
873 [ 'tree_with_path', 'id', 'parent_id', 'path' ],
876 'id', 'parent_id', { -as => [
877 { -cast => { -as => [ 'id', 'char', 255 ] } },
880 from => 'tree_table',
881 union_all => { -select => {
883 't.id', 't.parent_id', { -as => [
884 { -concat => [ 'r.path', \"'/'", 't.id' ] },
889 'tree_table', -as => 't', -join => {
891 on => { 't.parent_id' => 'r.id' },
892 to => 'tree_with_path',
896 where => { parent_id => undef },
902 set => { path => { -ident => [ 'tree', 'path' ] } },
910 tree_with_path(id, parent_id, path) AS (
912 SELECT id, parent_id, CAST(id AS char(255)) AS path
913 FROM tree_table WHERE parent_id IS NULL
915 SELECT t.id, t.parent_id, CONCAT(r.path, '/', t.id) AS path
917 tree_table AS t JOIN tree_with_path AS r ON
921 SELECT * FROM tree_with_path
923 ON tree.id = tree_with_path.id