From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 8 Nov 2010 01:10:20 +0000 (+0100)
Subject: Refactor insert logic (Row should not handle SQLA options)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a85b7ebe9762ca64a08468f6c8f27a0ae583d38c;p=dbsrgits%2FDBIx-Class-Historic.git

Refactor insert logic (Row should not handle SQLA options)
---

diff --git a/Changes b/Changes
index 93ba746..2acf103 100644
--- a/Changes
+++ b/Changes
@@ -11,6 +11,8 @@ Revision history for DBIx::Class
           (RT#62642)
         - Fix incomplete logic while detecting correct Oracle sequence
           on insert
+        - Refactor handling of RDBMS-side values during insert() - fix
+          regression of inserts into a Postgres / ::Replicated combination
 
 0.08124 2010-10-28 14:23 (UTC)
     * New Features / Changes
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 1b66e35..b8c4da7 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -295,6 +295,8 @@ sub insert {
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
 
+  my $storage = $source->storage;
+
   my $rollback_guard;
 
   # Check if we stored uninserted relobjs here in new()
@@ -314,7 +316,7 @@ sub insert {
                   );
 
       # The guard will save us if we blow out of this scope via die
-      $rollback_guard ||= $source->storage->txn_scope_guard;
+      $rollback_guard ||= $storage->txn_scope_guard;
 
       MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
 
@@ -343,51 +345,48 @@ sub insert {
   # start a transaction here if not started yet and there is more stuff
   # to insert after us
   if (keys %related_stuff) {
-    $rollback_guard ||= $source->storage->txn_scope_guard
-  }
-
-  ## PK::Auto
-  my %auto_pri;
-  my $auto_idx = 0;
-  for ($self->primary_columns) {
-    if (
-      not defined $self->get_column($_)
-        ||
-      (ref($self->get_column($_)) eq 'SCALAR')
-    ) {
-      my $col_info = $source->column_info($_);
-      $auto_pri{$_} = $auto_idx++ unless $col_info->{auto_nextval};   # auto_nextval's are pre-fetched in the storage
-    }
+    $rollback_guard ||= $storage->txn_scope_guard
   }
 
   MULTICREATE_DEBUG and do {
     no warnings 'uninitialized';
     warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
   };
-  my $updated_cols = $source->storage->insert(
+
+  my %current_rowdata = $self->get_columns;
+
+  # perform the insert - the storage may return some stuff for us right there
+  #
+  my $returned_cols = $storage->insert(
     $source,
-    { $self->get_columns },
-    (keys %auto_pri) && $source->storage->_use_insert_returning
-      ? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] }
-      : ()
-    ,
+    \%current_rowdata,
   );
 
-  foreach my $col (keys %$updated_cols) {
-    $self->store_column($col, $updated_cols->{$col});
-    delete $auto_pri{$col};
+  for (keys %$returned_cols) {
+    $self->store_column(
+      $_,
+      ( $current_rowdata{$_} = $returned_cols->{$_} )
+    );
   }
 
-  if (keys %auto_pri) {
-    my @missing = sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri;
-    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing )."\n";
-    my $storage = $self->result_source->storage;
+  # see if any of the pcols still need filling (or re-querying in case of scalarrefs)
+  my @missing_pri = grep
+    { ! defined $current_rowdata{$_} or ref $current_rowdata{$_} eq 'SCALAR' }
+    $self->primary_columns
+  ;
+
+  if (@missing_pri) {
+    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing_pri )."\n";
+
     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
       unless $storage->can('last_insert_id');
-    my @ids = $storage->last_insert_id($self->result_source, @missing);
+
+    my @pri_values = $storage->last_insert_id($self->result_source, @missing_pri);
+
     $self->throw_exception( "Can't get last insert id" )
-      unless (@ids == @missing);
-    $self->store_column($missing[$_] => $ids[$_]) for 0 .. $#missing;
+      unless (@pri_values == @missing_pri);
+
+    $self->store_column($missing_pri[$_] => $pri_values[$_]) for 0 .. $#missing_pri;
   }
 
   $self->{_dirty_columns} = {};
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index b091e64..ed2ab1b 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1590,41 +1590,62 @@ sub _execute {
     $self->dbh_do('_dbh_execute', @_);  # retry over disconnects
 }
 
-sub _prefetch_insert_auto_nextvals {
+sub insert {
   my ($self, $source, $to_insert) = @_;
 
-  my $upd = {};
-
-  foreach my $col ( $source->columns ) {
-    if ( !defined $to_insert->{$col} ) {
-      my $col_info = $source->column_info($col);
+  my $colinfo = $source->columns_info;
 
-      if ( $col_info->{auto_nextval} ) {
-        $upd->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
-          'nextval',
-          $col_info->{sequence} ||=
+  # mix with auto-nextval marked values (a bit of a speed hit, but
+  # no saner way to handle this yet)
+  my $auto_nextvals = {} ;
+  for my $col (keys %$colinfo) {
+    if (
+      $colinfo->{$col}{auto_nextval}
+        and
+      (
+        ! exists $to_insert->{$col}
+          or
+        ref $to_insert->{$col} eq 'SCALAR'
+      )
+    ) {
+      $auto_nextvals->{$col} = $self->_sequence_fetch(
+        'nextval',
+        ( $colinfo->{$col}{sequence} ||=
             $self->_dbh_get_autoinc_seq($self->_get_dbh, $source, $col)
-        );
-      }
+        ),
+      );
     }
   }
 
-  return $upd;
-}
+  # fuse the values
+  $to_insert = { %$to_insert, %$auto_nextvals };
 
-sub insert {
-  my $self = shift;
-  my ($source, $to_insert, $opts) = @_;
+  # list of primary keys we try to fetch from the database
+  # both not-exsists and scalarrefs are considered
+  my %fetch_pks;
+  %fetch_pks = ( map
+    { $_ => scalar keys %fetch_pks }  # so we can preserve order for prettyness
+    grep
+      { ! exists $to_insert->{$_} or ref $to_insert->{$_} eq 'SCALAR' }
+      $source->primary_columns
+  );
 
-  my $updated_cols = $self->_prefetch_insert_auto_nextvals (@_);
+  my $sqla_opts;
+  if ($self->_use_insert_returning) {
+
+    # retain order as declared in the resultsource
+    for (sort { $fetch_pks{$a} <=> $fetch_pks{$b} } keys %fetch_pks ) {
+      push @{$sqla_opts->{returning}}, $_;
+    }
+  }
 
   my $bind_attributes = $self->source_bind_attributes($source);
 
-  my ($rv, $sth) = $self->_execute('insert' => [], $source, $bind_attributes, $to_insert, $opts);
+  my ($rv, $sth) = $self->_execute('insert' => [], $source, $bind_attributes, $to_insert, $sqla_opts);
 
-  if ($opts->{returning}) {
-    my @ret_cols = @{$opts->{returning}};
+  my %returned_cols = %$auto_nextvals;
 
+  if (my $retlist = $sqla_opts->{returning}) {
     my @ret_vals = try {
       local $SIG{__WARN__} = sub {};
       my @r = $sth->fetchrow_array;
@@ -1632,18 +1653,13 @@ sub insert {
       @r;
     };
 
-    my %ret;
-    @ret{@ret_cols} = @ret_vals if (@ret_vals);
-
-    $updated_cols = {
-      %$updated_cols,
-      %ret,
-    };
+    @returned_cols{@$retlist} = @ret_vals if @ret_vals;
   }
 
-  return $updated_cols;
+  return \%returned_cols;
 }
 
+
 ## Currently it is assumed that all values passed will be "normal", i.e. not
 ## scalar refs, or at least, all the same type as the first set, the statement is
 ## only prepped once.
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 4477475..b61e831 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -362,7 +362,6 @@ has 'write_handler' => (
     _do_query
     _dbh_sth
     _dbh_execute
-    _prefetch_insert_auto_nextvals
   /],
 );