From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 20 Feb 2009 02:22:47 +0000 (+0000)
Subject: add DBIC_MULTICREATE_DEBUG, fix one bug with column values not being transferred
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0cdf2cbe02e576686d9281c1eaac8456086cf39;hp=b3a9a1ac0bf01e7be5aae1966eef67f70a9dde55;p=dbsrgits%2FDBIx-Class-Historic.git

add DBIC_MULTICREATE_DEBUG, fix one bug with column values not being transferred
---

diff --git a/Makefile.PL b/Makefile.PL
index e116792..f590d45 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,6 +25,7 @@ requires 'Scope::Guard'              => 0.03;
 requires 'Path::Class'               => 0;
 requires 'List::Util'                => 1.19;
 requires 'Sub::Name'                 => 0.04;
+requires 'namespace::clean'          => 0.09;
 
 # Perl 5.8.0 doesn't have utf8::is_utf8()
 requires 'Encode'                    => 0 if ($] <= 5.008000);  
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index bc88091..89bc6ff 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1014,6 +1014,9 @@ sub reverse_relationship_info {
       $ret->{$otherrel} =  $otherrel_info;
     }
   }
+use Data::Dumper;
+#warn "return for reverse_relationship_info called on ".$self->name." for $rel:\n";
+#warn Dumper($ret);
   return $ret;
 }
 
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index ba05001..abc34ab 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -8,6 +8,13 @@ use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util ();
 use Scope::Guard;
 
+BEGIN {
+  *MULTICREATE_DEBUG =
+    $ENV{DBIC_MULTICREATE_DEBUG}
+      ? sub () { 1 }
+      : sub () { 0 };
+}
+
 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
 =head1 NAME
@@ -145,24 +152,38 @@ sub new {
             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
           }
 
-          $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          if ($rel_obj->in_storage) {
+            $new->set_from_related($key, $rel_obj);
+          } else {
+            $new->{_rel_in_storage} = 0;
+            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj\n";
+          }
 
-          $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
           $related->{$key} = $rel_obj;
           next;
         } elsif ($info && $info->{attrs}{accessor}
             && $info->{attrs}{accessor} eq 'multi'
             && ref $attrs->{$key} eq 'ARRAY') {
           my $others = delete $attrs->{$key};
-          foreach my $rel_obj (@$others) {
+          my $total = @$others;
+          my @objects;
+          foreach my $idx (0 .. $#$others) {
+            my $rel_obj = $others->[$idx];
             if(!Scalar::Util::blessed($rel_obj)) {
               $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
             }
 
-            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+            if ($rel_obj->in_storage) {
+              $new->set_from_related($key, $rel_obj);
+            } else {
+              $new->{_rel_in_storage} = 0;
+              MULTICREATE_DEBUG and
+                warn "MC $new: uninserted $key $rel_obj ($idx of $total)\n";
+            }
             $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
+            push(@objects, $rel_obj);
           }
-          $related->{$key} = $others;
+          $related->{$key} = \@objects;
           next;
         } elsif ($info && $info->{attrs}{accessor}
           && $info->{attrs}{accessor} eq 'filter')
@@ -172,7 +193,10 @@ sub new {
           if(!Scalar::Util::blessed($rel_obj)) {
             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
           }
-          $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+          unless ($rel_obj->in_storage) {
+            $new->{_rel_in_storage} = 0;
+            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj";
+          }
           $inflated->{$key} = $rel_obj;
           next;
         } elsif ($class->has_column($key)
@@ -256,12 +280,15 @@ sub insert {
                         $relname, { $rel_obj->get_columns }
                       );
 
+      MULTICREATE_DEBUG and warn "MC $self pre-inserting $relname $rel_obj\n";
+
       $rel_obj->insert();
       $self->set_from_related($relname, $rel_obj);
       delete $related_stuff{$relname};
     }
   }
 
+  MULTICREATE_DEBUG and warn "MC $self inserting self\n";
   my $updated_cols = $source->storage->insert($source, { $self->get_columns });
   foreach my $col (keys %$updated_cols) {
     $self->store_column($col, $updated_cols->{$col});
@@ -276,7 +303,7 @@ sub insert {
   if (@auto_pri) {
     #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
     #  if defined $too_many;
-
+    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
     my $storage = $self->result_source->storage;
     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
       unless $storage->can('last_insert_id');
@@ -284,8 +311,10 @@ sub insert {
     $self->throw_exception( "Can't get last insert id" )
       unless (@ids == @auto_pri);
     $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
+#use Data::Dumper; warn Dumper($self);
   }
 
+
   $self->{_dirty_columns} = {};
   $self->{related_resultsets} = {};
 
@@ -306,8 +335,12 @@ sub insert {
           $obj->set_from_related($_, $self) for keys %$reverse;
           my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
           if ($self->__their_pk_needs_us($relname, $them)) {
-            $obj = $self->find_or_create_related($relname, $them);
+            MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+            my $re = $self->find_or_create_related($relname, $them);
+            $obj->{_column_data} = $re->{_column_data};
+            MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
           } else {
+            MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
             $obj->insert();
           }
         }