X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=59ea97d0e4ca1bba0e730b3c19307063dddc310d;hb=0236f122f73090f9773bae7a6941a286c86ff889;hp=35a971d1b0776edac17f33105302de07567864aa;hpb=bd00b85c552ca9b51d06de615a669725dd3e69af;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 35a971d..59ea97d 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -208,6 +208,7 @@ sub new { (map +($_ => '_expand_op_is'), ('is', 'is_not')), ident => '_expand_ident', value => '_expand_value', + func => '_expand_func', }; $opt{expand_op} = { @@ -270,16 +271,13 @@ sub insert { my @parts = ([ $self->_sqlcase('insert into').' '.$table ]); push @parts, [ $self->render_aqt($f_aqt) ] if $f_aqt; - push @parts, [ $self->render_aqt($v_aqt) ]; - $parts[-1][0] =~ s/^/VALUES /; + push @parts, [ $self->_sqlcase('values') ], [ $self->render_aqt($v_aqt) ]; if ($options->{returning}) { push @parts, [ $self->_insert_returning($options) ]; } - my ($sql, @bind) = $self->_join_parts(' ', @parts); - - return wantarray ? ($sql, @bind) : $sql; + return $self->join_query_parts(' ', @parts); } sub _expand_insert_values { @@ -395,12 +393,12 @@ sub _update_set_values { my ($self, $data) = @_; return $self->render_aqt( - $self->_expand_update_set_values($data), + $self->_expand_update_set_values(undef, $data), ); } sub _expand_update_set_values { - my ($self, $data) = @_; + my ($self, undef, $data) = @_; $self->_expand_maybe_list_expr( [ map { my ($k, $set) = @$_; @@ -532,14 +530,17 @@ sub render_aqt { die "No" if @rest; die "Not a node type: $k" unless $k =~ s/^-//; if (my $meth = $self->{render}{$k}) { - return $self->$meth($v); + return $self->$meth($k, $v); } die "notreached: $k"; } sub render_expr { my ($self, $expr, $default_scalar_to) = @_; - $self->render_aqt($self->expand_expr($expr, $default_scalar_to)); + my ($sql, @bind) = $self->render_aqt( + $self->expand_expr($expr, $default_scalar_to) + ); + return (wantarray ? ($sql, @bind) : $sql); } sub _normalize_op { @@ -587,6 +588,11 @@ sub _expand_hashpair { } if ($k =~ /^-/) { return $self->_expand_hashpair_op($k, $v); + } elsif ($k =~ /^[^\w]/i) { + my ($lhs, @rhs) = @$v; + return $self->_expand_op( + -op, [ $k, $self->expand_expr($lhs, -ident), @rhs ] + ); } return $self->_expand_hashpair_ident($k, $v); } @@ -718,29 +724,29 @@ sub _expand_hashpair_op { return { $k => $v }; } - # hashref RHS values get expanded and used as op/func args + my $type = $self->{unknown_unop_always_func} ? -func : -op; - if ( - ref($v) eq 'HASH' - and keys %$v == 1 - and (keys %$v)[0] =~ /^-/ - ) { - my ($func) = $k =~ /^-(.*)$/; - { # Old SQLA compat - if (List::Util::first { $func =~ $_->{regex} } @{$self->{special_ops}}) { - return +{ -op => [ $func, $self->_expand_expr($v) ] }; - } - } - return +{ -func => [ $func, $self->_expand_expr($v) ] }; - } - - # scalars and literals get simply expanded + { # Old SQLA compat - if (!ref($v) or is_literal_value($v)) { - return +{ -op => [ $op, $self->_expand_expr($v) ] }; + if ( + ref($v) eq 'HASH' + and keys %$v == 1 + and (keys %$v)[0] =~ /^-/ + ) { + $type = ( + (List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) + ? -op + : -func + ) + } } - die "notreached"; + return +{ $type => [ + $op, + ($type eq -func and ref($v) eq 'ARRAY') + ? map $self->_expand_expr($_), @$v + : $self->_expand_expr($v) + ] }; } sub _expand_hashpair_cmp { @@ -844,6 +850,12 @@ sub _dwim_op_to_is { puke(sprintf $fail, $op); } +sub _expand_func { + my ($self, undef, $args) = @_; + my ($func, @args) = @$args; + return { -func => [ $func, map $self->expand_expr($_), @args ] }; +} + sub _expand_ident { my ($self, undef, $body, $k) = @_; return $self->_expand_hashpair_cmp( @@ -1056,20 +1068,23 @@ sub _recurse_where { } sub _render_ident { - my ($self, $ident) = @_; + my ($self, undef, $ident) = @_; return $self->_convert($self->_quote($ident)); } sub _render_row { - my ($self, $values) = @_; - my ($sql, @bind) = $self->_render_op([ ',', @$values ]); + my ($self, undef, $values) = @_; + my ($sql, @bind) = $self->_render_op(undef, [ ',', @$values ]); return "($sql)", @bind; } sub _render_func { - my ($self, $rest) = @_; + my ($self, undef, $rest) = @_; my ($func, @args) = @$rest; + if (ref($func) eq 'HASH') { + $func = $self->render_aqt($func); + } my @arg_sql; my @bind = map { my @x = @$_; @@ -1080,18 +1095,18 @@ sub _render_func { } sub _render_bind { - my ($self, $bind) = @_; + my ($self, undef, $bind) = @_; return ($self->_convert('?'), $self->_bindtype(@$bind)); } sub _render_literal { - my ($self, $literal) = @_; + my ($self, undef, $literal) = @_; $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]); return @$literal; } sub _render_op { - my ($self, $v) = @_; + my ($self, undef, $v) = @_; my ($op, @args) = @$v; if (my $r = $self->{render_op}{$op}) { return $self->$r($op, \@args); @@ -1170,30 +1185,30 @@ sub _render_op_in { sub _render_op_andor { my ($self, $op, $args) = @_; - my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args; + my @parts = map [ $self->render_aqt($_) ], @$args; return '' unless @parts; return @{$parts[0]} if @parts == 1; - my ($sql, @bind) = $self->_join_parts(' '.$self->_sqlcase($op).' ', @parts); + my ($sql, @bind) = $self->join_query_parts(' '.$self->_sqlcase($op).' ', @parts); return '( '.$sql.' )', @bind; } sub _render_op_multop { my ($self, $op, $args) = @_; - my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args; + my @parts = map [ $self->render_aqt($_) ], @$args; return '' unless @parts; return @{$parts[0]} if @parts == 1; my $join = ($op eq ',' ? ', ' : ' '.$self->_sqlcase(join ' ', split '_', $op).' ' ); - return $self->_join_parts($join, @parts); + return $self->join_query_parts($join, @parts); } -sub _join_parts { +sub join_query_parts { my ($self, $join, @parts) = @_; return ( join($join, map $_->[0], @parts), - map @{$_}[1..$#$_], @parts + (wantarray ? (map @{$_}[1..$#$_], @parts) : ()), ); }