From: Matt S Trout Date: Wed, 8 Mar 2006 10:44:50 +0000 (+0000) Subject: partially working has_many prefetch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f66a01b6ce8cf660badd5184aa5bcf2110779bc;p=dbsrgits%2FDBIx-Class-Historic.git partially working has_many prefetch --- diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index a39252a..ba36b7c 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -106,7 +106,10 @@ sub new { if $attrs->{order_by} && !ref($attrs->{order_by}); $attrs->{order_by} ||= []; + my $collapse = {}; + if (my $prefetch = delete $attrs->{prefetch}) { + my @pre_order; foreach my $p (ref $prefetch eq 'ARRAY' ? (@{$prefetch}) : ($prefetch)) { if( ref $p eq 'HASH' ) { @@ -120,11 +123,12 @@ sub new { unless $seen{$p}; } my @prefetch = $source->resolve_prefetch( - $p, $attrs->{alias}, {}, $attrs->{order_by}); + $p, $attrs->{alias}, {}, \@pre_order, $collapse); #die Dumper \@cols; push(@{$attrs->{select}}, map { $_->[0] } @prefetch); push(@{$attrs->{as}}, map { $_->[1] } @prefetch); } + push(@{$attrs->{order_by}}, @pre_order); } if ($attrs->{page}) { @@ -132,11 +136,17 @@ sub new { $attrs->{offset} ||= 0; $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1)); } + +#if (keys %{$collapse}) { +# use Data::Dumper; warn Dumper($collapse); +#} + my $new = { result_source => $source, result_class => $attrs->{result_class} || $source->result_class, cond => $attrs->{where}, from => $attrs->{from}, + collapse => $collapse, count => undef, page => delete $attrs->{page}, pager => undef, @@ -397,10 +407,12 @@ sub next { return $obj; } if ($self->{attrs}{cache}) { - $self->{all_cache_position} = 0; + $self->{all_cache_position} = 1; return ($self->all)[0]; } - my @row = delete $self->{stashed_row} || $self->cursor->next; + my @row = (exists $self->{stashed_row} + ? @{delete $self->{stashed_row}} + : $self->cursor->next); # warn Dumper(\@row); use Data::Dumper; return unless (@row); return $self->_construct_object(@row); @@ -408,33 +420,77 @@ sub next { sub _construct_object { my ($self, @row) = @_; - my @row_orig = @row; # copy @row for key comparison later, because @row will change my @as = @{ $self->{attrs}{as} }; -#use Data::Dumper; warn Dumper \@as; - #warn "@cols -> @row"; - my $info = [ {}, {} ]; - foreach my $as (@as) { - my $rs = $self; - my $target = $info; - my @parts = split(/\./, $as); - my $col = pop(@parts); - foreach my $p (@parts) { - $target = $target->[1]->{$p} ||= []; - - $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache}; - } - - $target->[0]->{$col} = shift @row - if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite - } + + my $info = $self->_collapse_result(\@as, \@row); + #use Data::Dumper; warn Dumper(\@as, $info); my $new = $self->result_class->inflate_result($self->result_source, @$info); + $new = $self->{attrs}{record_filter}->($new) if exists $self->{attrs}{record_filter}; return $new; } +sub _collapse_result { + my ($self, $as, $row, $prefix) = @_; + + my %const; + + my @copy = @$row; + foreach my $as (@$as) { + if (defined $prefix && !($as =~ s/\Q${prefix}\E\.//)) { + shift @copy; + next; + } + $as =~ /^(?:(.*)\.)?([^\.]+)$/; + $const{$1||''}{$2} = shift @copy; + } + + #warn "@cols -> @row"; + my $info = [ {}, {} ]; + foreach my $key (keys %const) { + if (length $key) { + my $target = $info; + my @parts = split(/\./, $key); + foreach my $p (@parts) { + $target = $target->[1]->{$p} ||= []; + } + $target->[0] = $const{$key}; + } else { + $info->[0] = $const{$key}; + } + } + + if (!defined($prefix) && keys %{$self->{collapse}}) { + my ($c) = sort { length $a <=> length $b } keys %{$self->{collapse}}; + #warn "Collapsing ${c}"; + my $target = $info; + #warn Data::Dumper::Dumper($target); + foreach my $p (split(/\./, $c)) { + $target = $target->[1]->{$p}; + } + my @co_key = @{$self->{collapse}{$c}}; + my %co_check = map { ($_, $target->[0]->{$_}); } @co_key; + my $tree = $self->_collapse_result($as, $row, $c); + #warn Data::Dumper::Dumper($target); + my (@final, @raw); + while ( !(grep { $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); + } + @{$target} = @final; + #warn Data::Dumper::Dumper($target); + } + + #warn Dumper($info); + + return $info; +} + =head2 result_source Returns a reference to the result source for this recordset. diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index edeb5b2..5c9d657 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -545,21 +545,23 @@ in the supplied relationships. Examples: =cut sub resolve_prefetch { - my ($self, $pre, $alias, $seen, $order) = @_; + my ($self, $pre, $alias, $seen, $order, $collapse) = @_; $seen ||= {}; use Data::Dumper; #$alias ||= $self->name; #warn $alias, Dumper $pre; if( ref $pre eq 'ARRAY' ) { - return map { $self->resolve_prefetch( $_, $alias, $seen, $order ) } @$pre; + return + map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) } + @$pre; } elsif( ref $pre eq 'HASH' ) { my @ret = map { - $self->resolve_prefetch($_, $alias, $seen, $order), + $self->resolve_prefetch($_, $alias, $seen, $order, $collapse), $self->related_source($_)->resolve_prefetch( - $pre->{$_}, "${alias}.$_", $seen, $order) - } keys %$pre; + $pre->{$_}, "${alias}.$_", $seen, $order, $collapse) + } keys %$pre; #die Dumper \@ret; return @ret; } @@ -575,9 +577,18 @@ sub resolve_prefetch { 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)); + + if (exists $rel_info->{attrs}{accessor} + && $rel_info->{attrs}{accessor} eq 'multi') { + $self->throw_exception( + "Can't prefetch has_many ${pre} (join cond too complex)") + unless ref($rel_info->{cond}) eq 'HASH'; + my @key = map { (/^foreign\.(.*)$/ ? ($1) : ()); } + keys %{$rel_info->{cond}}; + $collapse->{"${as_prefix}${pre}"} = \@key; + push(@$order, map { "${as}.$_" } (@key, @{$rel_info->{order_by}||[]})); + } + return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } $rel_source->columns; #warn $alias, Dumper (\@ret); diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 83502cf..2466753 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -304,7 +304,8 @@ sub inflate_result { my $pre_source = $source->related_source($pre); $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source; - if (ref $pre_val->[0] eq 'ARRAY') { # multi + #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]{$_}