Multi-step prefetch (all except _construct_object changes by Will Hawes)

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index bb3d37b..a63b547 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -89,15 +89,28 @@ sub new {
     push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}));
   }
   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
-  foreach my $pre (@{delete $attrs->{prefetch} || []}) {
-    push(@{$attrs->{from}}, $source->resolve_join($pre, $attrs->{alias}))
-      unless $seen{$pre};
-    my @pre = 
-      map { "$pre.$_" }
-      $source->related_source($pre)->columns;
-    push(@{$attrs->{select}}, @pre);
-    push(@{$attrs->{as}}, @pre);
+
+  if (my $prefetch = delete $attrs->{prefetch}) {
+    foreach my $p (ref $prefetch eq 'ARRAY'
+              ? (@{$prefetch}) : ($prefetch)) {
+      if( ref $p eq 'HASH' ) {
+        foreach my $key (keys %$p) {
+          push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+            unless $seen{$key};
+        }
+      }
+      else {
+        push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+            unless $seen{$p};
+      }
+      my @cols = ();
+      push @cols, $source->resolve_prefetch($p, $attrs->{alias});
+      #die Dumper \@cols;
+      push(@{$attrs->{select}}, @cols);
+      push(@{$attrs->{as}}, @cols);
+    }
   }
+
   if ($attrs->{page}) {
     $attrs->{rows} ||= 10;
     $attrs->{offset} ||= 0;
@@ -323,18 +336,21 @@ sub next {
 
 sub _construct_object {
   my ($self, @row) = @_;
-  my @cols = @{ $self->{attrs}{as} };
+  my @as = @{ $self->{attrs}{as} };
   #warn "@cols -> @row";
-  my (%me, %pre);
-  foreach my $col (@cols) {
-    if ($col =~ /([^\.]+)\.([^\.]+)/) {
-      $pre{$1}[0]{$2} = shift @row;
-    } else {
-      $me{$col} = shift @row;
+  my $info = [ {}, {} ];
+  foreach my $as (@as) {
+    my $target = $info;
+    my @parts = split(/\./, $as);
+    my $col = pop(@parts);
+    foreach my $p (@parts) {
+      $target = $target->[1]->{$p} ||= [];
     }
+    $target->[0]->{$col} = shift @row;
   }
+  #use Data::Dumper; warn Dumper(\@as, $info);
   my $new = $self->{source}->result_class->inflate_result(
-              $self->{source}, \%me, \%pre);
+              $self->{source}, @$info);
   $new = $self->{attrs}{record_filter}->($new)
     if exists $self->{attrs}{record_filter};
   return $new;

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 2e5a84c..b4dbfd3 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -407,6 +407,79 @@ sub resolve_condition {
   }
 }
 
+=head2 resolve_prefetch (hashref/arrayref/scalar)
+ 
+Accepts one or more relationships for the current source and returns an
+array of column names for each of those relationships. Column names are
+prefixed relative to the current source, in accordance with where they appear
+in the supplied relationships. Examples:
+
+  my $source = $schema->$resultset('Tag')->source;
+  @columns = $source->resolve_prefetch( { cd => 'artist' } );
+
+  # @columns =
+  #(
+  #  'cd.cdid',
+  #  'cd.artist',
+  #  'cd.title',
+  #  'cd.year',
+  #  'cd.artist.artistid',
+  #  'cd.artist.name'
+  #)
+
+  @columns = $source->resolve_prefetch( qw[/ cd /] );
+
+  # @columns =
+  #(
+  #   'cd.cdid',
+  #   'cd.artist',
+  #   'cd.title',
+  #   'cd.year'
+  #)
+
+  $source = $schema->resultset('CD')->source;
+  @columns = $source->resolve_prefetch( qw[/ artist producer /] );
+
+  # @columns =
+  #(
+  #  'artist.artistid',
+  #  'artist.name',
+  #  'producer.producerid',
+  #  'producer.name'
+  #)  
+  
+=cut
+
+sub resolve_prefetch {
+  my( $self, $pre, $alias ) = @_;
+  use Data::Dumper;
+  #$alias ||= $self->name;
+  #warn $alias, Dumper $pre;
+  if( ref $pre eq 'ARRAY' ) {
+    return map { $self->resolve_prefetch( $_, $alias ) } @$pre;
+  }
+  elsif( ref $pre eq 'HASH' ) {
+    my @ret =
+    map {
+      $self->resolve_prefetch($_, $alias),
+      $self->related_source($_)->resolve_prefetch( $pre->{$_}, $_ )
+    }
+    keys %$pre;
+    #die Dumper \@ret;
+    return @ret;
+  }
+  elsif( ref $pre ) {
+    croak( "don't know how to resolve prefetch reftype " . ref $pre);
+  }
+  else {
+    my $rel_info = $self->relationship_info( $pre );
+    croak( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
+    my $prefix = $alias && $alias ne 'me' ? "$alias.$pre" : $pre;
+    my @ret = map { "$prefix.$_" } $self->related_source($pre)->columns;
+    #warn $alias, Dumper (\@ret);
+    return @ret;
+  }
+}
 
 =head2 related_source($relname)
 

diff --git a/t/lib/DBICTest/Schema/BasicRels.pm b/t/lib/DBICTest/Schema/BasicRels.pm
index a3e7279..551d8b9 100644 (file)
--- a/t/lib/DBICTest/Schema/BasicRels.pm
+++ b/t/lib/DBICTest/Schema/BasicRels.pm
@@ -71,7 +71,8 @@ DBICTest::Schema::SelfRef->add_relationship(
 
 DBICTest::Schema::Tag->add_relationship(
     cd => 'DBICTest::Schema::CD',
-    { 'foreign.cdid' => 'self.cd' }
+    { 'foreign.cdid' => 'self.cd' },
+    { accessor => 'single' }
 );
 
 DBICTest::Schema::Track->add_relationship(

diff --git a/t/run/16joins.tl b/t/run/16joins.tl
index 939ae34..0f59ab7 100644 (file)
--- a/t/run/16joins.tl
+++ b/t/run/16joins.tl
@@ -7,7 +7,7 @@ BEGIN {
     eval "use DBD::SQLite";
     plan $@
         ? ( skip_all => 'needs DBD::SQLite for testing' )
-        : ( tests => 23 );
+        : ( tests => 27 );
 }
 
 # test the abstract join => SQL generator
@@ -121,7 +121,7 @@ is(ref $cd[1]->liner_notes, 'DBICTest::LinerNotes', 'Prefetch returns correct cl
 is($cd[2]->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'Prefetch on parent object ok');
 
 # count the SELECTs
-DBI->trace(0);
+DBI->trace(0, undef);
 my $selects = 0;
 my $trace = IO::File->new('t/var/dbic.trace', '<') 
     or die "Unable to read trace file";
@@ -132,6 +132,45 @@ $trace->close;
 unlink 't/var/dbic.trace';
 is($selects, 1, 'prefetch ran only 1 select statement');
 
+# start test for nested prefetch SELECT count
+unlink 't/var/dbic.trace' if -e 't/var/dbic.trace';
+DBI->trace(1, 't/var/dbic.trace');
+
+$rs = $schema->resultset('Tag')->search(
+  {},
+  {
+    prefetch => { cd => 'artist' }
+  }
+);
+
+my $tag = $rs->first;
+
+is( $tag->cd->title, 'Spoonful of bees', 'step 1 ok for nested prefetch' );
+
+is( $tag->cd->artist->name, 'Caterwauler McCrae', 'step 2 ok for nested prefetch');
+
+# count the SELECTs
+DBI->trace(0, undef);
+my $selects = 0;
+my $trace = IO::File->new('t/var/dbic.trace', '<') 
+    or die "Unable to read trace file";
+while (<$trace>) {
+    $selects++ if /SELECT(?!.*WHERE 1=0.*)/;
+}
+$trace->close;
+unlink 't/var/dbic.trace';
+is($selects, 1, 'nested prefetch ran exactly 1 select statement (excluding column_info)');
+
+$rs = $schema->resultset('Tag')->search(
+  {},
+  {
+    join => { cd => 'artist' },
+    prefetch => { cd => 'artist' }
+  }
+);
+
+cmp_ok( $rs->count, '>=', 0, 'nested prefetch does not duplicate joins' );
+
 my ($artist) = $schema->resultset("Artist")->search({ 'cds.year' => 2001 },
                  { order_by => 'artistid DESC', join => 'cds' });