test is case insensitive, result should be lower cased

[scpubgit/Q-Branch.git] / lib / SQL / Abstract.pm

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 327ddfd..79c6300 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -2,6 +2,7 @@ package SQL::Abstract; # see doc at end of file
 
 use strict;
 use warnings;
+use Module::Runtime ();
 use Carp ();
 use List::Util ();
 use Scalar::Util ();
@@ -239,6 +240,13 @@ sub new {
     ',' => '_render_op_multop',
   };
 
+  if ($opt{lazy_join_sql_parts}) {
+    my $mod = Module::Runtime::use_module('SQL::Abstract::Parts');
+    $opt{join_sql_parts} ||= sub { $mod->new(@_) };
+  }
+
+  $opt{join_sql_parts} ||= sub { join $_[0], @_[1..$#_] };
+
   return bless \%opt, $class;
 }
 
@@ -270,14 +278,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,9 +328,9 @@ 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 ($self->_sqlcase(' returning ').$sql, @bind);
 }
 
@@ -390,9 +399,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 {
@@ -401,7 +410,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 = $_;
@@ -452,9 +461,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')
-  );
+  ) };
 }
 
 #======================================================================
@@ -535,15 +544,16 @@ 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 ($sql, @bind);
+  ) };
 }
 
 sub _normalize_op {
   my ($self, $raw) = @_;
-  s/^-(?=.)//, s/\s+/_/g for my $op = lc $raw;
+  my $op = lc $raw;
+  return $op if grep $_->{$op}, @{$self}{qw(is_op expand_op render_op)};
+  s/^-(?=.)//, s/\s+/_/g for $op;
   $op;
 }
 
@@ -584,7 +594,7 @@ sub _expand_hashpair {
     }
     puke "Supplying an empty left hand side argument is not supported";
   }
-  if ($k =~ /^-/) {
+  if ($k =~ /^-./) {
     return $self->_expand_hashpair_op($k, $v);
   } elsif ($k =~ /^[^\w]/i) {
     my ($lhs, @rhs) = @$v;
@@ -755,7 +765,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);
@@ -785,7 +795,7 @@ sub _expand_hashtriple {
   if (ref($vv) eq 'ARRAY') {
     my @raw = @$vv;
     my $logic = (defined($raw[0]) and $raw[0] =~ /^-(and|or)$/i)
-      ? (shift(@raw), $1) : 'or';
+      ? (shift(@raw), lc $1) : 'or';
     my @values = map +{ $vk => $_ }, @raw;
     if (
       $op =~ $self->{inequality_op}
@@ -851,7 +861,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 {
@@ -902,7 +912,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 {
@@ -1053,7 +1063,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) {
@@ -1068,35 +1078,40 @@ 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('',
+      '(',
+      $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 {
@@ -1116,10 +1131,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);
@@ -1158,26 +1173,30 @@ sub _render_op_in {
   return $self->join_query_parts(' ',
     $lhs,
     $self->format_keyword($op),
-    '(',
-    [ $self->join_query_parts(', ', @rhs) ],
-    ')'
+    $self->join_query_parts(' ',
+      '(',
+      $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) ], ')'
+  my $inner = $self->_render_op_multop($op, $args);
+  return undef unless defined($inner->[0]) and length($inner->[0]);
+  return $self->join_query_parts(' ',
+    '(', $inner, ')'
   );
 }
 
 sub _render_op_multop {
   my ($self, $op, $args) = @_;
   my @parts = @$args;
-  return '' unless @parts;
-  return @{[ $self->render_aqt($parts[0])]} if @parts == 1;
+  return undef unless @parts;
+  return $self->render_aqt($parts[0]) if @parts == 1;
   my $join = ($op eq ','
                 ? ', '
                 :  ' '.$self->format_keyword($op).' '
@@ -1189,19 +1208,19 @@ sub join_query_parts {
   my ($self, $join, @parts) = @_;
   my @final = map +(
     ref($_) eq 'HASH'
-      ? [ $self->render_aqt($_) ]
-      : ref($_) eq 'ARRAY' ? $_ : [ $_ ]),
-         @parts;
-  return (
-    join($join, map $_->[0], @final),
+      ? $self->render_aqt($_)
+      : ((ref($_) eq 'ARRAY') ? $_ : [ $_ ])
+  ), @parts;
+  return [
+    $self->{join_sql_parts}->($join, grep defined, map $_->[0], @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), ')'
   );
 }
 
@@ -1294,7 +1313,7 @@ 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);
 
@@ -1310,13 +1329,15 @@ sub _order_by_chunks {
 
   return () unless defined(my $expanded = $self->_expand_order_by($arg));
 
-  return $self->_chunkify_order_by($expanded);
+  my @res = $self->_chunkify_order_by($expanded);
+  (ref() ? $_->[0] : $_) .= '' for @res;
+  return @res;
 }
 
 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) {
@@ -1324,7 +1345,7 @@ sub _chunkify_order_by {
       my ($comma, @list) = @{$_->{-op}};
       return map $self->_chunkify_order_by($_), @list;
     }
-    return [ $self->render_aqt($_) ];
+    return $self->render_aqt($_);
   }
 }
 
@@ -1335,9 +1356,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];
 }
 
 
@@ -1405,8 +1426,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];
 }