where_hashpair is better than recurse_where

[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 8c552f2..eb50d98 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -28,6 +28,7 @@ my @BUILTIN_SPECIAL_OPS = (
   {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
   {regex => qr/^ (?: not \s )? in      $/ix, handler => '_where_field_IN'},
   {regex => qr/^ func $/ix, handler => '_where_field_FUNC'},
+  {regex => qr/^ op   $/ix, handler => '_where_op_OP'},
 );
 
 # unaryish operators - key maps to handler
@@ -38,6 +39,7 @@ my @BUILTIN_UNARY_OPS = (
   { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
   { regex => qr/^ (?: not \s )? bool     $/xi, handler => '_where_op_BOOL' },
   { regex => qr/^ func $/ix,                   handler => '_where_op_FUNC' },
+  { regex => qr/^ op   $/ix,                   handler => '_where_op_OP' },
 );
 
 #======================================================================
@@ -601,7 +603,7 @@ sub _where_op_ANDOR {
 
     SCALARREF  => sub {
       puke "-$op => \\\$scalar makes little sense, use " .
-        ($op =~ /^or/i 
+        ($op =~ /^or/i
           ? '[ \$scalar, \%rest_of_conditions ] instead'
           : '-and => [ \$scalar, \%rest_of_conditions ] instead'
         );
@@ -609,7 +611,7 @@ sub _where_op_ANDOR {
 
     ARRAYREFREF => sub {
       puke "-$op => \\[...] makes little sense, use " .
-        ($op =~ /^or/i 
+        ($op =~ /^or/i
           ? '[ \[...], \%rest_of_conditions ] instead'
           : '-and => [ \[...], \%rest_of_conditions ] instead'
         );
@@ -985,64 +987,92 @@ sub _where_generic_FUNC {
 
   my $label       = $self->_convert($self->_quote($k));
   my $placeholder = $self->_convert('?');
-  my $error = "special op 'func' accepts an arrayref with more than one value.";
 
-  my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
-    ARRAYREFREF => sub {
-      my ($s, @b) = @$$vals;
-      $self->_assert_bindval_matches_bindtype(@b);
-      ($s, @b);
-    },
-    SCALARREF => sub {
-      puke $error;
-    },
-    ARRAYREF => sub {
-      puke $error
-        if @$vals < 1;
+  puke '-func must be an array' unless ref $vals eq 'ARRAY';
+  puke 'first arg for -func must be a scalar' unless !ref $vals->[0];
+
+  my ($func,@rest_of_vals) = @$vals;
+
+  $self->_assert_pass_injection_guard($func);
+
+  my (@all_sql, @all_bind);
+  foreach my $val (@rest_of_vals) {
+    my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+       SCALAR => sub {
+         return ($placeholder, $self->_bindtype($k, $val) );
+       },
+       SCALARREF => sub {
+         return $$val;
+       },
+       ARRAYREFREF => sub {
+         my ($sql, @bind) = @$$val;
+         $self->_assert_bindval_matches_bindtype(@bind);
+         return ($sql, @bind);
+       },
+       HASHREF => sub {
+         my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
+         $self->$method('', $val);
+       }
+    });
+    push @all_sql, $sql;
+    push @all_bind, @bind;
+  }
 
-      my (@all_sql, @all_bind);
+  my ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
 
-      my ($func,@rest_of_vals) = @$vals;
+  my $sql = $k ? "( $label = $clause )" : "( $clause )";
+  return ($sql, @bind)
+}
 
-      if ($func =~ m{\W})
-      {
-        puke "Function in -func may only contain alphanumeric characters.";
-      }
+sub _where_op_OP {
+  my ($self) = @_;
 
-      foreach my $val (@rest_of_vals) {
-        my ($sql, @bind) = $self->_SWITCH_refkind($val, {
-           SCALAR => sub {
-             return ($placeholder, $self->_bindtype($k, $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 BETWEEN")
-               if (@rest or $func !~ /^ \- (.+)/x);
-             local $self->{_nested_func_lhs} = $k;
-             $self->_where_unary_op ($1 => $arg);
-           }
-        });
-        push @all_sql, $sql;
-        push @all_bind, @bind;
-      }
+  my ($k, $vals);
 
-      return (
-        ("$func(" . (join ",", @all_sql) . ")"),
-        @all_bind
-      );
-    },
-    FALLBACK => sub {
-      puke $error; 
-    },
-  });
+  if (@_ == 3) {
+     # $_[1] gets set to "op"
+     $vals = $_[2];
+     $k = '';
+  } elsif (@_ == 4) {
+     $k = $_[1];
+     # $_[2] gets set to "op"
+     $vals = $_[3];
+  }
+
+  my $label       = $self->_convert($self->_quote($k));
+  my $placeholder = $self->_convert('?');
+
+  puke 'argument to -op must be an arrayref' unless ref $vals eq 'ARRAY';
+  puke 'first arg for -op must be a scalar' unless !ref $vals->[0];
+
+  my ($op, @rest_of_vals) = @$vals;
+
+  $self->_assert_pass_injection_guard($op);
+
+  my (@all_sql, @all_bind);
+  foreach my $val (@rest_of_vals) {
+    my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+       SCALAR => sub {
+         return ($placeholder, $self->_bindtype($k, $val) );
+       },
+       SCALARREF => sub {
+         return $$val;
+       },
+       ARRAYREFREF => sub {
+         my ($sql, @bind) = @$$val;
+         $self->_assert_bindval_matches_bindtype(@bind);
+         return ($sql, @bind);
+       },
+       HASHREF => sub {
+         my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $val);
+         $self->$method('', $val);
+       }
+    });
+    push @all_sql, $sql;
+    push @all_bind, @bind;
+  }
+
+  my ($clause, @bind) = ((join " $op ", @all_sql), @all_bind);
 
   my $sql = $k ? "( $label = $clause )" : "( $clause )";
   return ($sql, @bind)
@@ -2307,7 +2337,7 @@ list can be expanded : see section L</"SPECIAL OPERATORS"> below.
 Another operator is C<-func> that allows you to call SQL functions with
 arguments. It receives an array reference containing the function name
 as the 0th argument and the other arguments being its parameters. For example:
-    
+
     my %where = {
       -func => ['substr', 'Hello', 50, 5],
     };
@@ -2317,6 +2347,19 @@ Would give you:
    $stmt = "WHERE (substr(?,?,?))";
    @bind = ("Hello", 50, 5);
 
+Yet another operator is C<-op> that allows you to use SQL operators. It
+receives an array reference containing the operator 0th argument and the other
+arguments being its operands. For example:
+
+    my %where = {
+      foo => { -op => ['+', \'bar', 50, 5] },
+    };
+
+Would give you:
+
+   $stmt = "WHERE (foo = bar + ? + ?)";
+   @bind = (50, 5);
+
 =head2 Unary operators: bool
 
 If you wish to test against boolean columns or functions within your