X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=3f62403f5130cc2805e05e1446918ac5fe9b6540;hb=a639287d1ae82a3b58a75fa2193c900a0ab012ae;hp=406d4e54777b045f55332f4144f1d5ec70d8b03f;hpb=a2ad1cf9037d7a4e562d7e7f31a92a6049f6d3b2;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 406d4e5..3f62403 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -140,12 +140,13 @@ sub is_plain_value ($) { our %Defaults = ( expand => { bool => '_expand_bool', - nest => '_expand_nest', - bind => '_expand_bind', row => '_expand_row', op => '_expand_op', func => '_expand_func', values => '_expand_values', + bind => '_expand_noop', + literal => '_expand_noop', + keyword => '_expand_noop', }, expand_op => { 'between' => '_expand_between', @@ -159,7 +160,8 @@ our %Defaults = ( 'value' => '_expand_value', }, render => { - (map +($_, "_render_$_"), qw(op func bind ident literal row values)), + (map +($_, "_render_$_"), + qw(op func bind ident literal row values keyword)), }, render_op => { (map +($_ => '_render_op_between'), 'between', 'not_between'), @@ -473,7 +475,7 @@ sub _render_insert_clause_fields { sub _render_insert_clause_target { my ($self, undef, $from) = @_; - $self->join_query_parts(' ', $self->format_keyword('insert into'), $from); + $self->join_query_parts(' ', { -keyword => 'insert into' }, $from); } sub _render_insert_clause_from { @@ -552,7 +554,7 @@ sub update { sub _render_update_clause_target { my ($self, undef, $target) = @_; - $self->join_query_parts(' ', $self->format_keyword('update'), $target); + $self->join_query_parts(' ', { -keyword => 'update' }, $target); } sub _update_set_values { @@ -737,7 +739,7 @@ sub _expand_delete_clause_returning { sub _render_delete_clause_target { my ($self, undef, $from) = @_; - $self->join_query_parts(' ', $self->format_keyword('delete from'), $from); + $self->join_query_parts(' ', { -keyword => 'delete from' }, $from); } #====================================================================== @@ -840,7 +842,7 @@ sub _render_statement { my $r = $self->render_aqt($clause_expr, 1); next unless defined $r->[0] and length $r->[0]; $self->join_query_parts(' ', - $self->format_keyword($clause), + { -keyword => $clause }, $r ); } @@ -1034,13 +1036,6 @@ sub _expand_hashpair_op { } } - # an explicit node type is currently assumed to be expanded (this is almost - # certainly wrong and there should be expansion anyway) - - if ($self->{render}{$op}) { - return { $k => $v }; - } - my $type = ( $self->{unknown_unop_always_func} && !$self->{render_op}{$op} ? -func @@ -1065,12 +1060,11 @@ sub _expand_hashpair_op { } } - return +{ $type => [ - $op, - ($type eq -func and ref($v) eq 'ARRAY') - ? map $self->_expand_expr($_), @$v - : $self->_expand_expr($v) - ] }; + if ($type eq -func and ref($v) eq 'ARRAY') { + return $self->_expand_expr({ -func => [ $op, @$v ] }); + } + + return $self->_expand_expr({ $type => [ $op, $v ] }); } sub _expand_hashpair_cmp { @@ -1308,7 +1302,7 @@ sub _expand_between { return +{ -op => [ $op, $self->expand_expr(ref($k) ? $k : { -ident => $k }), - @rhs + map $self->expand_expr($_, -value), @rhs ] } } @@ -1359,9 +1353,9 @@ sub _expand_nest { return $self->_expand_expr($v); } -sub _expand_bind { - my ($self, undef, $bind) = @_; - return { -bind => $bind }; +sub _expand_noop { + my ($self, $type, $v) = @_; + return { "-${type}" => $v }; } sub _expand_values { @@ -1376,12 +1370,12 @@ sub _expand_values { } sub _recurse_where { - my ($self, $where, $logic) = @_; + my ($self, $where) = @_; # Special case: top level simple string treated as literal my $where_exp = (ref($where) - ? $self->_expand_expr($where, $logic) + ? $self->_expand_select_clause_where(undef, $where) : { -literal => [ $where ] }); # dispatch expanded expression @@ -1401,7 +1395,7 @@ sub _recurse_where { sub _render_ident { my ($self, undef, $ident) = @_; - return [ $self->_convert($self->_quote($ident)) ]; + return [ $self->_quote($ident) ]; } sub _render_row { @@ -1428,7 +1422,7 @@ sub _render_func { sub _render_bind { my ($self, undef, $bind) = @_; - return [ $self->_convert('?'), $self->_bindtype(@$bind) ]; + return [ '?', $self->_bindtype(@$bind) ]; } sub _render_literal { @@ -1437,6 +1431,11 @@ sub _render_literal { return $literal; } +sub _render_keyword { + my ($self, undef, $keyword) = @_; + return [ $self->_sqlcase(join ' ', split '_', $keyword) ]; +} + sub _render_op { my ($self, undef, $v) = @_; my ($op, @args) = @$v; @@ -1481,11 +1480,11 @@ sub _render_op_between { unless $low->{-literal}; $low; } else { - +($low, $self->format_keyword('and'), $high); + +($low, { -keyword => 'and' }, $high); } }; return $self->join_query_parts(' ', - '(', $left, $self->format_keyword($op), @rh, ')', + '(', $left, { -keyword => $op }, @rh, ')', ); } @@ -1495,7 +1494,7 @@ sub _render_op_in { return $self->join_query_parts(' ', $lhs, - $self->format_keyword($op), + { -keyword => $op }, $self->join_query_parts(' ', '(', $self->join_query_parts(', ', @rhs), @@ -1522,7 +1521,7 @@ sub _render_op_multop { return $self->render_aqt($parts[0]) if @parts == 1; my $join = ($op eq ',' ? ', ' - : ' '.$self->format_keyword($op).' ' + : { -keyword => ' '.join(' ', split '_', $op).' ' } ); return $self->join_query_parts($join, @parts); } @@ -1530,7 +1529,7 @@ sub _render_op_multop { sub _render_values { my ($self, undef, $values) = @_; my $inner = $self->join_query_parts(' ', - $self->format_keyword('values'), + { -keyword => 'values' }, $self->join_query_parts(', ', ref($values) eq 'ARRAY' ? @$values : $values ), @@ -1542,6 +1541,9 @@ sub _render_values { sub join_query_parts { my ($self, $join, @parts) = @_; + if (ref($join) eq 'HASH') { + $join = $self->render_aqt($join)->[0]; + } my @final = map +( ref($_) eq 'HASH' ? $self->render_aqt($_) @@ -1572,7 +1574,7 @@ sub _render_unop_prefix { sub _render_unop_postfix { my ($self, $op, $v) = @_; return $self->join_query_parts(' ', - $v->[0], $self->format_keyword($op), + $v->[0], { -keyword => $op }, ); } @@ -1766,7 +1768,7 @@ sub _convert { #my ($self, $arg) = @_; if (my $conv = $_[0]->{convert_where}) { return @{ $_[0]->join_query_parts('', - $_[0]->format_keyword($conv), + $_[0]->_sqlcase($conv), '(' , $_[1] , ')' ) }; } @@ -1821,8 +1823,6 @@ sub _sqlcase { return $_[0]->{case} ? $_[1] : uc($_[1]); } -sub format_keyword { $_[0]->_sqlcase(join ' ', split '_', $_[1]) } - #====================================================================== # DISPATCHING FROM REFKIND #======================================================================