Add the -func operator

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 45d0425..8c552f2 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -27,6 +27,7 @@ our $AUTOLOAD;
 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'},
 );
 
 # unaryish operators - key maps to handler
@@ -36,6 +37,7 @@ my @BUILTIN_UNARY_OPS = (
   { 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/^ func $/ix,                   handler => '_where_op_FUNC' },
 );
 
 #======================================================================
@@ -966,6 +968,85 @@ sub _where_field_BETWEEN {
   return ($sql, @bind)
 }
 
+sub _where_field_FUNC {
+  my ($self, $k, $op, $vals) = @_;
+
+  return $self->_where_generic_FUNC($k,$vals);
+}
+
+sub _where_op_FUNC {
+  my ($self, $k, $vals) = @_;
+
+  return $self->_where_generic_FUNC('', $vals);
+}
+
+sub _where_generic_FUNC {
+  my ($self, $k, $vals) = @_;
+
+  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;
+
+      my (@all_sql, @all_bind);
+
+      my ($func,@rest_of_vals) = @$vals;
+
+      if ($func =~ m{\W})
+      {
+        puke "Function in -func may only contain alphanumeric characters.";
+      }
+
+      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;
+      }
+
+      return (
+        ("$func(" . (join ",", @all_sql) . ")"),
+        @all_bind
+      );
+    },
+    FALLBACK => sub {
+      puke $error; 
+    },
+  });
+
+  my $sql = $k ? "( $label = $clause )" : "( $clause )";
+  return ($sql, @bind)
+}
 
 sub _where_field_IN {
   my ($self, $k, $op, $vals) = @_;
@@ -2223,6 +2304,19 @@ Would give you:
 These are the two builtin "special operators"; but the
 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],
+    };
+
+Would give you:
+
+   $stmt = "WHERE (substr(?,?,?))";
+   @bind = ("Hello", 50, 5);
+
 =head2 Unary operators: bool
 
 If you wish to test against boolean columns or functions within your

diff --git a/t/01generate.t b/t/01generate.t
index 90e94f8..fd47578 100644 (file)
--- a/t/01generate.t
+++ b/t/01generate.t
@@ -538,9 +538,39 @@ my @tests = (
               stmt_q => 'SELECT * FROM `test` WHERE ( `Y` = ( MAX( LENGTH( MIN ? ) ) ) )',
               bind   => [[Y => 'x']],
       },
+      {
+              func   => 'select',
+              args   => ['jeff', '*', 
+                  { '-func' => ['substr', 1010, 5, 6,], },
+              ],
+              stmt   => 'SELECT * FROM jeff WHERE (substr(?, ?, ?))',
+              stmt_q => 'SELECT * FROM `jeff` WHERE (substr(?, ?, ?))',
+              bind => [1010,5,6],
+      },
+      {
+              func   => 'select',
+              args   => ['jeff', '*', 
+                  { 'a' => {
+                        -func => 
+                        [ 'foo', { -func => [ 'max', 'bar'], }, 
+                            \['(SELECT crate FROM baz)'],
+                        ],
+                      },
+                  }
+              ],
+              stmt   => 'SELECT * FROM jeff WHERE (a = foo((max(?)), (SELECT crate FROM baz)))',
+              stmt_q => 'SELECT * FROM `jeff` WHERE (`a` = foo((max(?)), (SELECT crate FROM baz)))',
+              bind => ['bar'],
+      },
+      {
+              func   => 'update',
+              args   => ['test', {'b' => { -func => ['max', 500]}}, { a => { -func => ['max', \'a',]}, b => { -func => ['present', \'t', 'sophie', 30] },},],
+              stmt   => 'UPDATE test SET b = max(?) WHERE ((a = max(a)) AND (b = present(t, ?, ?)))',
+              stmt_q  => 'UPDATE `test` SET `b` = max(?) WHERE ((`a` = max(a)) AND (`b` = present(t, ?, ?)))',
+              bind   => [500, 'sophie', 30],
+      },
 );
 
-
 plan tests => scalar(grep { !$_->{warning_like} } @tests) * 2
             + scalar(grep { $_->{warning_like} } @tests) * 4;