X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FExtraClauses.pm;h=2dafda1aa83f606a7a7eab566fca1b345c9e6a0b;hb=a97ecd95f2256f8e86c370fb19c570aa013cbf89;hp=6cfdc0f750b515a97ab78c6586e40d63ce462499;hpb=eaba09fc57316874586e26226a547d943327c955;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index 6cfdc0f..2dafda1 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -35,6 +35,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 +134,48 @@ 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); + } return $self; } @@ -167,6 +188,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 +220,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; @@ -220,18 +242,16 @@ sub _render_join { my ($self, undef, $args) = @_; my @parts = ( - [ $self->render_aqt($args->{from}) ], - [ $self->format_keyword(join '_', ($args->{type}||()), 'join') ], - [ $self->render_aqt( - map +($_->{-ident} || $_->{-as} ? $_ : { -row => [ $_ ] }), $args->{to} - ) ], + $args->{from}, + $self->format_keyword(join '_', ($args->{type}||()), 'join'), + (map +($_->{-ident} || $_->{-as} ? $_ : ('(', $_, ')')), $args->{to}), ($args->{on} ? ( - [ $self->format_keyword('on') ], - [ $self->render_aqt($args->{on}) ], + $self->format_keyword('on') , + $args->{on}, ) : ()), ($args->{using} ? ( - [ $self->format_keyword('using') ], - [ $self->render_aqt($args->{using}) ], + $self->format_keyword('using'), + '(', $args->{using}, ')', ) : ()), ); return $self->join_query_parts(' ', @parts); @@ -239,34 +259,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) );