X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=6d1b341012632c34c7634ffee58e493ad5f42d32;hb=f064a2abb15858bb39a141ad50391d4191988d2c;hp=5425fd80ce7fb5144113d96a7aabc6d7f42740ce;hpb=b70a4bb5fb07064a3a3255d0647d768f6c219061;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 5425fd8..6d1b341 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -6,8 +6,7 @@ use warnings; use base qw/DBIx::Class/; use Scalar::Util 'blessed'; -use List::Util 'first'; -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try fail_on_internal_call ); use DBIx::Class::Carp; use SQL::Abstract qw( is_literal_value is_plain_value ); @@ -344,7 +343,7 @@ sub insert { $self->throw_exception("No result_source set on this object; can't insert") unless $rsrc; - my $storage = $rsrc->storage; + my $storage = $rsrc->schema->storage; my $rollback_guard; @@ -373,8 +372,7 @@ sub insert { my $existing; # if there are no keys - nothing to search for - if (keys %$them and $existing = $self->result_source - ->related_source($rel_name) + if (keys %$them and $existing = $rsrc->related_source($rel_name) ->resultset ->find($them) ) { @@ -419,7 +417,14 @@ sub insert { or (defined $current_rowdata{$_} xor defined $returned_cols->{$_}) or - (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_}) + ( + defined $current_rowdata{$_} + and + # one of the few spots doing forced-stringification + # needed to work around objects with defined stringification + # but *without* overloaded comparison (ugh!) + "$current_rowdata{$_}" ne "$returned_cols->{$_}" + ) ); } @@ -551,7 +556,7 @@ sub update { $self->throw_exception( "Not in database" ) unless $self->in_storage; - my $rows = $self->result_source->storage->update( + my $rows = $self->result_source->schema->storage->update( $self->result_source, \%to_update, $self->_storage_ident_condition ); if ($rows == 0) { @@ -613,7 +618,7 @@ sub delete { if (ref $self) { $self->throw_exception( "Not in database" ) unless $self->in_storage; - $self->result_source->storage->delete( + $self->result_source->schema->storage->delete( $self->result_source, $self->_storage_ident_condition ); @@ -621,7 +626,7 @@ sub delete { $self->in_storage(0); } else { - my $rsrc = try { $self->result_source_instance } + my $rsrc = dbic_internal_try { $self->result_source_instance } or $self->throw_exception("Can't do class delete without a ResultSource instance"); my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {}; @@ -892,15 +897,18 @@ sub get_inflated_columns { sub _is_column_numeric { my ($self, $column) = @_; - return undef unless $self->result_source->has_column($column); + my $rsrc; + + return undef + unless ( $rsrc = $self->result_source )->has_column($column); - my $colinfo = $self->result_source->column_info ($column); + my $colinfo = $rsrc->column_info ($column); # cache for speed (the object may *not* have a resultsource instance) if ( ! defined $colinfo->{is_numeric} and - my $storage = try { $self->result_source->schema->storage } + my $storage = dbic_internal_try { $rsrc->schema->storage } ) { $colinfo->{is_numeric} = $storage->is_datatype_numeric ($colinfo->{data_type}) @@ -1026,7 +1034,10 @@ sub _eq_column_values { # value tracked between column changes and commitment to storage sub _track_storage_value { my ($self, $col) = @_; - return defined first { $col eq $_ } ($self->result_source->primary_columns); + return scalar grep + { $col eq $_ } + $self->result_source->primary_columns + ; } =head2 set_columns @@ -1188,7 +1199,7 @@ sub copy { foreign_alias => "\xFF", # irrelevant, )->{inferred_values} - ) for $self->search_related($rel_name)->all; + ) for $self->related_resultset($rel_name)->all; } return $new; } @@ -1221,12 +1232,13 @@ sub store_column { $self->throw_exception( "set_column called for ${column} without value" ) if @_ < 3; - # stringify all refs explicitly, guards against overloaded objects - # with defined stringification AND fallback => 0 (ugh!) - $self->{_column_data}{$column} = ( length ref $value and is_plain_value( $value ) ) - ? "$value" - : $value - ; + my $vref; + $self->{_column_data}{$column} = ( + # unpack potential { -value => "foo" } + ( length ref $value and $vref = is_plain_value( $value ) ) + ? $$vref + : $value + ); } =head2 inflate_result @@ -1347,7 +1359,10 @@ Alias for L =cut -sub insert_or_update { shift->update_or_insert(@_) } +sub insert_or_update { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->update_or_insert(@_); +} sub update_or_insert { my $self = shift; @@ -1415,21 +1430,14 @@ Accessor to the L this object was created from. =cut sub result_source { - $_[0]->throw_exception( 'result_source can be called on instances only' ) - unless ref $_[0]; - - @_ > 1 - ? $_[0]->{_result_source} = $_[1] - - # note this is a || not a ||=, the difference is important - : $_[0]->{_result_source} || do { - $_[0]->can('result_source_instance') - ? $_[0]->result_source_instance - : $_[0]->throw_exception( - "No result source instance registered for @{[ ref $_[0] ]}, did you forget to call @{[ ref $_[0] ]}->table(...) ?" - ) - } - ; + # this is essentially a `shift->result_source_instance(@_)` with handholding + &{ + $_[0]->can('result_source_instance') + || + $_[0]->throw_exception( + "No result source instance registered for '@{[ $_[0] ]}', did you forget to call @{[ ref $_[0] || $_[0] ]}->table(...) ?" + ) + }; } =head2 register_column @@ -1575,7 +1583,11 @@ See L. sub throw_exception { my $self=shift; - if (ref $self && ref (my $rsrc = try { $self->result_source_instance } ) ) { + if ( + ! DBIx::Class::_Util::in_internal_try + and + my $rsrc = dbic_internal_try { $self->result_source } + ) { $rsrc->throw_exception(@_) } else {