X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=5b9a3b9d8fef1b63ccc6d007229cfeb33d14054e;hb=b5e9214cde0ae129ebc5121a4fc9ccc7492f2d2e;hp=17a26668b189067e13dfe449cd76830c625ae83e;hpb=21622a8edfa4e05d4ca170d6085823e47df48a1b;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 17a2666..5b9a3b9 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -44,19 +44,27 @@ passed objects. ## tests! sub new { - my ($class, $attrs, $source) = @_; + my ($class, $attrs) = @_; $class = ref $class if ref $class; my $new = { _column_data => {} }; bless $new, $class; - $new->_source_handle($source) if $source; + if (my $handle = delete $attrs->{-source_handle}) { + $new->_source_handle($handle); + } + if (my $source = delete $attrs->{-result_source}) { + $new->result_source($source); + } if ($attrs) { $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH'; my ($related,$inflated); + ## Pretend all the rels are actual objects, unset below if not, for insert() to fix + $new->{_rel_in_storage} = 1; + print STDERR "Attrs: ", Dumper($attrs), "\n"; foreach my $key (keys %$attrs) { if (ref $attrs->{$key}) { ## Can we extract this lot to use with update(_or .. ) ? @@ -64,20 +72,20 @@ sub new { if ($info && $info->{attrs}{accessor} && $info->{attrs}{accessor} eq 'single') { - my $rel_obj = $attrs->{$key}; - $new->{_rel_in_storage} = 1; + my $rel_obj = delete $attrs->{$key}; + print STDERR "REL: $key ", ref($rel_obj), "\n"; if(!Scalar::Util::blessed($rel_obj)) { $rel_obj = $new->new_related($key, $rel_obj); + print STDERR "REL: $key ", ref($rel_obj), "\n"; $new->{_rel_in_storage} = 0; } - $new->set_from_related($key, $attrs->{$key}); - $related->{$key} = $attrs->{$key}; + $new->set_from_related($key, $rel_obj); + $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}; - $new->{_rel_in_storage} = 1; foreach my $rel_obj (@$others) { if(!Scalar::Util::blessed($rel_obj)) { $rel_obj = $new->new_related($key, $rel_obj); @@ -91,7 +99,6 @@ sub new { { ## 'filter' should disappear and get merged in with 'single' above! my $rel_obj = $attrs->{$key}; - $new->{_rel_in_storage} = 1; if(!Scalar::Util::blessed($rel_obj)) { $rel_obj = $new->new_related($key, $rel_obj); $new->{_rel_in_storage} = 0; @@ -100,13 +107,12 @@ sub new { next; } } + use Data::Dumper; + print STDERR "Key: ", Dumper($key), "\n"; $new->throw_exception("No such column $key on $class") unless $class->has_column($key); $new->store_column($key => $attrs->{$key}); } - if (my $source = delete $attrs->{-result_source}) { - $new->result_source($source); - } $new->{_relationship_data} = $related if $related; $new->{_inflated_column} = $inflated if $inflated; @@ -148,6 +154,7 @@ sub insert { my $relobj = $related_stuff{$relname}; if(ref $relobj ne 'ARRAY') { $relobj->insert() if(!$relobj->in_storage); + print STDERR "Inserting: ", ref($relobj), "\n"; $self->set_from_related($relname, $relobj); } } @@ -177,6 +184,7 @@ sub insert { my $info = $self->relationship_info($relname); ## What about multi-col FKs ? my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/); + print STDERR "Inserting: ", ref($obj), "\n"; $obj->set_from_related($key, $self); $obj->insert() if(!$obj->in_storage); }