Fix bindtype omission in -in handling
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract.pm
index 3863425..4d2e49f 100644 (file)
@@ -15,7 +15,7 @@ use Scalar::Util ();
 # GLOBALS
 #======================================================================
 
-our $VERSION  = '1.65_02';
+our $VERSION  = '1.68';
 
 # This would confuse some packagers
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
@@ -406,7 +406,11 @@ sub _where_ARRAYREF {
       # skip empty elements, otherwise get invalid trailing AND stuff
       ARRAYREF  => sub {$self->_recurse_where($el)        if @$el},
 
-      ARRAYREFREF => sub { @{${$el}}                 if @{${$el}}},
+      ARRAYREFREF => sub {
+        my ($s, @b) = @$$el;
+        $self->_assert_bindval_matches_bindtype(@b);
+        ($s, @b);
+      },
 
       HASHREF   => sub {$self->_recurse_where($el, 'and') if %$el},
            # LDNOTE : previous SQLA code for hashrefs was creating a dirty
@@ -438,8 +442,8 @@ sub _where_ARRAYREF {
 
 sub _where_ARRAYREFREF {
     my ($self, $where) = @_;
-    my ($sql, @bind) = @{${$where}};
-
+    my ($sql, @bind) = @$$where;
+    $self->_assert_bindval_matches_bindtype(@bind);
     return ($sql, @bind);
 }
 
@@ -782,7 +786,7 @@ sub _where_hashpair_SCALARREF {
 sub _where_hashpair_ARRAYREFREF {
   my ($self, $k, $v) = @_;
   $self->_debug("REF($k) means literal SQL: @${$v}");
-  my ($sql, @bind) = @${$v};
+  my ($sql, @bind) = @$$v;
   $self->_assert_bindval_matches_bindtype(@bind);
   $sql  = $self->_quote($k) . " " . $sql;
   return ($sql, @bind );
@@ -852,7 +856,9 @@ sub _where_field_BETWEEN {
 
   my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
     ARRAYREFREF => sub {
-      return @$$vals;
+      my ($s, @b) = @$$vals;
+      $self->_assert_bindval_matches_bindtype(@b);
+      ($s, @b);
     },
     SCALARREF => sub {
       return $$vals;
@@ -865,15 +871,23 @@ sub _where_field_BETWEEN {
       foreach my $val (@$vals) {
         my ($sql, @bind) = $self->_SWITCH_refkind($val, {
            SCALAR => sub {
-             return ($placeholder, ($val));
+             return ($placeholder, $val);
            },
            SCALARREF => sub {
-             return ($self->_convert($$val), ());
+             return $$val;
            },
            ARRAYREFREF => sub {
              my ($sql, @bind) = @$$val;
-             return ($self->_convert($sql), @bind);
+             $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_func_generic ($1 => $arg);
+           }
         });
         push @all_sql, $sql;
         push @all_bind, @bind;
@@ -907,11 +921,41 @@ sub _where_field_IN {
   my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
     ARRAYREF => sub {     # list of choices
       if (@$vals) { # nonempty list
-        my $placeholders  = join ", ", (($placeholder) x @$vals);
-        my $sql           = "$label $op ( $placeholders )";
-        my @bind = $self->_bindtype($k, @$vals);
+        my (@all_sql, @all_bind);
+
+        for my $val (@$vals) {
+          my ($sql, @bind) = $self->_SWITCH_refkind($val, {
+            SCALAR => sub {
+              return ($placeholder, $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 IN")
+                if (@rest or $func !~ /^ \- (.+)/x);
+              local $self->{_nested_func_lhs} = $k;
+              $self->_where_func_generic ($1 => $arg);
+            }
+          });
+          push @all_sql, $sql;
+          push @all_bind, @bind;
+        }
 
-        return ($sql, @bind);
+        return (
+          sprintf ('%s %s ( %s )',
+            $label,
+            $op,
+            join (', ', @all_sql)
+          ),
+          $self->_bindtype($k, @all_bind),
+        );
       }
       else { # empty list : some databases won't understand "IN ()", so DWIM
         my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
@@ -983,7 +1027,11 @@ sub _order_by_chunks {
       map { $self->_order_by_chunks ($_ ) } @$arg;
     },
 
-    ARRAYREFREF => sub { [ @$$arg ] },
+    ARRAYREFREF => sub {
+      my ($s, @b) = @$$arg;
+      $self->_assert_bindval_matches_bindtype(@b);
+      [ $s, @b ];
+    },
 
     SCALAR    => sub {$self->_quote($arg)},
 
@@ -993,11 +1041,11 @@ sub _order_by_chunks {
 
     HASHREF   => sub {
       # get first pair in hash
-      my ($key, $val) = each %$arg;
+      my ($key, $val, @rest) = %$arg;
 
       return () unless $key;
 
-      if ( (keys %$arg) > 1 or not $key =~ /^-(desc|asc)/i ) {
+      if ( @rest or not $key =~ /^-(desc|asc)/i ) {
         puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
       }
 
@@ -1113,12 +1161,12 @@ sub _bindtype (@) {
 # Dies if any element of @bind is not in [colname => value] format
 # if bindtype is 'columns'.
 sub _assert_bindval_matches_bindtype {
-  my ($self, @bind) = @_;
-
+#  my ($self, @bind) = @_;
+  my $self = shift;
   if ($self->{bindtype} eq 'columns') {
-    foreach my $val (@bind) {
-      if (!defined $val || ref($val) ne 'ARRAY' || @$val != 2) {
-        die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
+    for (@_) {
+      if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
+        puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
       }
     }
   }
@@ -1889,6 +1937,20 @@ This simple code will create the following:
 A field associated to an empty arrayref will be considered a
 logical false and will generate 0=1.
 
+=head2 Tests for NULL values
+
+If the value part is C<undef> then this is converted to SQL <IS NULL>
+
+    my %where  = (
+        user   => 'nwiger',
+        status => undef,
+    );
+
+becomes:
+
+    $stmt = "WHERE user = ? AND status IS NULL";
+    @bind = ('nwiger');
+
 =head2 Specific comparison operators
 
 If you want to specify a different type of operator for your comparison,
@@ -2087,7 +2149,7 @@ list can be expanded : see section L</"SPECIAL OPERATORS"> below.
 If you wish to test against boolean columns or functions within your
 database you can use the C<-bool> and C<-not_bool> operators. For
 example to test the column C<is_user> being true and the column
-<is_enabled> being false you would use:-
+C<is_enabled> being false you would use:-
 
     my %where  = (
         -bool       => 'is_user',
@@ -2250,6 +2312,17 @@ which yields
     $stmt = "WHERE priority < ? AND is_ready";
     @bind = ('2');
 
+Literal SQL is also the only way to compare 2 columns to one another:
+
+    my %where = (
+        priority => { '<', 2 },
+        requestor => \'= submittor'
+    );
+
+which creates:
+
+    $stmt = "WHERE priority < ? AND requestor = submitter";
+    @bind = ('2');
 
 =head2 Literal SQL with placeholders and bind values (subqueries)
 
@@ -2573,6 +2646,12 @@ the same structure, you only have to generate the SQL the first time
 around. On subsequent queries, simply use the C<values> function provided
 by this module to return your values in the correct order.
 
+However this depends on the values having the same type - if, for
+example, the values of a where clause may either have values
+(resulting in sql of the form C<column = ?> with a single bind
+value), or alternatively the values might be C<undef> (resulting in
+sql of the form C<column IS NULL> with no bind value) then the
+caching technique suggested will not work.
 
 =head1 FORMBUILDER