X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=5b48dcf37acc3b4e59d10066cb0cc5cac78e654a;hb=ef89a85d54dbfbfb740b9e6a310758df8c532af5;hp=be1f3c5e8f08ea73881c209fe84b0d91c1f65694;hpb=7a36c11c3bf30a0544c0311e07475b2ff0775ab5;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index be1f3c5..5b48dcf 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -270,14 +270,15 @@ sub insert { my ($f_aqt, $v_aqt) = $self->_expand_insert_values($data); my @parts = ([ $self->_sqlcase('insert into').' '.$table ]); - push @parts, [ $self->render_aqt($f_aqt) ] if $f_aqt; - push @parts, [ $self->_sqlcase('values') ], [ $self->render_aqt($v_aqt) ]; + push @parts, $self->render_aqt($f_aqt) if $f_aqt; + push @parts, [ $self->_sqlcase('values') ], $self->render_aqt($v_aqt); if ($options->{returning}) { push @parts, [ $self->_insert_returning($options) ]; } - return $self->join_query_parts(' ', @parts); + my ($sql, @bind) = @{ $self->join_query_parts(' ', @parts) }; + return wantarray ? ($sql, @bind) : $sql; } sub _expand_insert_values { @@ -319,12 +320,10 @@ sub _returning { my $f = $options->{returning}; - my ($sql, @bind) = $self->render_aqt( + my ($sql, @bind) = @{ $self->render_aqt( $self->_expand_maybe_list_expr($f, -ident) - ); - return wantarray - ? $self->_sqlcase(' returning ') . $sql - : ($self->_sqlcase(' returning ').$sql, @bind); + ) }; + return ($self->_sqlcase(' returning ').$sql, @bind); } sub _expand_insert_value { @@ -392,9 +391,9 @@ sub update { sub _update_set_values { my ($self, $data) = @_; - return $self->render_aqt( + return @{ $self->render_aqt( $self->_expand_update_set_values(undef, $data), - ); + ) }; } sub _expand_update_set_values { @@ -403,7 +402,7 @@ sub _expand_update_set_values { map { my ($k, $set) = @$_; $set = { -bind => $_ } unless defined $set; - +{ -op => [ '=', $self->_expand_ident(-ident => $k), $set ] }; + +{ -op => [ '=', { -ident => $k }, $set ] }; } map { my $k = $_; @@ -454,9 +453,9 @@ sub select { sub _select_fields { my ($self, $fields) = @_; return $fields unless ref($fields); - return $self->render_aqt( + return @{ $self->render_aqt( $self->_expand_maybe_list_expr($fields, '-ident') - ); + ) }; } #====================================================================== @@ -537,10 +536,9 @@ sub render_aqt { sub render_expr { my ($self, $expr, $default_scalar_to) = @_; - my ($sql, @bind) = $self->render_aqt( + return @{ $self->render_aqt( $self->expand_expr($expr, $default_scalar_to) - ); - return (wantarray ? ($sql, @bind) : $sql); + ) }; } sub _normalize_op { @@ -757,7 +755,7 @@ sub _expand_hashpair_cmp { sub _expand_hashtriple { my ($self, $k, $vk, $vv) = @_; - my $ik = $self->_expand_ident(-ident => $k); + my $ik = $self->_expand_expr({ -ident => $k }); my $op = $self->_normalize_op($vk); $self->_assert_pass_injection_guard($op); @@ -853,7 +851,7 @@ sub _dwim_op_to_is { sub _expand_func { my ($self, undef, $args) = @_; my ($func, @args) = @$args; - return { -func => [ $func, map $self->expand_expr($_), @args ] }; + return +{ -func => [ $func, map $self->expand_expr($_), @args ] }; } sub _expand_ident { @@ -904,7 +902,7 @@ sub _expand_bool { return $self->_expand_expr($v); } puke "-bool => undef not supported" unless defined($v); - return $self->_expand_ident(-ident => $v); + return $self->_expand_expr({ -ident => $v }); } sub _expand_op_andor { @@ -1055,7 +1053,7 @@ sub _recurse_where { # dispatch expanded expression - my ($sql, @bind) = defined($where_exp) ? $self->render_aqt($where_exp) : (undef); + my ($sql, @bind) = defined($where_exp) ? @{ $self->render_aqt($where_exp) || [] } : (); # DBIx::Class used to call _recurse_where in scalar context # something else might too... if (wantarray) { @@ -1070,35 +1068,38 @@ sub _recurse_where { sub _render_ident { my ($self, undef, $ident) = @_; - return $self->_convert($self->_quote($ident)); + return [ $self->_convert($self->_quote($ident)) ]; } sub _render_row { my ($self, undef, $values) = @_; - my ($sql, @bind) = $self->_render_op(undef, [ ',', @$values ]); - return $self->join_query_parts('', [ '(' ], [ $sql, @bind ], [ ')' ]); + return $self->join_query_parts('', + '(', + $self->_render_op(undef, [ ',', @$values ]), + ')' + ); } sub _render_func { my ($self, undef, $rest) = @_; my ($func, @args) = @$rest; return $self->join_query_parts('', - [ $self->_sqlcase($func) ], - [ '(' ], - [ $self->join_query_parts(', ', @args) ], - [ ')' ] + $self->_sqlcase($func), + '(', + $self->join_query_parts(', ', @args), + ')' ); } sub _render_bind { my ($self, undef, $bind) = @_; - return ($self->_convert('?'), $self->_bindtype(@$bind)); + return [ $self->_convert('?'), $self->_bindtype(@$bind) ]; } sub _render_literal { my ($self, undef, $literal) = @_; $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]); - return @$literal; + return $literal; } sub _render_op { @@ -1118,10 +1119,10 @@ sub _render_op { unless my ($ident) = map $_->{-ident}, grep ref($_) eq 'HASH', $args[0]; my $k = join(($self->{name_sep}||'.'), @$ident); local our $Expand_Depth = 1; - return $self->${\($ss->{handler})}($k, $op, $args[1]); + return [ $self->${\($ss->{handler})}($k, $op, $args[1]) ]; } if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) { - return $self->${\($us->{handler})}($op, $args[0]); + return [ $self->${\($us->{handler})}($op, $args[0]) ]; } if ($ss) { return $self->_render_unop_paren($op, \@args); @@ -1161,25 +1162,25 @@ sub _render_op_in { $lhs, $self->format_keyword($op), '(', - [ $self->join_query_parts(', ', @rhs) ], + $self->join_query_parts(', ', @rhs), ')' ); } sub _render_op_andor { my ($self, $op, $args) = @_; - return '' unless @$args; + return undef unless @$args; return $self->join_query_parts('', $args->[0]) if @$args == 1; return $self->join_query_parts( - ' ' => '(',[ $self->_render_op_multop($op, $args) ], ')' + ' ' => '(', $self->_render_op_multop($op, $args), ')' ); } sub _render_op_multop { my ($self, $op, $args) = @_; - my @parts = map [ $self->render_aqt($_) ], @$args; - return '' unless @parts; - return @{$parts[0]} if @parts == 1; + my @parts = @$args; + return undef unless @parts; + return $self->render_aqt($parts[0]) if @parts == 1; my $join = ($op eq ',' ? ', ' : ' '.$self->format_keyword($op).' ' @@ -1191,19 +1192,19 @@ sub join_query_parts { my ($self, $join, @parts) = @_; my @final = map +( ref($_) eq 'HASH' - ? [ $self->render_aqt($_) ] - : ref($_) eq 'ARRAY' ? $_ : [ $_ ]), - @parts; - return ( + ? $self->render_aqt($_) + : ((ref($_) eq 'ARRAY') ? $_ : [ $_ ]) + ), @parts; + return [ join($join, map $_->[0], @final), - (wantarray ? (map @{$_}[1..$#$_], @final) : ()), - ); + (map @{$_}[1..$#$_], @final), + ]; } sub _render_unop_paren { my ($self, $op, $v) = @_; return $self->join_query_parts('', - '(', [ $self->_render_unop_prefix($op, $v) ], ')' + '(', $self->_render_unop_prefix($op, $v), ')' ); } @@ -1296,13 +1297,13 @@ sub _order_by { return '' unless defined(my $expanded = $self->_expand_order_by($arg)); - my ($sql, @bind) = $self->render_aqt($expanded); + my ($sql, @bind) = @{ $self->render_aqt($expanded) }; return '' unless length($sql); my $final_sql = $self->_sqlcase(' order by ').$sql; - return wantarray ? ($final_sql, @bind) : $final_sql; + return ($final_sql, @bind); } # _order_by no longer needs to call this so doesn't but DBIC uses it. @@ -1318,7 +1319,7 @@ sub _order_by_chunks { sub _chunkify_order_by { my ($self, $expanded) = @_; - return grep length, $self->render_aqt($expanded) + return grep length, @{ $self->render_aqt($expanded) } if $expanded->{-ident} or @{$expanded->{-literal}||[]} == 1; for ($expanded) { @@ -1326,7 +1327,7 @@ sub _chunkify_order_by { my ($comma, @list) = @{$_->{-op}}; return map $self->_chunkify_order_by($_), @list; } - return [ $self->render_aqt($_) ]; + return $self->render_aqt($_); } } @@ -1337,9 +1338,9 @@ sub _chunkify_order_by { sub _table { my $self = shift; my $from = shift; - ($self->render_aqt( + $self->render_aqt( $self->_expand_maybe_list_expr($from, -ident) - ))[0]; + )->[0]; } @@ -1407,8 +1408,11 @@ sub _quote { # Conversion, if applicable sub _convert { #my ($self, $arg) = @_; - if ($_[0]->{convert_where}) { - return $_[0]->_sqlcase($_[0]->{convert_where}) .'(' . $_[1] . ')'; + if (my $conv = $_[0]->{convert_where}) { + return @{ $_[0]->join_query_parts('', + $_[0]->format_keyword($conv), + '(' , $_[1] , ')' + ) }; } return $_[1]; } @@ -1645,6 +1649,7 @@ sub AUTOLOAD { # This allows us to check for a local, then _form, attr my $self = shift; my($name) = $AUTOLOAD =~ /.*::(.+)/; + puke "AUTOLOAD invoked for method name ${name} and allow_autoload option not set" unless $self->{allow_autoload}; return $self->generate($name, @_); }