X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=7d81682efec2446323672c2c6872b375d015b559;hb=da0dd7dc8c18f051d39733703d3790af65c9842e;hp=310e10e65ea459a86ba0c881900a2c0088d5d8d7;hpb=a614f1d20e6e020bb7b58bc77f1c8efb9cf43a2b;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 310e10e..7d81682 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -6,7 +6,9 @@ use warnings; use base qw/DBIx::Class/; use DBIx::Class::Exception; -use Scalar::Util (); +use Scalar::Util 'blessed'; +use Try::Tiny; +use namespace::clean; ### ### Internal method @@ -133,7 +135,10 @@ sub __new_related_find_or_new_helper { } else { my $us = $rsrc->source_name; - $self->throw_exception ("'$us' neither depends nor is depended on by '$relname', something is wrong..."); + $self->throw_exception ( + "Unable to determine relationship '$relname' direction from '$us', " + . "possibly due to a missing reverse-relationship on '$relname' to '$us'." + ); } } @@ -188,7 +193,7 @@ sub new { my $acc_type = $info->{attrs}{accessor} || ''; if ($acc_type eq 'single') { my $rel_obj = delete $attrs->{$key}; - if(!Scalar::Util::blessed($rel_obj)) { + if(!blessed $rel_obj) { $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); } @@ -208,7 +213,7 @@ sub new { my @objects; foreach my $idx (0 .. $#$others) { my $rel_obj = $others->[$idx]; - if(!Scalar::Util::blessed($rel_obj)) { + if(!blessed $rel_obj) { $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); } @@ -226,7 +231,7 @@ sub new { elsif ($acc_type eq 'filter') { ## 'filter' should disappear and get merged in with 'single' above! my $rel_obj = delete $attrs->{$key}; - if(!Scalar::Util::blessed($rel_obj)) { + if(!blessed $rel_obj) { $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); } if ($rel_obj->in_storage) { @@ -302,8 +307,7 @@ sub insert { 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 unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row')); next unless $source->_pk_depends_on( $relname, { $rel_obj->get_columns } @@ -363,7 +367,7 @@ sub insert { my $updated_cols = $source->storage->insert( $source, { $self->get_columns }, - (keys %auto_pri) && $source->storage->_supports_insert_returning + (keys %auto_pri) && $source->storage->_use_insert_returning ? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] } : () , @@ -397,25 +401,18 @@ sub insert { : $related_stuff{$relname} ; - if (@cands - && Scalar::Util::blessed($cands[0]) - && $cands[0]->isa('DBIx::Class::Row') + if (@cands && 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)) { 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 - ->create($them); - %{$obj} = %{$re}; - MULTICREATE_DEBUG and warn "MC $self new $relname $obj"; + } + else { + MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj"; + $obj->insert; } } else { MULTICREATE_DEBUG and warn "MC $self post-inserting $obj"; @@ -427,6 +424,7 @@ sub insert { $self->in_storage(1); delete $self->{_orig_ident}; + delete $self->{_orig_ident_failreason}; delete $self->{_ignore_at_insert}; $rollback_guard->commit if $rollback_guard; @@ -527,7 +525,7 @@ sub update { $self->throw_exception( "Not in database" ) unless $self->in_storage; - $self->throw_exception('Unable to update a row with incomplete or no identity') + $self->throw_exception($self->{_orig_ident_failreason}) if ! keys %$ident_cond; my $rows = $self->result_source->storage->update( @@ -593,14 +591,14 @@ sub delete { $self->throw_exception( "Not in database" ) unless $self->in_storage; my $ident_cond = $self->{_orig_ident} || $self->ident_condition; - $self->throw_exception('Unable to delete a row with incomplete or no identity') + $self->throw_exception($self->{_orig_ident_failreason}) if ! keys %$ident_cond; $self->result_source->storage->delete( $self->result_source, $ident_cond ); - delete $self->{_orig_ident}; + delete $self->{_orig_ident}; # no longer identifiable $self->in_storage(undef); } else { @@ -825,7 +823,7 @@ sub _is_column_numeric { 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) { + if (! defined $colinfo->{is_numeric} && $self->_source_handle) { $colinfo->{is_numeric} = $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type}) ? 1 @@ -862,7 +860,16 @@ sub set_column { my ($self, $column, $new_value) = @_; # if we can't get an ident condition on first try - mark the object as unidentifiable - $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {}; + # (by using an empty hashref) and store the error for further diag + unless ($self->{_orig_ident}) { + try { + $self->{_orig_ident} = $self->ident_condition + } + catch { + $self->{_orig_ident_failreason} = $_; + $self->{_orig_ident} = {}; + }; + } my $old_value = $self->get_column($column); $new_value = $self->store_column($column, $new_value); @@ -1119,7 +1126,7 @@ sub inflate_result { if ($source->isa('DBIx::Class::ResultSourceHandle')) { $source = $source_handle->resolve - } + } else { $source_handle = $source->handle } @@ -1358,26 +1365,42 @@ sub get_from_storage { my $ident_cond = $self->{_orig_ident} || $self->ident_condition; - $self->throw_exception('Unable to requery a row with incomplete or no identity') + $self->throw_exception($self->{_orig_ident_failreason}) if ! keys %$ident_cond; return $resultset->find($ident_cond); } -=head2 discard_changes ($attrs) +=head2 discard_changes ($attrs?) + + $row->discard_changes + +=over + +=item Arguments: none or $attrs + +=item Returns: self (updates object in-place) + +=back Re-selects the row from the database, losing any changes that had -been made. Throws an exception if a proper WHERE clause identifying +been made. Throws an exception if a proper C clause identifying the database row can not be constructed (i.e. if the original object does not contain its entire -L -). +L). This method can also be used to refresh from storage, retrieving any changes made since the row was last read from storage. -$attrs is expected to be a hashref of attributes suitable for passing as the -second argument to $resultset->search($cond, $attrs); +$attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the +second argument to C<< $resultset->search($cond, $attrs) >>; + +Note: If you are using L as your +storage, please kept in mind that if you L on a row that you +just updated or created, you should wrap the entire bit inside a transaction. +Otherwise you run the risk that you insert or update to the master database +but read from a replicant database that has not yet been updated from the +master. This will result in unexpected results. =cut @@ -1438,34 +1461,6 @@ sub throw_exception { Returns the primary key(s) for a row. Can't be called as a class method. Actually implemented in L -=head2 discard_changes - - $row->discard_changes - -=over - -=item Arguments: none - -=item Returns: nothing (updates object in-place) - -=back - -Retrieves and sets the row object data from the database, losing any -local changes made. - -This method can also be used to refresh from storage, retrieving any -changes made since the row was last read from storage. Actually -implemented in L - -Note: If you are using L as your -storage, please kept in mind that if you L on a row that you -just updated or created, you should wrap the entire bit inside a transaction. -Otherwise you run the risk that you insert or update to the master database -but read from a replicant database that has not yet been updated from the -master. This will result in unexpected results. - -=cut - 1; =head1 AUTHORS @@ -1477,3 +1472,5 @@ Matt S. Trout You may distribute this code under the same terms as Perl itself. =cut + +1;