X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FExtraClauses.pm;h=73e7073a3476a623be22496929b02f84674b7295;hb=a3040091c492c3fca3e8d22b4192572858f7ccf8;hp=f7da28082281484dcbf171cb765381ee3d71b513;hpb=412f9efece1d9a7e967b937b38e89c4821e08dce;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index f7da280..73e7073 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -4,13 +4,12 @@ use strict; use warnings; use if $] < '5.010', 'MRO::Compat'; use mro 'c3'; -use base qw(SQL::Abstract::Clauses); +use base qw(SQL::Abstract); BEGIN { *puke = \&SQL::Abstract::puke } -sub register_defaults { - my $self = shift; - $self->next::method(@_); +sub new { + my $self = shift->next::method(@_); my @clauses = $self->clauses_of('select'); my @before_setop; CLAUSE: foreach my $idx (0..$#clauses) { @@ -35,6 +34,18 @@ sub register_defaults { $self->op_expander(as => '_expand_op_as'); $self->expander(as => '_expand_op_as'); $self->renderer(as => '_render_as'); + $self->expander(alias => sub { + my ($self, undef, $args) = @_; + if (ref($args) eq 'HASH' and my $alias = $args->{-alias}) { + $args = $alias; + } + +{ -alias => [ + map $self->expand_expr($_, -ident), + ref($args) eq 'ARRAY' ? @{$args} : $args + ] + } + }); + $self->renderer(alias => '_render_alias'); $self->clauses_of(update => sub { my ($self, @clauses) = @_; @@ -122,39 +133,56 @@ sub register_defaults { if (ref($with) eq 'HASH') { return +{ %$with, - queries => [ map $self->expand_expr($_), @{$with->{queries}} ] + queries => [ + map +[ + $self->expand_expr({ -alias => $_->[0] }, -ident), + $self->expand_expr($_->[1]), + ], @{$with->{queries}} + ] } } my @with = @$with; my @exp; - while (my ($name, $query) = splice @with, 0, 2) { - my @n = map $self->expand_expr($_, -ident), - ref($name) eq 'ARRAY' ? @$name : $name; + while (my ($alias, $query) = splice @with, 0, 2) { push @exp, [ - \@n, + $self->expand_expr({ -alias => $alias }, -ident), $self->expand_expr($query) ]; } return +(with => { ($type ? (type => $type) : ()), queries => \@exp }); }); $self->clause_expander('select.with_recursive', $with_expander); - $self->clause_renderer('select.with' => sub { + $self->clause_renderer('select.with' => my $with_renderer = sub { my ($self, undef, $with) = @_; - my $q_part = [ $self->join_query_parts(', ', + my $q_part = $self->join_query_parts(', ', map { my ($alias, $query) = @$_; - [ $self->join_query_parts(' ', - [ $self->_render_alias($alias) ], - [ $self->format_keyword('as') ], + $self->join_query_parts(' ', + $alias, + $self->format_keyword('as'), $query, - ) ] + ) } @{$with->{queries}} - ) ]; + ); return $self->join_query_parts(' ', - [ $self->format_keyword(join '_', 'with', ($with->{type}||'')) ], + $self->format_keyword(join '_', 'with', ($with->{type}||'')), $q_part, ); }); + foreach my $stmt (qw(insert update delete)) { + $self->clauses_of($stmt => 'with', $self->clauses_of($stmt)); + $self->clause_expander("${stmt}.$_", $with_expander) + for qw(with with_recursive); + $self->clause_renderer("${stmt}.with", $with_renderer); + } + $self->expander(cast => sub { + return { -func => [ cast => $_[2] ] } if ref($_[2]) eq 'HASH'; + my ($cast, $to) = @{$_[2]}; + +{ -func => [ cast => { -as => [ + $self->expand_expr($cast), + $self->expand_expr($to, -ident), + ] } ] }; + }); return $self; } @@ -167,6 +195,7 @@ sub _expand_select_clause_from { sub _expand_from_list { my ($self, undef, $args) = @_; if (ref($args) eq 'HASH') { + return $args if $args->{-from_list}; return { -from_list => [ $self->expand_expr($args) ] }; } my @list; @@ -198,13 +227,13 @@ sub _expand_join { : (to => $args->[0], @{$args}[1..$#$args]) ); if (my $as = delete $proto{as}) { - $proto{to} = { -as => [ $proto{to}, ref($as) eq 'ARRAY' ? @$as : $as ] }; + $proto{to} = $self->expand_expr({ -as => [ $proto{to}, $as ] }); } if (defined($proto{using}) and ref(my $using = $proto{using}) ne 'HASH') { - $proto{using} = { -row => [ + $proto{using} = [ map [ $self->expand_expr($_, -ident) ], ref($using) eq 'ARRAY' ? @$using: $using - ] }; + ]; } my %ret = map +($_ => $self->expand_expr($proto{$_}, -ident)), sort keys %proto; @@ -222,14 +251,14 @@ sub _render_join { my @parts = ( $args->{from}, $self->format_keyword(join '_', ($args->{type}||()), 'join'), - (map +($_->{-ident} || $_->{-as} ? $_ : { -row => [ $_ ] }), $args->{to}), + (map +($_->{-ident} || $_->{-as} ? $_ : ('(', $_, ')')), $args->{to}), ($args->{on} ? ( $self->format_keyword('on') , $args->{on}, ) : ()), ($args->{using} ? ( $self->format_keyword('using'), - $args->{using}, + '(', $args->{using}, ')', ) : ()), ); return $self->join_query_parts(' ', @parts); @@ -237,34 +266,39 @@ sub _render_join { sub _expand_op_as { my ($self, undef, $vv, $k) = @_; - my @as = map $self->expand_expr($_, -ident), - (defined($k) ? ($k) : ()), ref($vv) eq 'ARRAY' ? @$vv : $vv; - return { -as => \@as }; + 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'; + + my @as = map $self->expand_expr($_, -ident), @vv; + return { -as => [ $ik, { -alias => \@as } ] }; } sub _render_as { my ($self, undef, $args) = @_; - my ($thing, @alias) = @$args; + my ($thing, $alias) = @$args; return $self->join_query_parts( ' ', - [ $self->render_aqt($thing) ], - [ $self->format_keyword('as') ], - [ $self->_render_alias(\@alias) ], + $thing, + $self->format_keyword('as'), + $alias, ); } sub _render_alias { - my ($self, $args) = @_; + my ($self, undef, $args) = @_; my ($as, @cols) = @$args; return (@cols ? $self->join_query_parts('', $as, - [ '(' ], - [ $self->join_query_parts( - ', ', - @cols - ) ], - [ ')' ], + '(', + $self->join_query_parts( + ', ', + @cols + ), + ')', ) : $self->render_aqt($as) );