Whoops - forgot to commit

[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 99936b8..060e601 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,14 +8,14 @@ package SQL::Abstract; # see doc at end of file
 use Carp;
 use strict;
 use warnings;
-use List::Util   qw/first/;
-use Scalar::Util qw/blessed/;
+use List::Util ();
+use Scalar::Util ();
 
 #======================================================================
 # GLOBALS
 #======================================================================
 
-our $VERSION  = '1.61';
+our $VERSION  = '1.62';
 
 # This would confuse some packagers
 #$VERSION      = eval $VERSION; # numify for warning-free dev releases
@@ -474,7 +474,7 @@ sub _where_HASHREF {
 
         $self->_debug("Unary OP(-$op) within hashref, recursing...");
 
-        my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
+        my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}};
         if (my $handler = $op_entry->{handler}) {
           if (not ref $handler) {
             if ($op =~ s/\s?\d+$//) {
@@ -513,7 +513,13 @@ sub _where_func_generic {
 
   my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
     SCALAR =>   sub {
-      ($self->_convert('?'), $self->_bindtype('xxx', $rhs) );
+      puke "Illegal use of top-level '$op'"
+        unless $self->{_nested_func_lhs};
+
+      return (
+        $self->_convert('?'),
+        $self->_bindtype($self->{_nested_func_lhs}, $rhs)
+      );
     },
     FALLBACK => sub {
       $self->_recurse_where ($rhs)
@@ -565,22 +571,6 @@ sub _where_op_NEST {
 
   $self->_SWITCH_refkind($v, {
 
-    ARRAYREF => sub {
-      return $self->_where_ARRAYREF($v, '');
-    },
-
-    HASHREF => sub {
-      return $self->_where_HASHREF($v);
-    },
-
-    SCALARREF  => sub {         # literal SQL
-      return ($$v); 
-    },
-
-    ARRAYREFREF => sub {        # literal SQL
-      return @{${$v}};
-    },
-
     SCALAR => sub { # permissively interpreted as SQL
       belch "literal SQL should be -nest => \\'scalar' "
           . "instead of -nest => 'scalar' ";
@@ -590,6 +580,11 @@ sub _where_op_NEST {
     UNDEF => sub {
       puke "-$op => undef not supported";
     },
+
+    FALLBACK => sub {
+      $self->_recurse_where ($v);
+    },
+
    });
 }
 
@@ -659,6 +654,8 @@ sub _where_hashpair_HASHREF {
   my ($self, $k, $v, $logic) = @_;
   $logic ||= 'and';
 
+  local $self->{_nested_func_lhs} = $self->{_nested_func_lhs};
+
   my ($all_sql, @all_bind);
 
   for my $orig_op (sort keys %$v) {
@@ -677,7 +674,7 @@ sub _where_hashpair_HASHREF {
       ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
     }
     # CASE: special operators like -in or -between
-    elsif ( my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
+    elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
       my $handler = $special_op->{handler};
       if (! $handler) {
         puke "No handler supplied for special operator $orig_op";
@@ -716,8 +713,17 @@ sub _where_hashpair_HASHREF {
         },
 
         FALLBACK => sub {       # CASE: col => {op/func => $stuff}
+
+          # if we are starting to nest and the first func is not a cmp op
+          # assume equality
+          my $prefix;
+          unless ($self->{_nested_func_lhs}) {
+            $self->{_nested_func_lhs} = $k;
+            $prefix = $self->{cmp} unless $op =~ $self->{cmp_ops};
+          }
+
           ($sql, @bind) = $self->_where_func_generic ($op, $val);
-          $sql = join ' ', $self->_convert($self->_quote($k)), $sql;
+          $sql = join ' ', $self->_convert($self->_quote($k)), $prefix||(), $sql;
         },
       });
     }
@@ -1167,7 +1173,7 @@ sub _refkind {
 
   while (1) {
     # blessed objects are treated like scalars
-    $ref = (blessed $data) ? '' : ref $data;
+    $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
     $n_steps += 1 if $ref;
     last          if $ref ne 'REF';
     $data = $$data;
@@ -1190,19 +1196,29 @@ sub _try_refkind {
 
 sub _METHOD_FOR_refkind {
   my ($self, $meth_prefix, $data) = @_;
-  my $method = first {$_} map {$self->can($meth_prefix."_".$_)} 
-                              $self->_try_refkind($data)
-    or puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
-  return $method;
+
+  my $method;
+  for ($self->_try_refkind($data)) {
+    $method = $self->can($meth_prefix."_".$_)
+      and last;
+  }
+
+  return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
 }
 
 
 sub _SWITCH_refkind {
   my ($self, $data, $dispatch_table) = @_;
 
-  my $coderef = first {$_} map {$dispatch_table->{$_}} 
-                               $self->_try_refkind($data)
-    or puke "no dispatch entry for ".$self->_refkind($data);
+  my $coderef;
+  for ($self->_try_refkind($data)) {
+    $coderef = $dispatch_table->{$_}
+      and last;
+  }
+
+  puke "no dispatch entry for ".$self->_refkind($data)
+    unless $coderef;
+
   $coderef->();
 }