X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FExtraClauses.pm;h=3467f23ff86f5f454e0320b722808f951fcd60a9;hb=984db0d74eadc40e35f40a013e11d35062eab02a;hp=eaac9c171cf9ca21ae4da60fa985c5dac8d3bc3a;hpb=3f9899e505733687a57b30404dff4a060dca7474;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index eaac9c1..3467f23 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) = @_; @@ -92,9 +104,9 @@ sub register_defaults { $self->renderer($_ => sub { my ($self, $setop, $args) = @_; - $self->join_clauses( + $self->join_query_parts( ' '.$self->format_keyword(join '_', $setop, ($args->{type}||())).' ', - map [ $self->render_aqt($_) ], @{$args->{queries}} + @{$args->{queries}} ); }) for qw(union intersect except); @@ -122,16 +134,19 @@ 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) ]; } @@ -140,18 +155,18 @@ sub register_defaults { $self->clause_expander('select.with_recursive', $with_expander); $self->clause_renderer('select.with' => sub { my ($self, undef, $with) = @_; - my $q_part = [ $self->join_clauses(', ', + my $q_part = $self->join_query_parts(', ', map { my ($alias, $query) = @$_; - [ $self->join_clauses(' ', - [ $self->_render_alias($alias) ], - [ $self->format_keyword('as') ], - [ $self->render_aqt($query) ], - ) ] + $self->join_query_parts(' ', + $alias, + $self->format_keyword('as'), + $query, + ) } @{$with->{queries}} - ) ]; - return $self->join_clauses(' ', - [ $self->format_keyword(join '_', 'with', ($with->{type}||'')) ], + ); + return $self->join_query_parts(' ', + $self->format_keyword(join '_', 'with', ($with->{type}||'')), $q_part, ); }); @@ -159,8 +174,6 @@ sub register_defaults { return $self; } -sub format_keyword { $_[0]->_sqlcase(join ' ', split '_', $_[1]) } - sub _expand_select_clause_from { my ($self, undef, $from) = @_; +(from => $self->_expand_from_list(undef, $from)); @@ -169,6 +182,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; @@ -200,7 +214,7 @@ 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 => [ @@ -215,60 +229,63 @@ sub _expand_join { sub _render_from_list { my ($self, undef, $list) = @_; - return $self->join_clauses(', ', map [ $self->render_aqt($_) ], @$list); + return $self->join_query_parts(', ', @$list); } 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} ? $_ : { -row => [ $_ ] }), $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_clauses(' ', @parts); + return $self->join_query_parts(' ', @parts); } 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; - return $self->join_clauses( + 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_clauses('', - [ $self->render_aqt($as) ], - [ '(' ], - [ $self->join_clauses( - ', ', - map [ $self->render_aqt($_) ], @cols - ) ], - [ ')' ], + ? $self->join_query_parts('', + $as, + '(', + $self->join_query_parts( + ', ', + @cols + ), + ')', ) : $self->render_aqt($as) );