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
_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/[EMAIL PROTECTED]
