[Dbix-class] ->copy for has_one relationships broken?

[Mark Trostler]

Ok having more time to think about it - here's what is the problem (I 
think):

->copy works great for 'multi' type relationships.
However when putting cascade_copy => 1 on a 'has_one' relationship:

package PBDB::Ingredient;

...
     hardware_spec_id => {
                         data_type           => 'INT',
                         is_nullable         => 0,
                     },
...

__PACKAGE__->has_one(hardware_spec => 'PBDB::Hardware_Spec',
     { 'foreign.id' => 'self.hardware_spec_id' }, { cascade_copy => 1 });

-----

package PDBD::Hardware_Spec;

...
     id          => {
                         data_type           => 'INT',
                         is_nullable         => 0,
                         is_auto_increment   => 1,
                     },
...


__PACKAGE__->has_many(ingredients => 'PBDB::Ingredient',
     { 'foreign.hardware_spec_id' => 'self.id' }, { cascade_copy => 0 });

...


Strange Thing happen on ->copy.

First, the $resolved hash has the primary auto incremented key of the 
hardware_spec row 'id' - so when ->copy is called recursively on it the 
insert fails (as it's a dup entry).

Second, since the recursive relationship-creating copy call happens 
after the $new object is inserted, the $new object's has_one 
relationship with the cascaded copy never gets set to the newly created 
cascaded object.

So here's a patch that seems to fix both problem:

--- /home/y/lib/perl5/site_perl/5.8/DBIx/Class/Row.pm   2007-08-01 
12:02:11.000000000 -0700
+++ hack/Row.pm 2008-05-22 11:33:58.000000000 -0700
@@ -518,6 +518,11 @@ sub copy {
        if $self->result_source->column_info($col)->{is_auto_increment};
    }

+  foreach my $col (keys %$changes) {
+    delete $changes->{$col}
+      if $self->result_source->column_info($col)->{is_auto_increment};
+  }
+
    my $new = { _column_data => $col_data };
    bless $new, ref $self;

@@ -530,10 +535,14 @@ sub copy {
        my $resolved = $self->result_source->resolve_condition(
         $rel_info->{cond}, $rel, $new);
        foreach my $related ($self->search_related($rel)) {
-        $related->copy($resolved);
+        my $copy = $related->copy($resolved);
+        if ($rel_info->{attrs}->{accessor} eq 'single') {
+            $new->update_from_related($rel, $copy);
+        }
        }
      }
    }



I think that makes sense...  Of course I could be missing something very 
  obvious.
thanks,
	Mark