X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=b0542cb04185692a6358da6c51ee5c1d26cda330;hb=b83736a7d3235d2f50fe5695550eb3637432d960;hp=c8b57b696c61c9764343541852239f487d13b5b4;hpb=87b1255103d7b8873b225416cb381c50011f4c06;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index c8b57b6..b0542cb 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -6,7 +6,7 @@ use warnings; use base qw/DBIx::Class/; use Scalar::Util 'blessed'; -use DBIx::Class::_Util 'dbic_internal_try'; +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 ); @@ -196,7 +196,7 @@ sub new { @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = (); } - my ($related,$inflated); + my( $related, $inflated, $colinfos ); foreach my $key (keys %$attrs) { if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) { @@ -258,9 +258,8 @@ sub new { next; } elsif ( - $rsrc->has_column($key) - and - $rsrc->column_info($key)->{_inflate_info} + ( $colinfos ||= $rsrc->columns_info ) + ->{$key}{_inflate_info} ) { $inflated->{$key} = $attrs->{$key}; next; @@ -343,7 +342,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; @@ -372,8 +371,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) ) { @@ -418,7 +416,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->{$_}" + ) ); } @@ -550,7 +555,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) { @@ -612,7 +617,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 ); @@ -891,15 +896,18 @@ sub get_inflated_columns { sub _is_column_numeric { my ($self, $column) = @_; - return undef unless $self->result_source->has_column($column); + my $rsrc; - my $colinfo = $self->result_source->column_info ($column); + return undef + unless ( $rsrc = $self->result_source )->has_column($column); + + my $colinfo = $rsrc->columns_info->{$column}; # cache for speed (the object may *not* have a resultsource instance) if ( ! defined $colinfo->{is_numeric} and - my $storage = dbic_internal_try { $self->result_source->schema->storage } + my $storage = dbic_internal_try { $rsrc->schema->storage } ) { $colinfo->{is_numeric} = $storage->is_datatype_numeric ($colinfo->{data_type}) @@ -1090,7 +1098,9 @@ See also L. sub set_inflated_columns { my ( $self, $upd ) = @_; - my $rsrc; + + my ($rsrc, $colinfos); + foreach my $key (keys %$upd) { if (ref $upd->{$key}) { $rsrc ||= $self->result_source; @@ -1108,9 +1118,11 @@ sub set_inflated_columns { ); } elsif ( - $rsrc->has_column($key) - and - exists $rsrc->column_info($key)->{_inflate_info} + exists( ( + ( $colinfos ||= $rsrc->columns_info )->{$key} + || + {} + )->{_inflate_info} ) ) { $self->set_inflated_column($key, delete $upd->{$key}); } @@ -1190,7 +1202,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; } @@ -1223,17 +1235,13 @@ sub store_column { $self->throw_exception( "set_column called for ${column} without value" ) if @_ < 3; - return $self->{_column_data}{$column} = $value - unless length ref $value and my $vref = is_plain_value( $value ); - - # if we are dealing with a value/ref - there are a couple possibilities - # unpack the underlying piece of data and stringify all objects explicitly - # ( to accomodate { -value => ... } and guard against overloaded objects - # with defined stringification AND fallback => 0 (ugh!) - $self->{_column_data}{$column} = defined blessed $$vref - ? "$$vref" - : $$vref - ; + my $vref; + $self->{_column_data}{$column} = ( + # unpack potential { -value => "foo" } + ( length ref $value and $vref = is_plain_value( $value ) ) + ? $$vref + : $value + ); } =head2 inflate_result @@ -1354,7 +1362,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; @@ -1422,21 +1433,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 @@ -1583,9 +1587,9 @@ sub throw_exception { my $self=shift; if ( - ref $self + ! DBIx::Class::_Util::in_internal_try and - my $rsrc = dbic_internal_try { $self->result_source_instance } + my $rsrc = dbic_internal_try { $self->result_source } ) { $rsrc->throw_exception(@_) }