From: Matt S Trout Date: Fri, 11 May 2007 02:51:46 +0000 (+0000) Subject: collapse result refac hopefully complete X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b25e9fa0e642e100b461592dbf52c668377a5a70;p=dbsrgits%2FDBIx-Class-Historic.git collapse result refac hopefully complete --- diff --git a/lib/DBIx/Class/ResultClass/HashRefInflator.pm b/lib/DBIx/Class/ResultClass/HashRefInflator.pm index ca6741e..9a2c8eb 100644 --- a/lib/DBIx/Class/ResultClass/HashRefInflator.pm +++ b/lib/DBIx/Class/ResultClass/HashRefInflator.pm @@ -63,6 +63,16 @@ sub mk_hash { # to avoid emtpy has_many rels contain one empty hashref return if (not keys %$me); + my $def; + + foreach (values %$me) { + if (defined $_) { + $def = 1; + last; + } + } + return unless $def; + return { %$me, map { ( $_ => diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 9367b3c..d2cee9a 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -98,8 +98,8 @@ sub new { $attrs->{alias} ||= 'me'; my $self = { - result_source => $source, - result_class => $attrs->{result_class} || $source->result_class, + _source_handle => $source, + result_class => $attrs->{result_class} || $source->resolve->result_class, cond => $attrs->{where}, count => undef, pager => undef, @@ -782,7 +782,8 @@ sub _collapse_result { if (keys %collapse) { my %pri = map { ($_ => 1) } $self->result_source->primary_columns; foreach my $i (0 .. $#construct_as) { - if (delete $pri{$construct_as[$i]}) { + next if defined($construct_as[$i][0]); # only self table + if (delete $pri{$construct_as[$i][1]}) { push(@pri_index, $i); } last unless keys %pri; # short circuit (Johnny Five Is Alive!) @@ -793,14 +794,18 @@ sub _collapse_result { my %pri_vals = map { ($_ => $copy[$_]) } @pri_index; - my %const; + my @const_rows; do { # no need to check anything at the front, we always want the first row + + my %const; foreach my $this_as (@construct_as) { $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); } + push(@const_rows, \%const); + } until ( # no pri_index => no collapse => drop straight out !@pri_index or @@ -824,17 +829,49 @@ sub _collapse_result { # THIS BIT STILL NEEDS TO DO THE COLLAPSE my $alias = $self->{attrs}{alias}; - my $info = [ {}, {} ]; - foreach my $key (keys %const) { - if (length $key && $key ne $alias) { - my $target = $info; - my @parts = split(/\./, $key); - foreach my $p (@parts) { - $target = $target->[1]->{$p} ||= []; + my $info = []; + + my %collapse_pos; + + my @const_keys; + + use Data::Dumper; + + foreach my $const (@const_rows) { + scalar @const_keys or do { + @const_keys = sort { length($a) <=> length($b) } keys %$const; + }; + foreach my $key (@const_keys) { + if (length $key) { + my $target = $info; + my @parts = split(/\./, $key); + my $cur = ''; + my $data = $const->{$key}; + foreach my $p (@parts) { + $target = $target->[1]->{$p} ||= []; + $cur .= ".${p}"; + if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { + # collapsing at this point and on final part + my $pos = $collapse_pos{$cur}; + CK: foreach my $ck (@ckey) { + if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) { + $collapse_pos{$cur} = $data; + delete @collapse_pos{ # clear all positioning for sub-entries + grep { m/^\Q${cur}.\E/ } keys %collapse_pos + }; + push(@$target, []); + last CK; + } + } + } + if (exists $collapse{$cur}) { + $target = $target->[-1]; + } + } + $target->[0] = $data; + } else { + $info->[0] = $const->{$key}; } - $target->[0] = $const{$key}; - } else { - $info->[0] = $const{$key}; } } diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 4bb6ff6..e4d30e9 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -175,7 +175,7 @@ sub add_columns { return $self; } -*add_column = \&add_columns; +sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB =head2 has_column @@ -286,7 +286,7 @@ sub remove_columns { $self->_ordered_columns(\@remaining); } -*remove_column = \&remove_columns; +sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB =head2 set_primary_key @@ -874,9 +874,13 @@ sub resolve_prefetch { $self->throw_exception( "Can't prefetch has_many ${pre} (join cond too complex)") unless ref($rel_info->{cond}) eq 'HASH'; + #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); } + # values %{$rel_info->{cond}}; + $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ]; + # action at a distance. prepending the '.' allows simpler code + # in ResultSet->_collapse_result my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); } keys %{$rel_info->{cond}}; - $collapse->{"${as_prefix}${pre}"} = \@key; my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' ? @{$rel_info->{attrs}{order_by}} : (defined $rel_info->{attrs}{order_by} @@ -1034,3 +1038,4 @@ You may distribute this code under the same terms as Perl itself. =cut +1; diff --git a/t/76joins.t b/t/76joins.t index b172d29..57a9ffc 100644 --- a/t/76joins.t +++ b/t/76joins.t @@ -408,9 +408,5 @@ sub make_hash_struc { my $prefetch_result = make_hash_struc($art_rs_pr); my $nonpre_result = make_hash_struc($art_rs); -TODO: { - local $TODO = 'fixing collapse in -current'; is_deeply( $prefetch_result, $nonpre_result, 'Compare 2 level prefetch result to non-prefetch result' ); -} - diff --git a/t/83cache.t b/t/83cache.t index 78113b3..63de0d3 100644 --- a/t/83cache.t +++ b/t/83cache.t @@ -12,7 +12,7 @@ $schema->storage->debugcb( sub{ $queries++ } ); eval "use DBD::SQLite"; plan skip_all => 'needs DBD::SQLite for testing' if $@; -plan tests => 22; +plan tests => 23; my $rs = $schema->resultset("Artist")->search( { artistid => 1 } @@ -158,7 +158,15 @@ while( my $tag = $tags->next ) { push @objs, $tag->id; #warn "tag: ", $tag->ID; } -is_deeply( \@objs, [ 2, 5, 8 ], 'second cd has correct tags' ); +is_deeply( \@objs, [ 1 ], 'second cd has correct tags' ); + +$tags = $cds->next->tags; +@objs = (); +while( my $tag = $tags->next ) { + push @objs, $tag->id; #warn "tag: ", $tag->ID; +} + +is_deeply( \@objs, [ 2, 5, 8 ], 'third cd has correct tags' ); is( $queries, 0, 'no additional SQL statements while checking nested data' ); diff --git a/t/90join_torture.t b/t/90join_torture.t index d2fcd97..7c66799 100644 --- a/t/90join_torture.t +++ b/t/90join_torture.t @@ -13,7 +13,7 @@ my @rs1a_results = $schema->resultset("Artist")->search_related('cds', {title => is($rs1a_results[0]->title, 'Forkful of bees', "bare field conditions okay after search related"); my $rs1 = $schema->resultset("Artist")->search({ 'tags.tag' => 'Blue' }, { join => {'cds' => 'tracks'}, prefetch => {'cds' => 'tags'} }); my @artists = $rs1->all; -cmp_ok(@artists, '==', 1, "Two artists returned"); +cmp_ok(@artists, '==', 2, "Two artists returned"); my $rs2 = $rs1->search({ artistid => '1' }, { join => {'cds' => {'cd_to_producer' => 'producer'} } });