X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FQ-Branch.git;a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FExtraClauses.pm;h=7d576bf4fcf429d3cf4410b9247a72b2d032ce6e;hp=c0e753dd75a03fe1a1b1cd99a66c2ab0e266ff6c;hb=49dba492babc1248fa1acbf75f1bfd237f2a6ef3;hpb=ec49a2e10ad2cca513719dc04f410fb9cae85978 diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index c0e753d..7d576bf 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -5,7 +5,7 @@ use Moo; has sqla => ( is => 'ro', init_arg => undef, handles => [ qw( - expand_expr expand_maybe_list_expr render_aqt join_query_parts + expand_expr render_aqt join_query_parts ) ], ); @@ -18,11 +18,13 @@ sub cb { } sub register { - my ($self, $method, @pairs) = @_; + my ($self, @pairs) = @_; my $sqla = $self->sqla; - while (my ($car, $cdr) = splice(@pairs, 0, 2)) { - my $cb = $self->cb($cdr); - $sqla->$method($car, $cb); + while (my ($method, $cases) = splice(@pairs, 0, 2)) { + my @cases = @$cases; + while (my ($name, $case) = splice(@cases, 0, 2)) { + $sqla->$method($name, $self->cb($case)); + } } return $self; } @@ -36,6 +38,7 @@ sub apply_to { sub register_extensions { my ($self, $sqla) = @_; + my @clauses = $sqla->clauses_of('select'); my @before_setop; CLAUSE: foreach my $idx (0..$#clauses) { @@ -45,23 +48,9 @@ sub register_extensions { last CLAUSE; } } + die "Huh?" unless @before_setop; - $sqla->clauses_of(select => 'with', @clauses); - $self->register( - clause_expanders => - 'select.group_by' - => sub { $_[0]->expand_maybe_list_expr($_[2], -ident) }, - 'select.having' - => sub { $_[0]->expand_expr($_[2]) }, - ); - foreach my $thing (qw(join from_list)) { - $sqla->expander($thing => $self->cb("_expand_${thing}")) - ->renderer($thing => $self->cb("_render_${thing}")) - } - $sqla->binop_expander(as => $self->cb('_expand_op_as')); - $sqla->renderer(as => $self->cb('_render_as')); - $sqla->expander(alias => $self->cb('_expand_alias')); - $sqla->renderer(alias => $self->cb('_render_alias')); + $sqla->clauses_of(select => @clauses); $sqla->clauses_of(update => sub { my ($self, @clauses) = @_; @@ -75,15 +64,35 @@ sub register_extensions { @clauses; }); - $sqla->clause_expanders( - 'update.from' => $self->cb('_expand_from_list'), - 'delete.using' => $self->cb('_expand_from_list'), - 'insert.rowvalues' => $self->cb(sub { - +(from => $_[0]->expand_expr({ -values => $_[2] })); - }), - 'insert.select' => $self->cb(sub { - +(from => $_[0]->expand_expr({ -select => $_[2] })); - }), + $self->register( + (map +( + "${_}er" => [ + do { + my $x = $_; + (map +($_ => "_${x}_${_}"), qw(join from_list alias)) + } + ] + ), qw(expand render)), + binop_expander => [ as => '_expand_op_as' ], + renderer => [ as => '_render_as' ], + expander => [ cast => '_expand_cast' ], + clause_expanders => [ + "select.from", '_expand_from_list', + 'select.group_by' + => sub { $_[0]->expand_expr({ -list => $_[2] }, -ident) }, + 'select.having' + => sub { $_[0]->expand_expr($_[2]) }, + 'update.from' => '_expand_from_list', + "update.target", '_expand_update_clause_target', + "update.update", '_expand_update_clause_target', + 'delete.using' => '_expand_from_list', + 'insert.rowvalues' => sub { + +(from => $_[0]->expand_expr({ -values => $_[2] })); + }, + 'insert.select' => sub { + +(from => $_[0]->expand_expr({ -select => $_[2] })); + }, + ], ); # set ops @@ -91,15 +100,15 @@ sub register_extensions { $self->cb('_expand_select', $_[0], \@before_setop); }); - $sqla->clause_renderer( - 'select.setop' => $self->cb(sub { $_[0]->render_aqt($_[2]); }) + $self->register( + clause_renderer => [ + 'select.setop' => sub { $_[0]->render_aqt($_[2]) } + ], + expander => [ + map +($_ => '_expand_setop', "${_}_all" => '_expand_setop'), qw(union intersect except) ], + renderer => [ map +($_ => '_render_setop'), qw(union intersect except) ], ); - foreach my $setop (qw(union intersect except)) { - $sqla->expander($setop => $self->cb('_expand_setop')); - $sqla->renderer($setop => $self->cb('_render_setop')); - } - my $setop_expander = $self->cb('_expand_clause_setop'); $sqla->clause_expanders( @@ -109,27 +118,17 @@ sub register_extensions { qw(union intersect except) ); - my $w_exp = $self->cb('_expand_with'); - my $w_rdr = $self->cb('_render_with'); - $sqla->clause_expander('select.with' => $w_exp); - $sqla->clause_expander('select.with_recursive' => $w_exp); - $sqla->clause_renderer('select.with' => $w_rdr); - - foreach my $stmt (qw(insert update delete)) { + foreach my $stmt (qw(select insert update delete)) { $sqla->clauses_of($stmt => 'with', $sqla->clauses_of($stmt)); - $sqla->clause_expander("${stmt}.$_" => $w_exp) - for qw(with with_recursive); - $sqla->clause_renderer("${stmt}.with" => $w_rdr); + $self->register( + clause_expanders => [ + "${stmt}.with" => '_expand_with', + "${stmt}.with_recursive" => '_expand_with', + ], + clause_renderer => [ "${stmt}.with" => '_render_with' ], + ); } - $sqla->expander(cast => $self->cb('_expand_cast')); - - $sqla->clause_expanders( - "select.from", $self->cb('_expand_from_list'), - "update.target", $self->cb('_expand_update_clause_target'), - "update.update", $self->cb('_expand_update_clause_target'), - ); - return $sqla; } @@ -169,6 +168,7 @@ sub _expand_from_list { } push @list, $aqt; } + return $list[0] if @list == 1; return { -from_list => \@list }; } @@ -177,10 +177,12 @@ sub _expand_join { my %proto = ( ref($args) eq 'HASH' ? %$args - : (to => $args->[0], @{$args}[1..$#$args]) + : (to => @$args) ); if (my $as = delete $proto{as}) { - $proto{to} = $self->expand_expr({ -as => [ $proto{to}, $as ] }); + $proto{to} = $self->expand_expr( + { -as => [ { -from_list => $proto{to} }, $as ] } + ); } if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') { $proto{using} = [ @@ -188,8 +190,14 @@ sub _expand_join { ref($using) eq 'ARRAY' ? @$using: $using ]; } - my %ret = map +($_ => $self->expand_expr($proto{$_}, -ident)), - sort keys %proto; + my %ret = ( + type => delete $proto{type}, + to => $self->expand_expr({ -from_list => delete $proto{to} }, -ident) + ); + %ret = (%ret, + map +($_ => $self->expand_expr($proto{$_}, -ident)), + sort keys %proto + ); return +{ -join => \%ret }; } @@ -204,7 +212,12 @@ sub _render_join { my @parts = ( $args->{from}, { -keyword => join '_', ($args->{type}||()), 'join' }, - (map +($_->{-ident} || $_->{-as} ? $_ : ('(', $_, ')')), $args->{to}), + (map +($_->{-ident} || $_->{-as} + ? $_ + : ('(', $self->render_aqt($_, 1), ')')), + map +(@{$_->{-from_list}||[]} == 1 ? $_->{-from_list}[0] : $_), + $args->{to} + ), ($args->{on} ? ( { -keyword => 'on' }, $args->{on}, @@ -221,11 +234,11 @@ sub _expand_op_as { my ($self, undef, $vv, $k) = @_; my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv); my $ik = $self->expand_expr($k, -ident); - return +{ -as => [ $ik, $self->expand_expr($vv[0], -alias) ] } + return +{ -as => [ $ik, $self->expand_expr($vv[0], -ident) ] } if @vv == 1 and ref($vv[0]) eq 'HASH'; my @as = map $self->expand_expr($_, -ident), @vv; - return { -as => [ $ik, { -alias => \@as } ] }; + return { -as => [ $ik, $self->expand_expr({ -alias => \@as }) ] }; } sub _render_as { @@ -276,11 +289,10 @@ sub _expand_alias { if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) { $args = $alias; } - +{ -alias => [ - map $self->expand_expr($_, -ident), - ref($args) eq 'ARRAY' ? @{$args} : $args - ] - } + my @parts = map $self->expand_expr($_, -ident), + ref($args) eq 'ARRAY' ? @{$args} : $args; + return $parts[0] if @parts == 1; + return { -alias => \@parts }; } sub _expand_with { @@ -328,9 +340,16 @@ sub _render_with { sub _expand_setop { my ($self, $setop, $args) = @_; + my $is_all = $setop =~ s/_all$//; +{ "-${setop}" => { - %$args, - queries => [ map $self->expand_expr($_), @{$args->{queries}} ], + ($is_all ? (type => 'all') : ()), + (ref($args) eq 'ARRAY' + ? (queries => [ map $self->expand_expr($_), @$args ]) + : ( + %$args, + queries => [ map $self->expand_expr($_), @{$args->{queries}} ] + ) + ), } }; } @@ -366,16 +385,29 @@ SQL::Abstract::ExtraClauses - new/experimental additions to L my $sqla = SQL::Abstract->new; SQL::Abstract::ExtraClauses->apply_to($sqla); +=head1 WARNING + +This module is basically a nursery for things that seem like a good idea +to live in until we figure out if we were right about that. + =head1 METHODS =head2 apply_to Applies the plugin to an L object. +=head2 register_extensions + +Registers the extensions described below + =head2 cb For plugin authors, creates a callback to call a method on the plugin. +=head2 register + +For plugin authors, registers callbacks more easily. + =head2 sqla Available only during plugin callback executions, contains the currently @@ -409,12 +441,7 @@ as a list of arguments for the alias node. { foo => { -as => 'bar' } } # aqt - { -as => - [ - { -ident => [ 'foo' ] }, - { -alias => [ { -ident => [ 'bar' ] } ] }, - ] - } + { -as => [ { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] } # query foo AS bar @@ -451,4 +478,331 @@ as a list of arguments for the alias node. CAST(birthday AS date) [] +=head2 join + +If given an arrayref, pretends it was given a hashref with the first +element of the arrayref as the value for 'to' and the remaining pairs copied. + +Given a hashref, the 'as' key is if presented expanded to wrap the 'to'. + +If present the 'using' key is expanded as a list of idents. + +Known keys are: 'from' (the left hand side), 'type' ('left', 'right', or +nothing), 'to' (the right hand side), 'on' and 'using'. + + # expr + { -join => { + from => 'lft', + on => { 'lft.bloo' => { '>' => 'rgt.blee' } }, + to => 'rgt', + type => 'left', + } } + + # aqt + { -join => { + from => { -ident => [ 'lft' ] }, + on => { -op => [ + '>', { -ident => [ 'lft', 'bloo' ] }, + { -ident => [ 'rgt', 'blee' ] }, + ] }, + to => { -ident => [ 'rgt' ] }, + type => 'left', + } } + + # query + lft LEFT JOIN rgt ON lft.bloo > rgt.blee + [] + +=head2 from_list + +List of components of the FROM clause; -foo type elements indicate a pair +with the next element; this is easiest if I show you: + + # expr + { -from_list => [ + 't1', -as => 'table_one', -join => + [ 't2', 'on', { 'table_one.x' => 't2.x' } ], + ] } + + # aqt + { -join => { + from => + { + -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ] + }, + on => { -op => [ + '=', { -ident => [ 'table_one', 'x' ] }, + { -ident => [ 't2', 'x' ] }, + ] }, + to => { -ident => [ 't2' ] }, + type => undef, + } } + + # query + t1 AS table_one JOIN t2 ON table_one.x = t2.x + [] + +Or with using: + + # expr + { -from_list => + [ 't1', -as => 'table_one', -join => [ 't2', 'using', [ 'x' ] ] ] + } + + # aqt + { -join => { + from => + { + -as => [ { -ident => [ 't1' ] }, { -ident => [ 'table_one' ] } ] + }, + to => { -ident => [ 't2' ] }, + type => undef, + using => + { -op => [ 'or', { -op => [ 'or', { -ident => [ 'x' ] } ] } ] }, + } } + + # query + t1 AS table_one JOIN t2 USING ( x ) + [] + +With oddities: + + # expr + { -from_list => [ + 'x', -join => + [ [ 'y', -join => [ 'z', 'type', 'left' ] ], 'type', 'left' ], + ] } + + # aqt + { -join => { + from => { -ident => [ 'x' ] }, + to => { -join => { + from => { -ident => [ 'y' ] }, + to => { -ident => [ 'z' ] }, + type => 'left', + } }, + type => 'left', + } } + + # query + x LEFT JOIN ( y LEFT JOIN z ) + [] + +=head2 setops + +Expanders are provided for union, union_all, intersect, intersect_all, +except and except_all, and each takes an arrayref of queries: + + # expr + { -union => [ + { -select => { _ => { -value => 1 } } }, + { -select => { _ => { -value => 2 } } }, + ] } + + # aqt + { -union => { queries => [ + { -select => + { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } } + }, + { -select => + { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } } + }, + ] } } + + # query + (SELECT ?) UNION (SELECT ?) + [ 1, 2 ] + + # expr + { -union_all => [ + { -select => { _ => { -value => 1 } } }, + { -select => { _ => { -value => 2 } } }, + { -select => { _ => { -value => 1 } } }, + ] } + + # aqt + { -union => { + queries => [ + { -select => + { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } } + }, + { -select => + { select => { -op => [ ',', { -bind => [ undef, 2 ] } ] } } + }, + { -select => + { select => { -op => [ ',', { -bind => [ undef, 1 ] } ] } } + }, + ], + type => 'all', + } } + + # query + (SELECT ?) UNION ALL (SELECT ?) UNION ALL (SELECT ?) + [ 1, 2, 1 ] + +=head1 STATEMENT EXTENSIONS + +=head2 group by clause for select + +Expanded as a list with an ident default: + + # expr + { -select => { group_by => [ 'foo', 'bar' ] } } + + # aqt + { -select => { group_by => + { + -op => [ ',', { -ident => [ 'foo' ] }, { -ident => [ 'bar' ] } ] + } + } } + + # query + GROUP BY foo, bar + [] + +=head2 having clause for select + +Basic expr, just like where, given having is pretty much post-group-by +where clause: + + # expr + { -select => + { having => { '>' => [ { -count => { -ident => 'foo' } }, 3 ] } } + } + + # aqt + { -select => { having => { -op => [ + '>', { -func => [ 'count', { -ident => [ 'foo' ] } ] }, + { -bind => [ undef, 3 ] }, + ] } } } + + # query + HAVING COUNT(foo) > ? + [ 3 ] + +=head2 setop clauses + +If a select query contains a clause matching any of the setop node types, +clauses that appear before the setop would in the resulting query are +gathered together and moved into an inner select node: + + # expr + { -select => { + _ => '*', + from => 'foo', + order_by => 'baz', + union => + { + -select => { _ => '*', from => 'bar', where => { thing => 1 } } + }, + where => { thing => 1 }, + } } + + # aqt + { -select => { + order_by => { -op => [ ',', { -ident => [ 'baz' ] } ] }, + setop => { -union => { queries => [ + { -select => { + from => { -ident => [ 'foo' ] }, + select => { -op => [ ',', { -ident => [ '*' ] } ] }, + where => { -op => [ + '=', { -ident => [ 'thing' ] }, + { -bind => [ 'thing', 1 ] }, + ] }, + } }, ] }, + { -select => { + from => { -ident => [ 'bar' ] }, + select => { -op => [ ',', { -ident => [ '*' ] } ] }, + where => { -op => [ + '=', { -ident => [ 'thing' ] }, + { -bind => [ 'thing', 1 ] }, + } }, + ] } }, + } } + + # query + (SELECT * FROM foo WHERE thing = ?) UNION ( + SELECT * FROM bar WHERE thing = ? + ) + ORDER BY baz + [ 1, 1 ] + +=head2 update from clause + +Some databases allow an additional FROM clause to reference other tables +for the data to update; this clause is expanded as a normal from list, check +your database for what is and isn't allowed in practice. + + # expr + { -update => { + _ => 'employees', + from => 'accounts', + set => { sales_count => { sales_count => { '+' => \1 } } }, + where => { + 'accounts.name' => { '=' => \"'Acme Corporation'" }, + 'employees.id' => { -ident => 'accounts.sales_person' }, + }, + } } + + # aqt + { -update => { + from => { -ident => [ 'accounts' ] }, + set => { -op => [ + ',', { -op => [ + '=', { -ident => [ 'sales_count' ] }, { -op => [ + '+', { -ident => [ 'sales_count' ] }, + { -literal => [ 1 ] }, + ] }, + ] }, + ] }, + target => { -ident => [ 'employees' ] }, + where => { -op => [ + 'and', { -op => [ + '=', { -ident => [ 'accounts', 'name' ] }, + { -literal => [ "'Acme Corporation'" ] }, + ] }, { -op => [ + '=', { -ident => [ 'employees', 'id' ] }, + { -ident => [ 'accounts', 'sales_person' ] }, + ] }, + ] }, + } } + + # query + UPDATE employees SET sales_count = sales_count + 1 FROM accounts + WHERE ( + accounts.name = 'Acme Corporation' + AND employees.id = accounts.sales_person + ) + + [] + + [] + +=head2 delete using clause + +Some databases allow an additional USING clause to reference other tables +for the data to update; this clause is expanded as a normal from list, check +your database for what is and isn't allowed in practice. + + # expr + { -delete => { + from => 'x', + using => 'y', + where => { 'x.id' => { -ident => 'y.x_id' } }, + } } + + # aqt + { -delete => { + target => { -op => [ ',', { -ident => [ 'x' ] } ] }, + using => { -ident => [ 'y' ] }, + where => { -op => [ + '=', { -ident => [ 'x', 'id' ] }, + { -ident => [ 'y', 'x_id' ] }, + ] }, + } } + + # query + DELETE FROM x USING y WHERE x.id = y.x_id + [] + =cut