[Bast-commits] r9736 - in SQL-Abstract/1.x/trunk: . lib/SQL t

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-09-22 15:14:40 +0100 (Wed, 22 Sep 2010)
New Revision: 9736

Modified:
   SQL-Abstract/1.x/trunk/Changes
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/05in_between.t
Log:
Fix incomplete handling of IN/BETWEEN sub-args

Modified: SQL-Abstract/1.x/trunk/Changes
===================================================================
--- SQL-Abstract/1.x/trunk/Changes	2010-09-22 10:09:34 UTC (rev 9735)
+++ SQL-Abstract/1.x/trunk/Changes	2010-09-22 14:14:40 UTC (rev 9736)
@@ -2,6 +2,7 @@
 
     - 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
 ----------------------------

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2010-09-22 10:09:34 UTC (rev 9735)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2010-09-22 14:14:40 UTC (rev 9736)
@@ -34,8 +34,9 @@
   # 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/^ (?: 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' },
-  { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
 );
 
 #======================================================================
@@ -531,6 +532,16 @@
   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 @@
       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 @@
   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);
 
-        return ($sql, @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;
+        }
+
+        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};

Modified: SQL-Abstract/1.x/trunk/t/05in_between.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/05in_between.t	2010-09-22 10:09:34 UTC (rev 9735)
+++ SQL-Abstract/1.x/trunk/t/05in_between.t	2010-09-22 14:14:40 UTC (rev 9736)
@@ -66,7 +66,7 @@
   },
   {
     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 @@
       ] },
     },
     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 @@
     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;