From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 22 Sep 2010 14:14:40 +0000 (+0000)
Subject: Fix incomplete handling of IN/BETWEEN sub-args
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0336eddbbdeb91d1cba48182e6877c9f33da138a;p=scpubgit%2FQ-Branch.git

Fix incomplete handling of IN/BETWEEN sub-args
---

diff --git a/Changes b/Changes
index 793e118..6e19159 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@ Revision history for SQL::Abstract
 
     - Switch the tokenizer to precompiled regexes (massive speedup)
     - Rudimentary handling of quotes ( 'WHERE' vs WHERE )
+    - Fix extended argument parsing by IN/BETWEEN
 
 revision 1.68  2010-09-16
 ----------------------------
diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index bf00228..fcded1d 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -34,8 +34,9 @@ my @BUILTIN_UNARY_OPS = (
   # the digits are backcompat stuff
   { regex => qr/^and  (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
   { regex => qr/^or   (?: \s? \d+ )? $/xi, handler => '_where_op_ANDOR' },
-  { regex => qr/^nest (?: \s? \d+ )? $/xi, handler => '_where_op_NEST' },
   { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
+  { regex => qr/^ ident              $/xi, handler => '_where_op_IDENT' },
+  { regex => qr/^nest (?: \s? \d+ )? $/xi, handler => '_where_op_NEST' },
 );
 
 #======================================================================
@@ -531,6 +532,16 @@ sub _where_func_generic {
   return ($sql, @bind);
 }
 
+sub _where_op_IDENT {
+  my ($self, $op, $v) = @_;
+
+  if (ref $v) {
+    puke "-$op takes a single scalar argument (a quotable identifier)";
+  }
+
+  return $self->_convert($self->_quote($v));
+}
+
 sub _where_op_ANDOR {
   my ($self, $op, $v) = @_;
 
@@ -871,16 +882,23 @@ sub _where_field_BETWEEN {
       foreach my $val (@$vals) {
         my ($sql, @bind) = $self->_SWITCH_refkind($val, {
            SCALAR => sub {
-             return ($placeholder, ($val));
+             return ($placeholder, $val);
            },
            SCALARREF => sub {
-             return ($self->_convert($$val), ());
+             return $$val;
            },
            ARRAYREFREF => sub {
              my ($sql, @bind) = @$$val;
              $self->_assert_bindval_matches_bindtype(@bind);
-             return ($self->_convert($sql), @bind);
+             return ($sql, @bind);
            },
+           HASHREF => sub {
+             my ($func, $arg, @rest) = %$val;
+             puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
+               if (@rest or $func !~ /^ \- (.+)/x);
+             local $self->{_nested_func_lhs} = $k;
+             $self->_where_func_generic ($1 => $arg);
+           }
         });
         push @all_sql, $sql;
         push @all_bind, @bind;
@@ -914,11 +932,39 @@ sub _where_field_IN {
   my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
     ARRAYREF => sub {     # list of choices
       if (@$vals) { # nonempty list
-        my $placeholders  = join ", ", (($placeholder) x @$vals);
-        my $sql           = "$label $op ( $placeholders )";
-        my @bind = $self->_bindtype($k, @$vals);
+        my (@all_sql, @all_bind);
+
+        for my $val (@$vals) {
+          my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+            SCALAR => sub {
+              return ($placeholder, $val);
+            },
+            SCALARREF => sub {
+              return $$val;
+            },
+            ARRAYREFREF => sub {
+              my ($sql, @bind) = @$$val;
+              $self->_assert_bindval_matches_bindtype(@bind);
+              return ($sql, @bind);
+            },
+            HASHREF => sub {
+              my ($func, $arg, @rest) = %$val;
+              puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
+                if (@rest or $func !~ /^ \- (.+)/x);
+              local $self->{_nested_func_lhs} = $k;
+              $self->_where_func_generic ($1 => $arg);
+            }
+          });
+          push @all_sql, $sql;
+          push @all_bind, @bind;
+        }
 
-        return ($sql, @bind);
+        my $sql = sprintf ('%s %s ( %s )',
+          $label,
+          $op,
+          join (', ', @all_sql)
+        );
+        return ($sql, @all_bind);
       }
       else { # empty list : some databases won't understand "IN ()", so DWIM
         my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
diff --git a/t/05in_between.t b/t/05in_between.t
index ff6b738..a40416c 100644
--- a/t/05in_between.t
+++ b/t/05in_between.t
@@ -66,7 +66,7 @@ my @in_between_tests = (
   },
   {
     where => {
-      start0 => { -between => [ 1, 2 ] },
+      start0 => { -between => [ 1, { -upper => 2 } ] },
       start1 => { -between => \["? AND ?", 1, 2] },
       start2 => { -between => \"lower(x) AND upper(y)" },
       start3 => { -between => [
@@ -75,7 +75,7 @@ my @in_between_tests = (
       ] },
     },
     stmt => "WHERE (
-          ( start0 BETWEEN ? AND ?                )
+          ( start0 BETWEEN ? AND upper ?          )
       AND ( start1 BETWEEN ? AND ?                )
       AND ( start2 BETWEEN lower(x) AND upper(y)  )
       AND ( start3 BETWEEN lower(x) AND upper(?)  )
@@ -140,6 +140,12 @@ my @in_between_tests = (
     bind => [2000],
     test => '-in POD test',
   },
+  {
+    where => { x => { -in => [ \['LOWER(?)', 'A' ], \'LOWER(b)', { -lower => 'c' } ] } },
+    stmt => " WHERE ( x IN ( LOWER(?), LOWER(b), LOWER ? ) )",
+    bind => [qw/A c/],
+    test => '-in with an array of function array refs with args',
+  },
 );
 
 plan tests => @in_between_tests*4;