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

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Thu Oct 21 17:11:29 GMT 2010


Author: ribasushi
Date: 2010-10-21 17:11:29 +0000 (Thu, 21 Oct 2010)
New Revision: 9774

Modified:
   SQL-Abstract/1.x/trunk/Changes
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/01generate.t
Log:
Add support for { -op => $foo } in UPDATE arguments
Refactor unary op handlers to allow overrides at any level
Makes for very very hairy internals, but immensely useful for upstream

Modified: SQL-Abstract/1.x/trunk/Changes
===================================================================
--- SQL-Abstract/1.x/trunk/Changes	2010-10-21 14:51:31 UTC (rev 9773)
+++ SQL-Abstract/1.x/trunk/Changes	2010-10-21 17:11:29 UTC (rev 9774)
@@ -11,6 +11,7 @@
     - Make sure unparse() does not destroy a passed in \@bindargs
     - Support ops with _'s in them (valid in Oracle)
     - Properly parse both types of default value inserts
+    - Allow { -func => $val } as arguments to UPDATE
 
 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-10-21 14:51:31 UTC (rev 9773)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2010-10-21 17:11:29 UTC (rev 9774)
@@ -280,7 +280,19 @@
       },
       SCALARREF => sub {  # literal SQL without bind
         push @set, "$label = $$v";
-       },
+      },
+      HASHREF => sub {
+        my ($op, $arg, @rest) = %$v;
+
+        puke 'Operator calls in update must be in the form { -op => $arg }'
+          if (@rest or not $op =~ /^\-(.+)/);
+
+        local $self->{_nested_func_lhs} = $k;
+        my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
+
+        push @set, "$label = $sql";
+        push @all_bind, @bind;
+      },
       SCALAR_or_UNDEF => sub {
         push @set, "$label = ?";
         push @all_bind, $self->_bindtype($k, $v);
@@ -471,29 +483,16 @@
         $op =~ s/^not_/NOT /i;
 
         $self->_debug("Unary OP(-$op) within hashref, recursing...");
+        my ($s, @b) = $self->_where_unary_op ($op, $v);
 
-        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+ $//x ) {
-              belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
-                  . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
-              }
-            $self->$handler ($op, $v);
-          }
-          elsif (ref $handler eq 'CODE') {
-            $handler->($self, $op, $v);
-          }
-          else {
-            puke "Illegal handler for operator $k - expecting a method name or a coderef";
-          }
-        }
-        else {
-          $self->debug("Generic unary OP: $k - recursing as function");
-          my ($s, @b) = $self->_where_func_generic ($op, $v);
-          $s = "($s)" unless (defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k));  # top level vs nested
-          ($s, @b);
-        }
+        # top level vs nested
+        # we assume that handled unary ops will take care of their ()s
+        $s = "($s)" unless (
+          List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
+            or
+          defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k)
+        );
+        ($s, @b);
       }
       else {
         my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
@@ -508,9 +507,29 @@
   return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
 }
 
-sub _where_func_generic {
+sub _where_unary_op {
   my ($self, $op, $rhs) = @_;
 
+  if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
+    my $handler = $op_entry->{handler};
+
+    if (not ref $handler) {
+      if ($op =~ s/ [_\s]? \d+ $//x ) {
+        belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
+            . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
+      }
+      return $self->$handler ($op, $rhs);
+    }
+    elsif (ref $handler eq 'CODE') {
+      return $handler->($self, $op, $rhs);
+    }
+    else {
+      puke "Illegal handler for operator $op - expecting a method name or a coderef";
+    }
+  }
+
+  $self->debug("Generic unary OP: $op - recursing as function");
+
   my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
     SCALAR =>   sub {
       puke "Illegal use of top-level '$op'"
@@ -714,7 +733,7 @@
           # retain for proper column type bind
           $self->{_nested_func_lhs} ||= $k;
 
-          ($sql, @bind) = $self->_where_func_generic ($op, $val);
+          ($sql, @bind) = $self->_where_unary_op ($op, $val);
 
           $sql = join (' ',
             $self->_convert($self->_quote($k)),
@@ -886,7 +905,7 @@
              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);
+             $self->_where_unary_op ($1 => $arg);
            }
         });
         push @all_sql, $sql;
@@ -941,7 +960,7 @@
               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);
+              $self->_where_unary_op ($1 => $arg);
             }
           });
           push @all_sql, $sql;

Modified: SQL-Abstract/1.x/trunk/t/01generate.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/01generate.t	2010-10-21 14:51:31 UTC (rev 9773)
+++ SQL-Abstract/1.x/trunk/t/01generate.t	2010-10-21 17:11:29 UTC (rev 9774)
@@ -441,10 +441,10 @@
       {
               func   => 'update',
               new    => {bindtype => 'columns'},
-              args   => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", [{dummy => 1} => '02/02/02']]}, {a => {'between', [1,2]}}],
-              stmt   => 'UPDATE test SET a = ?, b = to_date(?, \'MM/DD/YY\') WHERE ( a BETWEEN ? AND ? )',
-              stmt_q => 'UPDATE `test` SET `a` = ?, `b` = to_date(?, \'MM/DD/YY\') WHERE ( `a` BETWEEN ? AND ? )',
-              bind   => [[a => '1'], [{dummy => 1} => '02/02/02'], [a => '1'], [a => '2']],
+              args   => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", [{dummy => 1} => '02/02/02']], c => { -lower => 'foo' }}, {a => {'between', [1,2]}}],
+              stmt   => "UPDATE test SET a = ?, b = to_date(?, 'MM/DD/YY'), c = LOWER( ? ) WHERE ( a BETWEEN ? AND ? )",
+              stmt_q => "UPDATE `test` SET `a` = ?, `b` = to_date(?, 'MM/DD/YY'), `c` = LOWER ( ? ) WHERE ( `a` BETWEEN ? AND ? )",
+              bind   => [[a => '1'], [{dummy => 1} => '02/02/02'], [c => 'foo'], [a => '1'], [a => '2']],
       },
       {
               func   => 'select',




More information about the Bast-commits mailing list