where_hashpair is better than recurse_where
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm
index 6ed7985..eb50d98 100644 (file)
@@ -15,7 +15,7 @@ use Scalar::Util ();
 # GLOBALS
 #======================================================================
 
-our $VERSION  = '1.71';
+our $VERSION  = '1.72';
 
 # This would confuse some packagers
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
@@ -27,6 +27,8 @@ 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'},
+  {regex => qr/^ op   $/ix, handler => '_where_op_OP'},
 );
 
 # unaryish operators - key maps to handler
@@ -36,6 +38,8 @@ 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' },
+  { regex => qr/^ op   $/ix,                   handler => '_where_op_OP' },
 );
 
 #======================================================================
@@ -117,6 +121,17 @@ sub new {
   return bless \%opt, $class;
 }
 
+
+sub _assert_pass_injection_guard {
+  if ($_[1] =~ $_[0]->{injection_guard}) {
+    my $class = ref $_[0];
+    puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
+     . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
+     . "{injection_guard} attribute to ${class}->new()"
+  }
+}
+
+
 #======================================================================
 # INSERT methods
 #======================================================================
@@ -547,13 +562,7 @@ sub _where_unary_op {
 
   $self->debug("Generic unary OP: $op - recursing as function");
 
-  if ($op =~ $self->{injection_guard}) {
-    my $class = ref $self;
-
-    puke "Possible SQL injection attempt '$op'. If this is indeed a part of the "
-     . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
-     . "{injection_guard} attribute to ${class}->new()"
-  }
+  $self->_assert_pass_injection_guard($op);
 
   my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
     SCALAR =>   sub {
@@ -594,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'
         );
@@ -602,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'
         );
@@ -713,14 +722,7 @@ sub _where_hashpair_HASHREF {
     $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
     $op =~ s/\s+/ /g;     # compress whitespace
 
-    if ($op =~ $self->{injection_guard}) {
-      my $class = ref $self;
-
-      puke "Possible SQL injection attempt '$op'. If this is indeed a part of the "
-       . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
-       . "{injection_guard} attribute to ${class}->new()"
-    }
-
+    $self->_assert_pass_injection_guard($op);
 
     # so that -not_foo works correctly
     $op =~ s/^not_/NOT /i;
@@ -968,6 +970,113 @@ 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('?');
+
+  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 ($clause, @bind) = ("$func(" . (join ",", @all_sql) . ")", @all_bind);
+
+  my $sql = $k ? "( $label = $clause )" : "( $clause )";
+  return ($sql, @bind)
+}
+
+sub _where_op_OP {
+  my ($self) = @_;
+
+  my ($k, $vals);
+
+  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)
+}
 
 sub _where_field_IN {
   my ($self, $k, $op, $vals) = @_;
@@ -1167,14 +1276,7 @@ sub _quote {
   return ${$_[1]} if ref($_[1]) eq 'SCALAR';
 
   unless ($_[0]->{quote_char}) {
-
-    if ($_[1] =~ $_[0]->{injection_guard}) {
-      my $class = ref $_[0];
-      puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
-         . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
-         . "{injection_guard} attribute to ${class}->new()";
-    }
-
+    $_[0]->_assert_pass_injection_guard($_[1]);
     return $_[1];
   }
 
@@ -2232,6 +2334,32 @@ 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);
+
+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