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

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-09-22 07:18:02 +0000 (Tue, 22 Sep 2009)
New Revision: 7716

Modified:
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/05between.t
Log:
Omnipotent 'between'

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-09-21 14:26:07 UTC (rev 7715)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-09-22 07:18:02 UTC (rev 7716)
@@ -818,38 +818,51 @@
 sub _where_field_BETWEEN {
   my ($self, $k, $op, $vals) = @_;
 
-  (ref $vals eq 'ARRAY' && @$vals == 2) or 
-  (ref $vals eq 'REF' && (@$$vals == 1 || @$$vals == 2 || @$$vals == 3))
-    or puke "special op 'between' requires an arrayref of two values (or a scalarref or arrayrefref for literal SQL)";
-
-  my ($clause, @bind, $label, $and, $placeholder);
+  my ($label, $and, $placeholder);
   $label       = $self->_convert($self->_quote($k));
   $and         = ' ' . $self->_sqlcase('and') . ' ';
   $placeholder = $self->_convert('?');
   $op               = $self->_sqlcase($op);
 
-  if (ref $vals eq 'REF') {
-    ($clause, @bind) = @$$vals;
-  }
-  else {
-    my (@all_sql, @all_bind);
+  my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
+    ARRAYREFREF => sub {
+      return @$$vals;
+    },
+    SCALARREF => sub {
+      return $$vals;
+    },
+    ARRAYREF => sub {
+      puke "special op 'between' accepts an arrayref with exactly two values"
+        if @$vals != 2;
 
-    foreach my $val (@$vals) {
-      my ($sql, @bind) = $self->_SWITCH_refkind($val, {
-         SCALAR => sub {
-           return ($placeholder, ($val));
-         },
-         SCALARREF => sub {
-           return ($self->_convert($$val), ());
-         },
-      });
-      push @all_sql, $sql;
-      push @all_bind, @bind;
-    }
+      my (@all_sql, @all_bind);
+      foreach my $val (@$vals) {
+        my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+           SCALAR => sub {
+             return ($placeholder, ($val));
+           },
+           SCALARREF => sub {
+             return ($self->_convert($$val), ());
+           },
+           ARRAYREFREF => sub {
+             my ($sql, @bind) = @$$val;
+             return ($self->_convert($sql), @bind);
+           },
+        });
+        push @all_sql, $sql;
+        push @all_bind, @bind;
+      }
 
-    $clause = (join $and, @all_sql);
-    @bind = $self->_bindtype($k, @all_bind);
-  }
+      return (
+        (join $and, @all_sql),
+        $self->_bindtype($k, @all_bind),
+      );
+    },
+    FALLBACK => sub {
+      puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref";
+    },
+  });
+
   my $sql = "( $label $op $clause )";
   return ($sql, @bind)
 }
@@ -895,8 +908,6 @@
 }
 
 
-
-
 #======================================================================
 # ORDER BY
 #======================================================================

Modified: SQL-Abstract/1.x/trunk/t/05between.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/05between.t	2009-09-21 14:26:07 UTC (rev 7715)
+++ SQL-Abstract/1.x/trunk/t/05between.t	2009-09-22 07:18:02 UTC (rev 7716)
@@ -49,6 +49,12 @@
     test => '-between with two literal sql arguments',
   },
   {
+    where => { x => { -between => [ \['current_date - ?', 1], \['current_date - ?', 0] ] } },
+    stmt => 'WHERE (x BETWEEN current_date - ? AND current_date - ?)',
+    bind => [1, 0],
+    test => '-between with two literal sql arguments with bind',
+  },
+  {
     where => { x => { -between => \['? AND ?', 1, 2] } },
     stmt => 'WHERE (x BETWEEN ? AND ?)',
     bind => [1,2],
@@ -67,14 +73,14 @@
     test => '-between with literal sql with one placeholder and one literal arg (\["? AND \'something\'", scalar])',
   },
   {
-    where => { x => { -between => \["'this' AND 'that'"] } },
+    where => { x => { -between => \"'this' AND 'that'" } },
     stmt => "WHERE (x BETWEEN 'this' AND 'that')",
     bind => [],
-    test => '-between with literal sql with two literal args (\["\'this\' AND \'that\'"])',
+    test => '-between with literal sql with a literal (\"\'this\' AND \'that\'")',
   },
 );
 
-plan tests => @in_between_tests*3;
+plan tests => @in_between_tests*4;
 
 for my $case (@in_between_tests) {
   TODO: {
@@ -82,20 +88,23 @@
 
     local $Data::Dumper::Terse = 1;
 
-    my @w;
-    local $SIG{__WARN__} = sub { push @w, @_ };
-    my $sql = SQL::Abstract->new ($case->{args} || {});
-    lives_ok (sub { 
-      my ($stmt, @bind) = $sql->where($case->{where});
-      is_same_sql_bind(
-        $stmt,
-        \@bind,
-        $case->{stmt},
-        $case->{bind},
-      )
-        || diag "Search term:\n" . Dumper $case->{where};
-    });
-    is (@w, 0, $case->{test} || 'No warnings within in-between tests')
-      || diag join "\n", 'Emitted warnings:', @w;
+    lives_ok (sub {
+
+      my @w;
+      local $SIG{__WARN__} = sub { push @w, @_ };
+      my $sql = SQL::Abstract->new ($case->{args} || {});
+      lives_ok (sub { 
+        my ($stmt, @bind) = $sql->where($case->{where});
+        is_same_sql_bind(
+          $stmt,
+          \@bind,
+          $case->{stmt},
+          $case->{bind},
+        )
+          || diag "Search term:\n" . Dumper $case->{where};
+      });
+      is (@w, 0, $case->{test} || 'No warnings within in-between tests')
+        || diag join "\n", 'Emitted warnings:', @w;
+    }, "$case->{test} doesn't die");
   }
 }