[Bast-commits] r5544 - DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2009-02-20 04:09:04 +0000 (Fri, 20 Feb 2009)
New Revision: 5544

Modified:
   DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
   DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm
Log:
prevent objects implicitly passed via new_related having insertion cascaded to them unless we have to

Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm	2009-02-20 03:57:18 UTC (rev 5543)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm	2009-02-20 04:09:04 UTC (rev 5544)
@@ -1701,6 +1701,7 @@
     && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
   ) {
     %new = %{$self->{attrs}{related_objects}};
+    $new{-from_resultset} = [ keys %new ] if keys %new;
   } else {
     $self->throw_exception(
       "Can't abstract implicit construct, condition not a hash"

Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm	2009-02-20 03:57:18 UTC (rev 5543)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm	2009-02-20 04:09:04 UTC (rev 5544)
@@ -1014,9 +1014,6 @@
       $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;
 }
 

Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm	2009-02-20 03:57:18 UTC (rev 5543)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm	2009-02-20 04:09:04 UTC (rev 5544)
@@ -131,6 +131,10 @@
     $new->result_source($source);
   }
 
+  if (my $related = delete $attrs->{-from_resultset}) {
+    @{$new->{_ignore_at_insert}={}}{@$related} = ();
+  }
+
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
@@ -156,7 +160,7 @@
             $new->set_from_related($key, $rel_obj);
           } else {
             $new->{_rel_in_storage} = 0;
-            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj\n";
+            MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
           }
 
           $related->{$key} = $rel_obj;
@@ -178,7 +182,7 @@
             } else {
               $new->{_rel_in_storage} = 0;
               MULTICREATE_DEBUG and
-                warn "MC $new: uninserted $key $rel_obj ($idx of $total)\n";
+                warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
             }
             $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
             push(@objects, $rel_obj);
@@ -195,7 +199,7 @@
           }
           unless ($rel_obj->in_storage) {
             $new->{_rel_in_storage} = 0;
-            MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj";
+            MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
           }
           $inflated->{$key} = $rel_obj;
           next;
@@ -288,7 +292,10 @@
     }
   }
 
-  MULTICREATE_DEBUG and warn "MC $self inserting self\n";
+  MULTICREATE_DEBUG and do {
+    no warnings 'uninitialized';
+    warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
+  };
   my $updated_cols = $source->storage->insert($source, { $self->get_columns });
   foreach my $col (keys %$updated_cols) {
     $self->store_column($col, $updated_cols->{$col});
@@ -319,7 +326,7 @@
   $self->{related_resultsets} = {};
 
   if(!$self->{_rel_in_storage}) {
-    ## Now do the has_many rels, that need $selfs ID.
+    ## Now do the relationships that need our ID (has_many etc.)
     foreach my $relname (keys %related_stuff) {
       my $rel_obj = $related_stuff{$relname};
       my @cands;
@@ -335,10 +342,14 @@
           $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)) {
-            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";
+            if (exists $self->{_ignore_at_insert}{$relname}) {
+              MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
+            } else {
+              MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+              my $re = $self->find_or_create_related($relname, $them);
+              %{$obj} = %{$re};
+              MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
+            }
           } else {
             MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
             $obj->insert();
@@ -346,6 +357,7 @@
         }
       }
     }
+    delete $self->{_ignore_at_insert};
     $rollback_guard->commit;
   }