From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 1 Mar 2006 03:41:37 +0000 (+0000)
Subject: half unpicked has_many prefetch mess
X-Git-Tag: v0.06000~60^2~70
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a86b1efe3def648c717752f383c32f346225008b;p=dbsrgits%2FDBIx-Class.git

half unpicked has_many prefetch mess
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 69ff26d..8e61243 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -102,6 +102,10 @@ sub new {
   }
   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
 
+  $attrs->{order_by} = [ $attrs->{order_by} ]
+    if $attrs->{order_by} && !ref($attrs->{order_by});
+  $attrs->{order_by} ||= [];
+
   if (my $prefetch = delete $attrs->{prefetch}) {
     foreach my $p (ref $prefetch eq 'ARRAY'
               ? (@{$prefetch}) : ($prefetch)) {
@@ -115,7 +119,8 @@ sub new {
         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
             unless $seen{$p};
       }
-      my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
+      my @prefetch = $source->resolve_prefetch(
+           $p, $attrs->{alias}, {}, $attrs->{order_by});
       #die Dumper \@cols;
       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
@@ -394,7 +399,7 @@ sub next {
     $self->{all_cache_position} = 0;
     return ($self->all)[0];
   }
-  my @row = $self->cursor->next;
+  my @row = delete $self->{stashed_row} || $self->cursor->next;
 #  warn Dumper(\@row); use Data::Dumper;
   return unless (@row);
   return $self->_construct_object(@row);
@@ -427,54 +432,8 @@ sub _construct_object {
   $new = $self->{attrs}{record_filter}->($new)
     if exists $self->{attrs}{record_filter};
  
-  if( $self->{attrs}->{cache} ) {
-    while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
-      $rs->all;
-      #warn "$rel:", @{$rs->get_cache};
-    }
-    $self->build_rr( $self, $new );
-  }
- 
   return $new;
 }
-  
-sub build_rr {
-  # build related resultsets for supplied object
-  my ( $self, $context, $obj ) = @_;
-  
-  my $re = qr/^\w+\./;
-  while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {  
-    #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
-    my @objs = ();
-    my $map = {};
-    my $cond = $context->result_source->relationship_info($rel)->{cond};
-    keys %$cond;
-    while( my( $rel_key, $pk ) = each(%$cond) ) {
-      $rel_key =~ s/$re//;
-      $pk =~ s/$re//;
-      $map->{$rel_key} = $pk;
-    }
-    
-    $rs->reset();
-    while( my $rel_obj = $rs->next ) {
-      while( my( $rel_key, $pk ) = each(%$map) ) {
-        if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
-          push @objs, $rel_obj;
-        }
-      }
-    }
-
-    my $rel_rs = $obj->related_resultset($rel);
-    $rel_rs->{attrs}->{cache} = 1;
-    $rel_rs->set_cache( \@objs );
-    
-    while( my $rel_obj = $rel_rs->next ) {
-      $self->build_rr( $rs, $rel_obj );
-    }
-    
-  }
-  
-}
 
 =head2 result_source
 
@@ -913,13 +872,12 @@ sub related_resultset {
       "search_related: result source '" . $self->result_source->name .
       "' has no such relationship ${rel}")
       unless $rel_obj; #die Dumper $self->{attrs};
-    my $rs;
-    if( $self->{attrs}->{cache} ) {
-      $rs = $self->search(undef);
-    }
-    else {
-      $rs = $self->search(undef, { join => $rel });
-    }
+    my $rs = $self->search(undef, { join => $rel });
+    #if( $self->{attrs}->{cache} ) {
+    #  $rs = $self->search(undef);
+    #}
+    #else {
+    #}
     #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
     #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
     my $alias = (defined $rs->{attrs}{seen_join}{$rel}
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 343c019..8b3863f 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -545,35 +545,41 @@ in the supplied relationships. Examples:
 =cut
 
 sub resolve_prefetch {
-  my ($self, $pre, $alias, $seen) = @_;
+  my ($self, $pre, $alias, $seen, $order) = @_;
   $seen ||= {};
   use Data::Dumper;
   #$alias ||= $self->name;
   #warn $alias, Dumper $pre;
   if( ref $pre eq 'ARRAY' ) {
-    return map { $self->resolve_prefetch( $_, $alias, $seen ) } @$pre;
+    return map { $self->resolve_prefetch( $_, $alias, $seen, $order ) } @$pre;
   }
   elsif( ref $pre eq 'HASH' ) {
     my @ret =
     map {
-      $self->resolve_prefetch($_, $alias, $seen),
+      $self->resolve_prefetch($_, $alias, $seen, $order),
       $self->related_source($_)->resolve_prefetch(
-                                   $pre->{$_}, "${alias}.$_", $seen)
+                                   $pre->{$_}, "${alias}.$_", $seen, $order)
         } keys %$pre;
     #die Dumper \@ret;
     return @ret;
   }
   elsif( ref $pre ) {
-    $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
+    $self->throw_exception(
+      "don't know how to resolve prefetch reftype ".ref($pre));
   }
   else {
     my $count = ++$seen->{$pre};
     my $as = ($count > 1 ? "${pre}_${count}" : $pre);
     my $rel_info = $self->relationship_info( $pre );
-    $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
+    $self->throw_exception( $self->name . " has no such relationship '$pre'" )
+      unless $rel_info;
     my $as_prefix = ($alias =~ /^.*?\.(.*)$/ ? $1.'.' : '');
+    my $rel_source = $self->related_source($pre);
+    push(@$order,
+      map { "${as}.$_" }
+        (@{$rel_info->{order_by}||[]}, $rel_source->primary_columns));
     return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
-      $self->related_source($pre)->columns;
+      $rel_source->columns;
     #warn $alias, Dumper (\@ret);
     #return @ret;
   }
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index df8bba8..33c8d19 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -298,25 +298,37 @@ sub inflate_result {
   foreach my $pre (keys %{$prefetch||{}}) {
     my $pre_val = $prefetch->{$pre};
     my $pre_source = $source->related_source($pre);
-    $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source;
-    my $fetched;
-    unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_} 
-       and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
-    {
-      $fetched = $pre_source->result_class->inflate_result(
-                    $pre_source, @{$prefetch->{$pre}});      
-    }
-    my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
-    $class->throw_exception("No accessor for prefetched $pre")
-     unless defined $accessor;
-    if ($accessor eq 'single') {
-      $new->{_relationship_data}{$pre} = $fetched;
-    } elsif ($accessor eq 'filter') {
-     $new->{_inflated_column}{$pre} = $fetched;
-    } elsif ($accessor eq 'multi') {
-      
+    $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
+      unless $pre_source;
+    if (ref $pre_val->[0] eq 'ARRAY') { # multi
+      my @pre_objects;
+      foreach my $pre_rec (@$pre_val) {
+        unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_} 
+           and !defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
+          next;
+        }
+        push(@pre_objects, $pre_source->result_class->inflate_result(
+                             $pre_source, @{$pre_rec}));
+      }
+      $new->related_resultset($pre)->set_cache(\@pre_objects);
     } else {
-     $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+      my $fetched;
+      unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_} 
+         and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
+      {
+        $fetched = $pre_source->result_class->inflate_result(
+                      $pre_source, @{$pre_val});      
+      }
+      my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
+      $class->throw_exception("No accessor for prefetched $pre")
+       unless defined $accessor;
+      if ($accessor eq 'single') {
+        $new->{_relationship_data}{$pre} = $fetched;
+      } elsif ($accessor eq 'filter') {
+        $new->{_inflated_column}{$pre} = $fetched;
+      } else {
+       $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+      }
     }
   }
   return $new;
diff --git a/t/run/23cache.tl b/t/run/23cache.tl
index f0c80ac..a8cfffe 100644
--- a/t/run/23cache.tl
+++ b/t/run/23cache.tl
@@ -5,6 +5,16 @@ eval "use DBD::SQLite";
 plan skip_all => 'needs DBD::SQLite for testing' if $@;
 plan tests => 12;
 
+warn "
+This test WILL fail. That's because the has_many prefetch code is
+only half re-written. However, it was utterly borken before, so
+this is arguably an improvement. If you fancy having a go at making
+_construct_object in resultset collapse multiple results into
+appropriate nested structures for inflate_result, be my guest.
+     -- mst
+
+";
+
 my $rs = $schema->resultset("Artist")->search(
   { artistid => 1 }
 );
@@ -18,7 +28,6 @@ $rs = $schema->resultset("Artist")->search(
   {
     join => [ qw/ cds /],
     prefetch => [qw/ cds /],
-    cache => 1,
   }
 );
 
@@ -72,7 +81,6 @@ $rs = $schema->resultset("Artist")->search(
     prefetch => {
       cds => 'tags'
     },
-    cache => 1
   }
 );