X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=daf5885d399e64cfbc19dcdfbbd4cd7359a4637d;hb=aff5e9c14f7ad7453a4a2a7d04dc4e85fa0d661c;hp=861a54b147984581df2244a9bf32da97777d8a75;hpb=5529838f7afff91467ef2664087999ab222da48d;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 861a54b..daf5885 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -7,9 +7,9 @@ use base qw/DBIx::Class/;
 
 use Scalar::Util 'blessed';
 use List::Util 'first';
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
 use DBIx::Class::Carp;
-use SQL::Abstract 'is_literal_value';
+use SQL::Abstract qw( is_literal_value is_plain_value );
 
 ###
 ### Internal method
@@ -621,7 +621,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(@_)} } : {};
@@ -900,7 +900,7 @@ sub _is_column_numeric {
     if (
       ! defined $colinfo->{is_numeric}
         and
-      my $storage = try { $self->result_source->schema->storage }
+      my $storage = dbic_internal_try { $self->result_source->schema->storage }
     ) {
       $colinfo->{is_numeric} =
         $storage->is_datatype_numeric ($colinfo->{data_type})
@@ -1174,16 +1174,21 @@ sub copy {
 
     next unless $rel_info->{attrs}{cascade_copy};
 
-    my $resolved = $rsrc->_resolve_condition(
-      $rel_info->{cond}, $rel_name, $new, $rel_name
-    );
-
+    my $foreign_vals;
     my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
-    foreach my $related ($self->search_related($rel_name)->all) {
-      $related->copy($resolved)
-        unless $copied->{$related->ID}++;
-    }
 
+    $copied->{$_->ID}++ or $_->copy(
+
+      $foreign_vals ||= $rsrc->_resolve_relationship_condition(
+        infer_values_based_on => {},
+        rel_name => $rel_name,
+        self_result_object => $new,
+
+        self_alias => "\xFE", # irrelevant
+        foreign_alias => "\xFF", # irrelevant,
+      )->{inferred_values}
+
+    ) for $self->search_related($rel_name)->all;
   }
   return $new;
 }
@@ -1215,7 +1220,18 @@ sub store_column {
     unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
   $self->throw_exception( "set_column called for ${column} without value" )
     if @_ < 3;
-  return $self->{_column_data}{$column} = $value;
+
+  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
+  ;
 }
 
 =head2 inflate_result
@@ -1412,11 +1428,10 @@ sub result_source {
 
     # note this is a || not a ||=, the difference is important
     : $_[0]->{_result_source} || do {
-        my $class = ref $_[0];
         $_[0]->can('result_source_instance')
           ? $_[0]->result_source_instance
           : $_[0]->throw_exception(
-            "No result source instance registered for $class, did you forget to call $class->table(...) ?"
+            "No result source instance registered for @{[ ref $_[0] ]}, did you forget to call @{[ ref $_[0] ]}->table(...) ?"
           )
       }
   ;
@@ -1565,8 +1580,12 @@ See L<DBIx::Class::Schema/throw_exception>.
 sub throw_exception {
   my $self=shift;
 
-  if (ref $self && ref $self->result_source ) {
-    $self->result_source->throw_exception(@_)
+  if (
+    ref $self
+      and
+    my $rsrc = dbic_internal_try { $self->result_source_instance }
+  ) {
+    $rsrc->throw_exception(@_)
   }
   else {
     DBIx::Class::Exception->throw(@_);
@@ -1588,13 +1607,16 @@ sub throw_exception {
 Returns the primary key(s) for a row. Can't be called as a class method.
 Actually implemented in L<DBIx::Class::PK>
 
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
 
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
 
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut