Use a separate key for caching prefetched filter rels
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Row.pm
index d356218..0781824 100644 (file)
@@ -52,7 +52,7 @@ All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
 object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
 L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
 instances, based on your application's
-L<Result class|DBIx::Class::Manual::Glossary/Result_class>.
+L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
 
 L<DBIx::Class::Row> implements most of the row-based communication with the
 underlying storage, but a Result class B<should not inherit from it directly>.
@@ -480,8 +480,8 @@ sub insert {
 
 Indicates whether the object exists as a row in the database or
 not. This is set to true when L<DBIx::Class::ResultSet/find>,
-L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
-are used.
+L<DBIx::Class::ResultSet/create> or L<DBIx::Class::Row/insert>
+are invoked.
 
 Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
 calling L</delete> on one, sets it to false.
@@ -711,6 +711,26 @@ sub has_column_loaded {
   ) ? 1 : 0;
 }
 
+sub _has_related_resultset_cached {
+  my ($self, $relname) = @_;
+
+  my $accessor = ($self->relationship_info($relname) || {})->{attrs}{accessor} || '';
+
+  return ((
+      $accessor eq 'single'
+        and
+      exists $self->{_relationship_data}{$relname}
+    ) or (
+      $accessor eq 'filter'
+        and
+      exists $self->{_filter_relationship_data}{$relname}
+    ) or (
+      defined $self->{related_resultsets}{$relname}
+        and
+      defined $self->{related_resultsets}{$relname}->get_cache
+    )) ? 1 : 0;
+}
+
 =head2 get_columns
 
   my %data = $result->get_columns;
@@ -744,9 +764,7 @@ sub get_columns {
         ) if (
           ! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
             and
-          defined $self->{related_resultsets}{$col}
-            and
-          defined $self->{related_resultsets}{$col}->get_cache
+          $self->_has_related_resultset_cached($col)
         );
 
         $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
@@ -858,9 +876,7 @@ sub get_inflated_columns {
       if (
         $loaded_colinfo->{$_}{_inflate_info}
           and
-        defined $self->{related_resultsets}{$_}
-          and
-        defined $self->{related_resultsets}{$_}->get_cache
+        $self->_has_related_resultset_cached($_)
       ) {
         carp_unique(
           "Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
@@ -890,7 +906,10 @@ sub get_inflated_columns {
 }
 
 sub _is_column_numeric {
-   my ($self, $column) = @_;
+    my ($self, $column) = @_;
+
+    return undef unless $self->result_source->has_column($column);
+
     my $colinfo = $self->result_source->column_info ($column);
 
     # cache for speed (the object may *not* have a resultsource instance)
@@ -942,9 +961,10 @@ sub set_column {
   my $dirty =
     $self->{_dirty_columns}{$column}
       ||
-    $self->in_storage # no point tracking dirtyness on uninserted data
+    ( $self->in_storage # no point tracking dirtyness on uninserted data
       ? ! $self->_eq_column_values ($column, $old_value, $new_value)
       : 1
+    )
   ;
 
   if ($dirty) {
@@ -968,6 +988,7 @@ sub set_column {
       elsif ( $acc eq 'filter' and $rel_name eq $column) {
         delete $self->{related_resultsets}{$rel_name};
         #delete $self->{_relationship_data}{$rel_name};
+        delete $self->{_filter_relationship_data}{$rel_name};
         delete $self->{_inflated_column}{$rel_name};
       }
     }
@@ -1143,14 +1164,14 @@ is set by default on C<has_many> relationships and unset on all others.
 sub copy {
   my ($self, $changes) = @_;
   $changes ||= {};
-  my $col_data = { %{$self->{_column_data}} };
+  my $col_data = { $self->get_columns };
 
   my $rsrc = $self->result_source;
 
-  my $colinfo = $rsrc->columns_info([ keys %$col_data ]);
+  my $colinfo = $rsrc->columns_info;
   foreach my $col (keys %$col_data) {
     delete $col_data->{$col}
-      if $colinfo->{$col}{is_auto_increment};
+      if ( ! $colinfo->{$col} or $colinfo->{$col}{is_auto_increment} );
   }
 
   my $new = { _column_data => $col_data };
@@ -1176,10 +1197,8 @@ sub copy {
 
     my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
     foreach my $related ($self->search_related($rel_name)->all) {
-      my $id_str = join("\0", $related->id);
-      next if $copied->{$id_str};
-      $copied->{$id_str} = 1;
-      my $rel_copy = $related->copy($resolved);
+      $related->copy($resolved)
+        unless $copied->{$related->ID}++;
     }
 
   }
@@ -1245,8 +1264,9 @@ L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
 sub inflate_result {
   my ($class, $rsrc, $me, $prefetch) = @_;
 
+  # XXX: WTF is $me sometimes undef?
   my $new = bless
-    { _column_data => $me, _result_source => $rsrc },
+    { _column_data => $me || {}, _result_source => $rsrc },
     ref $class || $class
   ;
 
@@ -1271,7 +1291,7 @@ sub inflate_result {
       $class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
         unless $relinfo->{attrs}{accessor};
 
-      my $rel_rs = $new->related_resultset($rel_name);
+      my $rel_rsrc = $rsrc->related_source($rel_name);
 
       my @rel_objects;
       if (
@@ -1281,8 +1301,7 @@ sub inflate_result {
       ) {
 
         if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
-          my $rel_rsrc = $rel_rs->result_source;
-          my $rel_class = $rel_rs->result_class;
+          my $rel_class = $rel_rsrc->result_class;
           my $rel_inflator = $rel_class->can('inflate_result');
           @rel_objects = map
             { $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
@@ -1290,8 +1309,8 @@ sub inflate_result {
           ;
         }
         else {
-          @rel_objects = $rel_rs->result_class->inflate_result(
-            $rel_rs->result_source, @{$prefetch->{$rel_name}}
+          @rel_objects = $rel_rsrc->result_class->inflate_result(
+            $rel_rsrc, @{$prefetch->{$rel_name}}
           );
         }
       }
@@ -1300,10 +1319,12 @@ sub inflate_result {
         $new->{_relationship_data}{$rel_name} = $rel_objects[0];
       }
       elsif ($relinfo->{attrs}{accessor} eq 'filter') {
+        $new->{_filter_relationship_data}{$rel_name} = $rel_objects[0];
         $new->{_inflated_column}{$rel_name} = $rel_objects[0];
       }
-
-      $rel_rs->set_cache(\@rel_objects);
+      else {
+          $new->related_resultset($rel_name)->set_cache(\@rel_objects);
+      }
     }
   }
 
@@ -1323,7 +1344,7 @@ sub inflate_result {
 
 =back
 
-L</Update>s the object if it's already in the database, according to
+L</update>s the object if it's already in the database, according to
 L</in_storage>, else L</insert>s it.
 
 =head2 insert_or_update
@@ -1586,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