squash, data filter shouldnt run on arrayrefref

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index b4e5851..f7e6222 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1995,29 +1995,34 @@ sub insert_bulk {
     }
 
     for my $chunk (@chunked) {
-      my $current = shift @$chunk;
-
-      my $tuple;
-      $tuple = sub {
-        my $row = do {
-          if (ref $current eq 'ARRAY') {
-            shift @$current;
+      if (ref $chunk eq 'REF') {
+        $self->_insert_bulk($source, $cols, $chunk);
+      }
+      else {
+        my $current = shift @$chunk;
+
+        my $tuple;
+        $tuple = sub {
+          my $row = do {
+            if (ref $current eq 'ARRAY') {
+              shift @$current;
+            }
+            elsif (ref $current eq 'CODE') {
+              $current->();
+            }
+          };
+
+          if ($row) {
+            return $row;
           }
-          elsif (ref $current eq 'CODE') {
-            $current->();
+          elsif (!defined $row && @$chunk) {
+            $current = shift @$chunk;
+            return $tuple->();
           }
         };
 
-        if ($row) {
-          return $row;
-        }
-        elsif (!defined $row && @$chunk) {
-          $current = shift @$chunk;
-          return $tuple->();
-        }
-      };
-
-      $self->_insert_bulk($source, $cols, $tuple);
+        $self->_insert_bulk($source, $cols, $tuple);
+      }
     }
   }
   else {
@@ -2119,7 +2124,6 @@ sub _insert_bulk {
     $source,
     [ $proto_data || \[ $cols => $data ] ],
   );
-  use DDP; p $proto_bind; p $proto_data;
 
   if (! @$proto_bind and keys %$value_type_by_col_idx) {
     # if the bindlist is empty and we had some dynamic binds, this means the
@@ -2149,15 +2153,8 @@ sub _insert_bulk {
     );
   };
 
-  my $row_idx = 0;
-  my $fetch_tuple = sub {
-    my $row
-      = !$row_idx++         ? $reference_row
-      : ref $data eq 'CODE' ? $data->()
-      :                     shift @$data;
-
-    return undef if !$row;
-
+  my $data_filter = sub {
+    my ($row, $row_idx) = @_;
     # FIXME - perhaps this is not even needed? does DBI stringify?
     #
     # forcibly stringify whatever is stringifiable
@@ -2167,7 +2164,6 @@ sub _insert_bulk {
         if ( ref $row->[$c] and overload::Method($row->[$c], '""') );
     }
 
-    # column validation
     for my $col_idx (@col_range) {
       my $reference_val = $reference_row->[$col_idx];
 
@@ -2175,6 +2171,7 @@ sub _insert_bulk {
 
       if (! exists $value_type_by_col_idx->{$col_idx}) { # literal no binds
         if (ref $val ne 'SCALAR') {
+          use DDP; p @_;
           $bad_slice_report_cref->(
             "Incorrect value (expecting SCALAR-ref \\'$$reference_val')",
             $row_idx,
@@ -2236,10 +2233,14 @@ sub _insert_bulk {
         }
       }
     }
-
-    $row;
   };
 
+  # we have a split codepath here where col validation happens in the
+  # fetch_tuple, but the tuple isnt used in no proto_bind situations, so we run it
+  if (!@$proto_bind && ref $data eq 'ARRAY') {
+    $data_filter->($data->[$_], $_) for (0..$#$data);
+  }
+
   # neither _dbh_execute_for_fetch, nor _dbh_execute_inserts_with_no_binds
   # are atomic (even if execute_for_fetch is a single call). Thus a safety
   # scope guard
@@ -2251,11 +2252,24 @@ sub _insert_bulk {
     if (@$proto_bind) {
       # proto bind contains the information on which pieces of $data to pull
       # $cols is passed in only for prettier error-reporting
+      my $row_idx = 0;
+      my $fetch_tuple = sub {
+        my $row
+          = !$row_idx++         ? $reference_row
+          : ref $data eq 'CODE' ? $data->()
+          :                     shift @$data;
+
+        return undef if !$row;
+
+        $data_filter->($row, $row_idx);
+
+        $row;
+      };
+
       $self->_dbh_execute_for_fetch( $source, $sth, $proto_bind, $cols, $fetch_tuple );
     }
     else {
       # bind_param_array doesn't work if there are no binds
-      p $proto_bind;
       $self->_dbh_execute_inserts_with_no_binds( $sth, ref $data eq 'ARRAY' ? (scalar(@$data)+1) : 1 );
     }
   };