Properly support ops containing _'s (valid in Oracle)

diff --git a/Changes b/Changes
index 5eedf96..fc2c77c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,7 @@ Revision history for SQL::Abstract
     - Better handling of generic -function's during AST construction
     - Special handle IS NOT? NULL
     - Make sure unparse() does not destroy a passed in \@bindargs
+    - Support ops with _'s in them (valid in Oracle)
 
 revision 1.68  2010-09-16
 ----------------------------

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 4d2e49f..f646790 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -25,17 +25,17 @@ our $AUTOLOAD;
 # special operators (-in, -between). May be extended/overridden by user.
 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
 my @BUILTIN_SPECIAL_OPS = (
-  {regex => qr/^(not )?between$/i, handler => '_where_field_BETWEEN'},
-  {regex => qr/^(not )?in$/i,      handler => '_where_field_IN'},
+  {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
+  {regex => qr/^ (?: not \s )? in      $/ix, handler => '_where_field_IN'},
 );
 
 # unaryish operators - key maps to handler
 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/^ 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' },
 );
 
 #======================================================================
@@ -463,16 +463,19 @@ sub _where_HASHREF {
       if ($k =~ /^-./) {
         # put the operator in canonical form
         my $op = $k;
-        $op =~ s/^-//;        # remove initial dash
-        $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+        $op = substr $op, 1;  # remove initial dash
         $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
+        $op =~ s/\s+/ /g;     # compress whitespace
+
+        # so that -not_foo works correctly
+        $op =~ s/^not_/NOT /i;
 
         $self->_debug("Unary OP(-$op) within hashref, recursing...");
 
         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+$//) {
+            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 ... ]";
               }
@@ -487,9 +490,9 @@ sub _where_HASHREF {
         }
         else {
           $self->debug("Generic unary OP: $k - recursing as function");
-          my ($sql, @bind) = $self->_where_func_generic ($op, $v);
-          $sql = "($sql)" unless (defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k));  # top level vs nested
-          ($sql, @bind);
+          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);
         }
       }
       else {
@@ -589,30 +592,22 @@ sub _where_op_NEST {
 sub _where_op_BOOL {
   my ($self, $op, $v) = @_;
 
-  my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
-    ? ( '(NOT ', ')' )
-    : ( '', '' );
-
-  my ($sql, @bind) = do {
-    $self->_SWITCH_refkind($v, {
-      SCALAR => sub { # interpreted as SQL column
-        $self->_convert($self->_quote($v));
-      },
+  my ($s, @b) = $self->_SWITCH_refkind($v, {
+    SCALAR => sub { # interpreted as SQL column
+      $self->_convert($self->_quote($v));
+    },
 
-      UNDEF => sub {
-        puke "-$op => undef not supported";
-      },
+    UNDEF => sub {
+      puke "-$op => undef not supported";
+    },
 
-      FALLBACK => sub {
-        $self->_recurse_where ($v);
-      },
-    });
-  };
+    FALLBACK => sub {
+      $self->_recurse_where ($v);
+    },
+  });
 
-  return (
-    join ('', $prefix, $sql, $suffix),
-    @bind,
-  );
+  $s = "(NOT $s)" if $op =~ /^not/i;
+  ($s, @b);
 }
 
 
@@ -660,9 +655,14 @@ sub _where_hashpair_HASHREF {
 
     # put the operator in canonical form
     my $op = $orig_op;
-    $op =~ s/^-//;        # remove initial dash
-    $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+
+    # FIXME - we need to phase out dash-less ops
+    $op =~ s/^-//;        # remove possible initial dash
     $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
+    $op =~ s/\s+/ /g;     # compress whitespace
+
+    # so that -not_foo works correctly
+    $op =~ s/^not_/NOT /i;
 
     my ($sql, @bind);
 

diff --git a/t/02where.t b/t/02where.t
index 5592977..5fea555 100644 (file)
--- a/t/02where.t
+++ b/t/02where.t
@@ -328,8 +328,8 @@ my @handle_tests = (
        bind => [],
    },
    {
-       where => { timestamp => { '>=' => { -TO_DATE => '2009-12-21 00:00:00' } } },
-       stmt => " WHERE ( timestamp >= TO DATE ? )",
+       where => { timestamp => { '>=' => { -to_date => '2009-12-21 00:00:00' } } },
+       stmt => " WHERE ( timestamp >= TO_DATE ? )",
        bind => ['2009-12-21 00:00:00'],
    },