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=eaac9c171cf9ca21ae4da60fa985c5dac8d3bc3a;hpb=3f9899e505733687a57b30404dff4a060dca7474;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index eaac9c1..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) = @_; @@ -92,9 +103,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,45 +133,60 @@ 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_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, ); }); + 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; } -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 +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; @@ -200,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; @@ -215,60 +242,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} ? $_ : ('(', $_, ')')), $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) );