From: Matt S Trout Date: Wed, 8 Mar 2006 15:58:52 +0000 (+0000) Subject: has_many prefetch works. no, seriously X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5a5bec6c01bda57e0f09e77b4e36ce84edeb5fa2;p=dbsrgits%2FDBIx-Class-Historic.git has_many prefetch works. no, seriously --- diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index ba36b7c..d994549 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -439,13 +439,18 @@ sub _collapse_result { my %const; my @copy = @$row; - foreach my $as (@$as) { - if (defined $prefix && !($as =~ s/\Q${prefix}\E\.//)) { - shift @copy; - next; + foreach my $this_as (@$as) { + my $val = shift @copy; + if (defined $prefix) { + if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) { + my $remain = $1; + $remain =~ /^(?:(.*)\.)?([^\.]+)$/; + $const{$1||''}{$2} = $val; + } + } else { + $this_as =~ /^(?:(.*)\.)?([^\.]+)$/; + $const{$1||''}{$2} = $val; } - $as =~ /^(?:(.*)\.)?([^\.]+)$/; - $const{$1||''}{$2} = shift @copy; } #warn "@cols -> @row"; @@ -463,27 +468,37 @@ sub _collapse_result { } } - if (!defined($prefix) && keys %{$self->{collapse}}) { - my ($c) = sort { length $a <=> length $b } keys %{$self->{collapse}}; + my @collapse = (defined($prefix) + ? (map { (m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()); } + keys %{$self->{collapse}}) + : keys %{$self->{collapse}}); + if (@collapse) { + my ($c) = sort { length $a <=> length $b } @collapse; #warn "Collapsing ${c}"; my $target = $info; #warn Data::Dumper::Dumper($target); foreach my $p (split(/\./, $c)) { - $target = $target->[1]->{$p}; + $target = $target->[1]->{$p} ||= []; } - my @co_key = @{$self->{collapse}{$c}}; + my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c); + my @co_key = @{$self->{collapse}{$c_prefix}}; my %co_check = map { ($_, $target->[0]->{$_}); } @co_key; - my $tree = $self->_collapse_result($as, $row, $c); - #warn Data::Dumper::Dumper($target); + my $tree = $self->_collapse_result($as, $row, $c_prefix); + #warn Data::Dumper::Dumper($tree, $row); my (@final, @raw); - while ( !(grep { $co_check{$_} ne $tree->[0]->{$_} } @co_key) ) { + while ( !(grep { + !defined($tree->[0]->{$_}) + || $co_check{$_} ne $tree->[0]->{$_} + } @co_key) ) { push(@final, $tree); last unless (@raw = $self->cursor->next); $row = $self->{stashed_row} = \@raw; - $tree = $self->_collapse_result($as, $row, $c); + $tree = $self->_collapse_result($as, $row, $c_prefix); + #warn Data::Dumper::Dumper($tree, $row); } @{$target} = @final; #warn Data::Dumper::Dumper($target); + #warn Data::Dumper::Dumper($info); } #warn Dumper($info); @@ -576,14 +591,29 @@ sub all { my ($self) = @_; return @{ $self->get_cache } if @{ $self->get_cache }; + + my @obj; + + if (keys %{$self->{collapse}}) { + # Using $self->cursor->all is really just an optimisation. + # If we're collapsing has_many prefetches it probably makes + # very little difference, and this is cleaner than hacking + # _construct_object to survive the approach + my @row; + $self->cursor->reset; + while (@row = $self->cursor->next) { + push(@obj, $self->_construct_object(@row)); + } + } else { + @obj = map { $self->_construct_object(@$_); } + $self->cursor->all; + } + if( $self->{attrs}->{cache} ) { - my @obj = map { $self->_construct_object(@$_); } - $self->cursor->all; $self->set_cache( \@obj ); - return @obj; } - return map { $self->_construct_object(@$_); } - $self->cursor->all; + + return @obj; } =head2 reset diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 5c9d657..22cbdf1 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -586,7 +586,12 @@ sub resolve_prefetch { my @key = map { (/^foreign\.(.*)$/ ? ($1) : ()); } keys %{$rel_info->{cond}}; $collapse->{"${as_prefix}${pre}"} = \@key; - push(@$order, map { "${as}.$_" } (@key, @{$rel_info->{order_by}||[]})); + my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' + ? @{$rel_info->{attrs}{order_by}} + : (defined $rel_info->{attrs}{order_by} + ? ($rel_info->{attrs}{order_by}) + : ())); + push(@$order, map { "${as}.$_" } (@key, @ord)); } return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 28cd906..709f312 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -312,12 +312,11 @@ sub inflate_result { my $pre_source = $source->related_source($pre); $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source; - #warn Data::Dumper::Dumper($pre_val)." "; 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) { + and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) { next; } push(@pre_objects, $pre_source->result_class->inflate_result( diff --git a/t/lib/DBICTest/Schema/HelperRels.pm b/t/lib/DBICTest/Schema/HelperRels.pm index 1fb8886..59cd0a3 100644 --- a/t/lib/DBICTest/Schema/HelperRels.pm +++ b/t/lib/DBICTest/Schema/HelperRels.pm @@ -10,7 +10,8 @@ DBICTest::Schema::Artist->has_many(onekeys => 'DBICTest::Schema::OneKey'); DBICTest::Schema::CD->belongs_to('artist', 'DBICTest::Schema::Artist'); DBICTest::Schema::CD->has_many(tracks => 'DBICTest::Schema::Track'); -DBICTest::Schema::CD->has_many(tags => 'DBICTest::Schema::Tag'); +DBICTest::Schema::CD->has_many(tags => 'DBICTest::Schema::Tag', undef, + { order_by => 'tag' }); DBICTest::Schema::CD->has_many(cd_to_producer => 'DBICTest::Schema::CD_to_Producer' => 'cd'); DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes', diff --git a/t/run/23cache.tl b/t/run/23cache.tl index a8cfffe..e654c61 100644 --- a/t/run/23cache.tl +++ b/t/run/23cache.tl @@ -5,16 +5,6 @@ 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 } ); @@ -65,7 +55,7 @@ while (<$trace>) { } $trace->close; unlink 't/var/dbic.trace'; -is($selects, 2, 'only one SQL statement for each cached table'); +is($selects, 1, 'only one SQL statement executed'); # make sure related_resultset is deleted after object is updated $artist->set_column('name', 'New Name'); @@ -88,7 +78,7 @@ $rs = $schema->resultset("Artist")->search( unlink 't/var/dbic.trace' if -e 't/var/dbic.trace'; DBI->trace(1, 't/var/dbic.trace'); -$artist = $rs->first; +$artist = ($rs->all)[0]; # count the SELECTs DBI->trace(0, undef); @@ -100,10 +90,10 @@ while (<$trace>) { } $trace->close; unlink 't/var/dbic.trace'; -is($selects, 3, 'one SQL statement for each cached table with nested prefetch'); +is($selects, 1, 'only one SQL statement executed'); my @objs; -$artist = $rs->find(1); +#$artist = $rs->find(1); unlink 't/var/dbic.trace' if -e 't/var/dbic.trace'; DBI->trace(1, 't/var/dbic.trace'); @@ -111,10 +101,10 @@ DBI->trace(1, 't/var/dbic.trace'); my $cds = $artist->cds; my $tags = $cds->next->tags; while( my $tag = $tags->next ) { - push @objs, $tag->tagid; #warn "tag:", $tag->ID; + push @objs, $tag->tagid; #warn "tag:", $tag->ID, " => ", $tag->tag; } -is_deeply( \@objs, [ 1 ], 'first cd has correct tags' ); +is_deeply( \@objs, [ 3 ], 'first cd has correct tags' ); $tags = $cds->next->tags; @objs = ();