X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FExtraClauses.pm;h=cb64a5e395ba17764a0fca49cef10a9b69b55649;hb=fda0b270e45b2f419edf94e4f7e91d82d31c6f84;hp=27f88f91f056f302e7c99527faf0a75713971e38;hpb=41086177ba1f6933a58673c79af6770fba80700e;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index 27f88f9..cb64a5e 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -5,16 +5,16 @@ use Moo; has sqla => ( is => 'ro', init_arg => undef, handles => [ qw( - expand_expr expand_maybe_list_expr render_aqt - format_keyword join_query_parts + expand_expr expand_maybe_list_expr render_aqt join_query_parts ) ], ); -BEGIN { *puke = \&SQL::Abstract::puke } - sub cb { - my ($self, $method) = @_; - return sub { local $self->{sqla} = shift; $self->$method(@_) }; + my ($self, $method, @args) = @_; + return sub { + local $self->{sqla} = shift; + $self->$method(@args, @_) + }; } sub apply_to { @@ -41,8 +41,7 @@ sub apply_to { $sqla->expander($thing => $self->cb("_expand_${thing}")) ->renderer($thing => $self->cb("_render_${thing}")) } - $sqla->op_expander(as => $self->cb('_expand_op_as')); - $sqla->expander(as => $self->cb('_expand_op_as')); + $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')); @@ -60,10 +59,8 @@ sub apply_to { }); $sqla->clause_expanders( - 'update.from' => $self->cb('_expand_select_clause_from'), - 'delete.using' => $self->cb(sub { - +(using => $_[0]->_expand_from_list(undef, $_[2])); - }), + '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] })); }), @@ -74,24 +71,12 @@ sub apply_to { # set ops $sqla->wrap_expander(select => sub { - my $orig = shift; - $self->cb(sub { - my $self = shift; - my $exp = $self->sqla->$orig(@_); - return $exp unless my $setop = (my $sel = $exp->{-select})->{setop}; - if (my @keys = grep $sel->{$_}, @before_setop) { - my %inner; @inner{@keys} = delete @{$sel}{@keys}; - unshift @{(values(%$setop))[0]{queries}}, - { -select => \%inner }; - } - return $exp; - }); + $self->cb('_expand_select', $_[0], \@before_setop); }); - $sqla->clause_renderer('select.setop' => $self->cb(sub { - my ($self, undef, $setop) = @_; - $self->render_aqt($setop); - })); + $sqla->clause_renderer( + 'select.setop' => $self->cb(sub { $_[0]->render_aqt($_[2]); }) + ); foreach my $setop (qw(union intersect except)) { $sqla->expander($setop => $self->cb('_expand_setop')); @@ -123,7 +108,7 @@ sub apply_to { $sqla->expander(cast => $self->cb('_expand_cast')); $sqla->clause_expanders( - "select.from", $self->cb('_expand_select_clause_from'), + "select.from", $self->cb('_expand_from_list'), "update.target", $self->cb('_expand_update_clause_target'), "update.update", $self->cb('_expand_update_clause_target'), ); @@ -131,9 +116,16 @@ sub apply_to { return $sqla; } -sub _expand_select_clause_from { - my ($self, undef, $from) = @_; - +(from => $self->_expand_from_list(undef, $from)); +sub _expand_select { + my ($self, $orig, $before_setop, @args) = @_; + my $exp = $self->sqla->$orig(@args); + return $exp unless my $setop = (my $sel = $exp->{-select})->{setop}; + if (my @keys = grep $sel->{$_}, @$before_setop) { + my %inner; @inner{@keys} = delete @{$sel}{@keys}; + unshift @{(values(%$setop))[0]{queries}}, + { -select => \%inner }; + } + return $exp; } sub _expand_from_list { @@ -194,14 +186,14 @@ sub _render_join { my @parts = ( $args->{from}, - $self->format_keyword(join '_', ($args->{type}||()), 'join'), + { -keyword => join '_', ($args->{type}||()), 'join' }, (map +($_->{-ident} || $_->{-as} ? $_ : ('(', $_, ')')), $args->{to}), ($args->{on} ? ( - $self->format_keyword('on') , + { -keyword => 'on' }, $args->{on}, ) : ()), ($args->{using} ? ( - $self->format_keyword('using'), + { -keyword => 'using' }, '(', $args->{using}, ')', ) : ()), ); @@ -211,7 +203,6 @@ sub _render_join { sub _expand_op_as { my ($self, undef, $vv, $k) = @_; my @vv = (ref($vv) eq 'ARRAY' ? @$vv : $vv); - $k ||= shift @vv; my $ik = $self->expand_expr($k, -ident); return +{ -as => [ $ik, $self->expand_expr($vv[0], -alias) ] } if @vv == 1 and ref($vv[0]) eq 'HASH'; @@ -226,7 +217,7 @@ sub _render_as { return $self->join_query_parts( ' ', $thing, - $self->format_keyword('as'), + { -keyword => 'as' }, $alias, ); } @@ -307,13 +298,13 @@ sub _render_with { my ($alias, $query) = @$_; $self->join_query_parts(' ', $alias, - $self->format_keyword('as'), + { -keyword => 'as' }, $query, ) } @{$with->{queries}} ); return $self->join_query_parts(' ', - $self->format_keyword(join '_', 'with', ($with->{type}||'')), + { -keyword => join '_', 'with', ($with->{type}||'') }, $q_part, ); } @@ -329,7 +320,7 @@ sub _expand_setop { sub _render_setop { my ($self, $setop, $args) = @_; $self->join_query_parts( - ' '.$self->format_keyword(join '_', $setop, ($args->{type}||())).' ', + { -keyword => ' '.join('_', $setop, ($args->{type}||())).' ' }, @{$args->{queries}} ); }