From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 10 Dec 2011 23:44:37 +0000 (+0100)
Subject: Switch from using execute_array to execute_for_fetch directly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52cef7e3;p=dbsrgits%2FDBIx-Class-Historic.git

Switch from using execute_array to execute_for_fetch directly

This saves us from pivoting our data into column slices, which execute_array
promptly turns back into our initial row-based format to feed to
execute_for_fetch. Apart from the obvious speed gain, this saves a lot of
memory since it avoids 2 copies of the (possibly rather large) dataset
---

diff --git a/Changes b/Changes
index 654ccca..702927c 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,8 @@ Revision history for DBIx::Class
 
     * New Features / Changes
         - Issue a warning when DateTime objects are passed to ->search
+        - Fast populate() in void context is now even more efficient by
+          going directly through execute_for_fetch bypassing execute_array
 
     * Fixes
         - Fix SkipFirst and FirstSkip limit dialects (Informix and Firebird)
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 210f254..607b1ef 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1871,8 +1871,8 @@ sub insert_bulk {
     $self->throw_exception('Cannot insert_bulk without support for placeholders');
   }
 
-  # neither _execute_array, nor _execute_inserts_with_no_binds are
-  # atomic (even if _execute _array is a single call). Thus a safety
+  # 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
   my $guard = $self->txn_scope_guard;
 
@@ -1882,7 +1882,7 @@ 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
-      $self->_execute_array( $source, $sth, $proto_bind, $cols, $data );
+      $self->_dbh_execute_for_fetch( $source, $sth, $proto_bind, $cols, $data );
     }
     else {
       # bind_param_array doesn't work if there are no binds
@@ -1897,37 +1897,56 @@ sub insert_bulk {
   return (wantarray ? ($rv, $sth, @$proto_bind) : $rv);
 }
 
-sub _execute_array {
-  my ($self, $source, $sth, $proto_bind, $cols, $data, @extra) = @_;
+# execute_for_fetch is capable of returning data just fine (it means it
+# can be used for INSERT...RETURNING and UPDATE...RETURNING. Since this
+# is the void-populate fast-path we will just ignore this altogether
+# for the time being.
+sub _dbh_execute_for_fetch {
+  my ($self, $source, $sth, $proto_bind, $cols, $data) = @_;
 
-  ## This must be an arrayref, else nothing works!
-  my $tuple_status = [];
+  my @idx_range = ( 0 .. $#$proto_bind );
 
-  my $bind_attrs = $self->_dbi_attrs_for_bind($source, $proto_bind);
+  # If we have any bind attributes to take care of, we will bind the
+  # proto-bind data (which will never be used by execute_for_fetch)
+  # However since column bindtypes are "sticky", this is sufficient
+  # to get the DBD to apply the bindtype to all values later on
 
-  # Bind the values by column slices
-  for my $i (0 .. $#$proto_bind) {
-    my $data_slice_idx = (
-      ref $proto_bind->[$i][0] eq 'HASH'
-        and
-      exists $proto_bind->[$i][0]{_bind_data_slice_idx}
-    ) ? $proto_bind->[$i][0]{_bind_data_slice_idx} : undef;
+  my $bind_attrs = $self->_dbi_attrs_for_bind($source, $proto_bind);
 
-    $sth->bind_param_array(
+  for my $i (@idx_range) {
+    $sth->bind_param (
       $i+1, # DBI bind indexes are 1-based
-      defined $data_slice_idx
-        # either get a "column" of dynamic values, or just repeat the same
-        # bind over and over
-        ? [ map { $_->[$data_slice_idx] } @$data ]
-        : [ ($proto_bind->[$i][1]) x @$data ]
-      ,
-      defined $bind_attrs->[$i] ? $bind_attrs->[$i] : (), # some DBDs throw up when given an undef
-    );
+      $proto_bind->[$i][1],
+      $bind_attrs->[$i],
+    ) if defined $bind_attrs->[$i];
   }
 
+  my $data_slice_idx = [ map {
+    (
+      ref $proto_bind->[$_][0] eq 'HASH'
+        and
+      exists $proto_bind->[$_][0]{_bind_data_slice_idx}
+    ) ? $proto_bind->[$_][0]{_bind_data_slice_idx} : undef;
+  } @idx_range ];
+
+  my $fetch_row_idx = -1; # saner loop this way
+  my $fetch_tuple = sub {
+    return undef if ++$fetch_row_idx > $#$data;
+
+    return [ map {
+      defined $data_slice_idx->[$_]
+        ? $data->[$fetch_row_idx][$data_slice_idx->[$_]]
+        : $proto_bind->[$_][1]
+    } @idx_range ];
+  };
+
+  my $tuple_status = [];
   my ($rv, $err);
   try {
-    $rv = $self->_dbh_execute_array($sth, $tuple_status, @extra);
+    $rv = $sth->execute_for_fetch(
+      $fetch_tuple,
+      $tuple_status,
+    );
   }
   catch {
     $err = shift;
@@ -1957,7 +1976,7 @@ sub _execute_array {
       if ($i > $#$tuple_status);
 
     require Data::Dumper::Concise;
-    $self->throw_exception(sprintf "execute_array() aborted with '%s' at populate slice:\n%s",
+    $self->throw_exception(sprintf "execute_for_fetch() aborted with '%s' at populate slice:\n%s",
       ($tuple_status->[$i][1] || $err),
       Data::Dumper::Concise::Dumper( { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } ),
     );
@@ -1966,11 +1985,6 @@ sub _execute_array {
   return $rv;
 }
 
-sub _dbh_execute_array {
-  #my ($self, $sth, $tuple_status, @extra) = @_;
-  return $_[1]->execute_array({ArrayTupleStatus => $_[2]});
-}
-
 sub _dbh_execute_inserts_with_no_binds {
   my ($self, $sth, $count) = @_;
 
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 256bbc9..3840c34 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -329,10 +329,10 @@ sub _dbh_execute {
   return wantarray ? @res : $res[0];
 }
 
-sub _dbh_execute_array {
+sub _dbh_execute_for_fetch {
   #my ($self, $sth, $tuple_status, @extra) = @_;
 
-  # DBD::Oracle warns loudly on partial execute_array failures
+  # DBD::Oracle warns loudly on partial execute_for_fetch failures
   local $_[1]->{PrintWarn} = 0;
 
   shift->next::method(@_);
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 43a5cca..7a9140a 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -299,7 +299,7 @@ my $method_dispatch = {
     transaction_depth
     _dbh
     _select_args
-    _dbh_execute_array
+    _dbh_execute_for_fetch
     _sql_maker
     _per_row_update_delete
     _dbh_execute_inserts_with_no_binds
@@ -309,7 +309,6 @@ my $method_dispatch = {
     _multipk_update_delete
     _normalize_connect_info
     _parse_connect_do
-    _execute_array
     savepoints
     _sql_maker_opts
     _conn_pid
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 55fb580..9c4f2f2 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -523,7 +523,7 @@ sub insert_bulk {
   if (not $use_bulk_api) {
     my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data);
 
-# _execute_array uses a txn anyway, but it ends too early in case we need to
+# next::method uses a txn anyway, but it ends too early in case we need to
 # select max(col) to get the identity for inserting blobs.
     ($self, my $guard) = $self->{transaction_depth} == 0 ?
       ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
@@ -654,7 +654,7 @@ sub insert_bulk {
       no strict 'refs';
       local *{ref($sth).'::finish'} = sub {};
 
-      $self->_execute_array(
+      $self->_dbh_execute_for_fetch(
         $source, $sth, $proto_bind, \@source_columns, \@new_data
       );
     }
diff --git a/t/100populate.t b/t/100populate.t
index f8c6f10..c5c3868 100644
--- a/t/100populate.t
+++ b/t/100populate.t
@@ -45,7 +45,7 @@ throws_ok ( sub {
       }
     } ('Huey', 'Dewey', $ex_title, 'Louie')
   ])
-}, qr/\Qexecute_array() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
+}, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
 
 ## make sure populate honors fields/orders in list context
 ## schema order
@@ -121,7 +121,7 @@ is($link7->title, 'gtitle', 'Link 7 title');
   my $rs = $schema->resultset('Link');
   $rs->delete;
 
-  # test _execute_array_empty (insert_bulk with all literal sql)
+  # test insert_bulk with all literal sql (no binds)
 
   $rs->populate([
     (+{
@@ -171,7 +171,7 @@ throws_ok {
             name => 'foo3',
         },
     ]);
-} qr/\Qexecute_array() aborted with 'datatype mismatch\E\b/, 'bad slice';
+} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice';
 
 is($rs->count, 0, 'populate is atomic');