X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=a77615b3a9142645ebb34ad932c98338947eb8c1;hb=d0e5848787d1fb2d4914001586c456b456593e20;hp=158c215d9aed0cf198c0ba52926afc3eb469927e;hpb=bbd107cf7ae1e53547ce63b710716d88adb73013;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 158c215..a77615b 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -4,9 +4,9 @@ use strict; use warnings; use base qw/DBIx::Class/; -use Carp::Clan qw/^DBIx::Class/; + +use DBIx::Class::Exception; use Scalar::Util (); -use Scope::Guard; ### ### Internal method @@ -155,7 +155,7 @@ sub new { $new->result_source($source); } - if (my $related = delete $attrs->{-from_resultset}) { + if (my $related = delete $attrs->{-cols_from_relations}) { @{$new->{_ignore_at_insert}={}}{@$related} = (); } @@ -164,13 +164,12 @@ sub new { 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; foreach my $key (keys %$attrs) { if (ref $attrs->{$key}) { ## Can we extract this lot to use with update(_or .. ) ? - confess "Can't do multi-create without result source" unless $source; + $new->throw_exception("Can't do multi-create without result source") + unless $source; my $info = $source->relationship_info($key); if ($info && $info->{attrs}{accessor} && $info->{attrs}{accessor} eq 'single') @@ -181,9 +180,9 @@ sub new { } if ($rel_obj->in_storage) { + $new->{_rel_in_storage}{$key} = 1; $new->set_from_related($key, $rel_obj); } else { - $new->{_rel_in_storage} = 0; MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n"; } @@ -202,13 +201,11 @@ sub new { } if ($rel_obj->in_storage) { - $new->set_from_related($key, $rel_obj); + $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong'); } else { - $new->{_rel_in_storage} = 0; MULTICREATE_DEBUG and 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); } $related->{$key} = \@objects; @@ -221,8 +218,10 @@ sub new { if(!Scalar::Util::blessed($rel_obj)) { $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); } - unless ($rel_obj->in_storage) { - $new->{_rel_in_storage} = 0; + if ($rel_obj->in_storage) { + $new->{_rel_in_storage}{$key} = 1; + } + else { MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj"; } $inflated->{$key} = $rel_obj; @@ -286,27 +285,21 @@ sub insert { my %related_stuff = (%{$self->{_relationship_data} || {}}, %{$self->{_inflated_column} || {}}); - if(!$self->{_rel_in_storage}) { - - # The guard will save us if we blow out of this scope via die - $rollback_guard = $source->storage->txn_scope_guard; - - ## Should all be in relationship_data, but we need to get rid of the - ## 'filter' reltype.. - ## These are the FK rels, need their IDs for the insert. - - my @pri = $self->primary_columns; - - REL: foreach my $relname (keys %related_stuff) { + # insert what needs to be inserted before us + my %pre_insert; + for my $relname (keys %related_stuff) { + my $rel_obj = $related_stuff{$relname}; - my $rel_obj = $related_stuff{$relname}; + if (! $self->{_rel_in_storage}{$relname}) { + next unless (Scalar::Util::blessed($rel_obj) + && $rel_obj->isa('DBIx::Class::Row')); - next REL unless (Scalar::Util::blessed($rel_obj) - && $rel_obj->isa('DBIx::Class::Row')); + next unless $source->_pk_depends_on( + $relname, { $rel_obj->get_columns } + ); - next REL unless $source->_pk_depends_on( - $relname, { $rel_obj->get_columns } - ); + # The guard will save us if we blow out of this scope via die + $rollback_guard ||= $source->storage->txn_scope_guard; MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n"; @@ -315,10 +308,19 @@ sub insert { ->related_source($relname) ->resultset ->find_or_create($them); + %{$rel_obj} = %{$re}; - $self->set_from_related($relname, $rel_obj); - delete $related_stuff{$relname}; + $self->{_rel_in_storage}{$relname} = 1; } + + $self->set_from_related($relname, $rel_obj); + delete $related_stuff{$relname}; + } + + # start a transaction here if not started yet and there is more stuff + # to insert after us + if (keys %related_stuff) { + $rollback_guard ||= $source->storage->txn_scope_guard } MULTICREATE_DEBUG and do { @@ -332,13 +334,12 @@ sub insert { ## PK::Auto my @auto_pri = grep { - !defined $self->get_column($_) || - ref($self->get_column($_)) eq 'SCALAR' + (not defined $self->get_column($_)) + || + (ref($self->get_column($_)) eq 'SCALAR') } $self->primary_columns; 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" ) @@ -353,47 +354,47 @@ sub insert { $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; - if(!$self->{_rel_in_storage}) { - ## 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; - if (Scalar::Util::blessed($rel_obj) - && $rel_obj->isa('DBIx::Class::Row')) { - @cands = ($rel_obj); - } elsif (ref $rel_obj eq 'ARRAY') { - @cands = @$rel_obj; - } - if (@cands) { - my $reverse = $source->reverse_relationship_info($relname); - foreach my $obj (@cands) { - $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)) { - 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->result_source - ->related_source($relname) - ->resultset - ->find_or_create($them); - %{$obj} = %{$re}; - MULTICREATE_DEBUG and warn "MC $self new $relname $obj"; - } + foreach my $relname (keys %related_stuff) { + next unless $source->has_relationship ($relname); + + my @cands = ref $related_stuff{$relname} eq 'ARRAY' + ? @{$related_stuff{$relname}} + : $related_stuff{$relname} + ; + + if (@cands + && Scalar::Util::blessed($cands[0]) + && $cands[0]->isa('DBIx::Class::Row') + ) { + my $reverse = $source->reverse_relationship_info($relname); + foreach my $obj (@cands) { + $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)) { + 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 post-inserting $obj"; - $obj->insert(); + MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj"; + my $re = $self->result_source + ->related_source($relname) + ->resultset + ->create($them); + %{$obj} = %{$re}; + MULTICREATE_DEBUG and warn "MC $self new $relname $obj"; } + } else { + MULTICREATE_DEBUG and warn "MC $self post-inserting $obj"; + $obj->insert(); } } } - delete $self->{_ignore_at_insert}; - $rollback_guard->commit; } $self->in_storage(1); - undef $self->{_orig_ident}; + delete $self->{_orig_ident}; + delete $self->{_ignore_at_insert}; + $rollback_guard->commit if $rollback_guard; + return $self; } @@ -423,7 +424,7 @@ L on one, sets it to false. sub in_storage { my ($self, $val) = @_; $self->{_in_storage} = $val if @_ > 1; - return $self->{_in_storage}; + return $self->{_in_storage} ? 1 : 0; } =head2 update @@ -526,7 +527,9 @@ attempt is made to delete all the related objects as well. To turn this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr> hashref of the relationship, see L. Any database-level cascade or restrict will take precedence over a -DBIx-Class-based cascading delete. +DBIx-Class-based cascading delete, since DBIx-Class B and only then attempts to delete any remaining related +rows. If you delete an object within a txn_do() (see L) and the transaction subsequently fails, the row object will remain marked as @@ -750,10 +753,43 @@ See L for how to setup inflation. sub get_inflated_columns { my $self = shift; - return map { - my $accessor = $self->column_info($_)->{'accessor'} || $_; - ($_ => $self->$accessor); - } grep $self->has_column_loaded($_), $self->columns; + + my %loaded_colinfo = (map + { $_ => $self->column_info($_) } + (grep { $self->has_column_loaded($_) } $self->columns) + ); + + my %inflated; + for my $col (keys %loaded_colinfo) { + if (exists $loaded_colinfo{$col}{accessor}) { + my $acc = $loaded_colinfo{$col}{accessor}; + if (defined $acc) { + $inflated{$col} = $self->$acc; + } + } + else { + $inflated{$col} = $self->$col; + } + } + + # return all loaded columns with the inflations overlayed on top + return ($self->get_columns, %inflated); +} + +sub _is_column_numeric { + my ($self, $column) = @_; + my $colinfo = $self->column_info ($column); + + # cache for speed (the object may *not* have a resultsource instance) + if (not defined $colinfo->{is_numeric} && $self->_source_handle) { + $colinfo->{is_numeric} = + $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type}) + ? 1 + : 0 + ; + } + + return $colinfo->{is_numeric}; } =head2 set_column @@ -784,7 +820,7 @@ sub set_column { $self->{_orig_ident} ||= $self->ident_condition; my $old_value = $self->get_column($column); - $self->store_column($column, $new_value); + $new_value = $self->store_column($column, $new_value); my $dirty; if (!$self->in_storage) { # no point tracking dirtyness on uninserted data @@ -800,18 +836,7 @@ sub set_column { $dirty = 0; } else { # do a numeric comparison if datatype allows it - my $colinfo = $self->column_info ($column); - - # cache for speed (the object may *not* have a resultsource instance) - if (not defined $colinfo->{is_numeric} && $self->_source_handle) { - $colinfo->{is_numeric} = - $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type}) - ? 1 - : 0 - ; - } - - if ($colinfo->{is_numeric}) { + if ($self->_is_column_numeric($column)) { $dirty = $old_value != $new_value; } else { @@ -1330,10 +1355,12 @@ See L. sub throw_exception { my $self=shift; + if (ref $self && ref $self->result_source && $self->result_source->schema) { - $self->result_source->schema->throw_exception(@_); - } else { - croak(@_); + $self->result_source->schema->throw_exception(@_) + } + else { + DBIx::Class::Exception->throw(@_); } }