handle completely bizarre edge case

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

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index efa1e8a..6a8abaf 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;
 }
 
@@ -543,7 +551,9 @@ sub render_expr {
 
 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,10 +594,10 @@ 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;
+    my ($lhs, @rhs) = ref($v) eq 'ARRAY' ? @$v : $v;
     return $self->_expand_op(
       -op, [ $k, $self->expand_expr($lhs, -ident), @rhs ]
     );
@@ -676,19 +686,6 @@ sub _expand_hashpair_op {
 
   my $op = $self->_normalize_op($k);
 
-  if (my $exp = $self->{expand}{$op}) {
-    return $self->$exp($op, $v);
-  }
-
-  # Ops prefixed with -not_ get converted
-
-  if (my ($rest) = $op =~/^not_(.*)$/) {
-    return +{ -op => [
-      'not',
-      $self->_expand_expr({ "-${rest}", $v })
-    ] };
-  }
-
   { # Old SQLA compat
 
     my $op = join(' ', split '_', $op);
@@ -707,9 +704,27 @@ sub _expand_hashpair_op {
     ) {
       puke "Illegal use of top-level '-$op'"
     }
+  }
+
+  if (my $exp = $self->{expand}{$op}) {
+    return $self->$exp($op, $v);
+  }
+
+  # Ops prefixed with -not_ get converted
+
+  if (my ($rest) = $op =~/^not_(.*)$/) {
+    return +{ -op => [
+      'not',
+      $self->_expand_expr({ "-${rest}", $v })
+    ] };
+  }
+
+  { # Old SQLA compat
 
     # the old unary op system means we should touch nothing and let it work
 
+    my $op = join(' ', split '_', $op);
+
     if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
       return { -op => [ $op, $v ] };
     }
@@ -785,7 +800,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}
@@ -1085,9 +1100,11 @@ sub _render_func {
   my ($func, @args) = @$rest;
   return $self->join_query_parts('',
     $self->_sqlcase($func),
-    '(',
-    $self->join_query_parts(', ', @args),
-    ')'
+    $self->join_query_parts('',
+      '(',
+      $self->join_query_parts(', ', @args),
+      ')'
+    ),
   );
 }
 
@@ -1161,9 +1178,11 @@ 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),
+      ')'
+    ),
   );
 }
 
@@ -1171,8 +1190,10 @@ sub _render_op_andor {
   my ($self, $op, $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, ')'
   );
 }
 
@@ -1196,7 +1217,7 @@ sub join_query_parts {
       : ((ref($_) eq 'ARRAY') ? $_ : [ $_ ])
   ), @parts;
   return [
-    join($join, map $_->[0], @final),
+    $self->{join_sql_parts}->($join, grep defined, map $_->[0], @final),
     (map @{$_}[1..$#$_], @final),
   ];
 }
@@ -1313,7 +1334,9 @@ 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 {