[Bast-commits] r7361 -
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class
mo at dev.catalyst.perl.org
mo at dev.catalyst.perl.org
Fri Aug 21 12:19:42 GMT 2009
Author: mo
Date: 2009-08-21 12:19:41 +0000 (Fri, 21 Aug 2009)
New Revision: 7361
Modified:
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm
Log:
rewrite of _collapse_result to support prefetch of multiple has_many rels on the same level
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm 2009-08-21 12:19:07 UTC (rev 7360)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm 2009-08-21 12:19:41 UTC (rev 7361)
@@ -966,140 +966,107 @@
return @new;
}
-sub _collapse_result {
- my ($self, $as_proto, $row) = @_;
+sub _unflatten_result {
+ my ( $self, $row ) = @_;
- # if the first row that ever came in is totally empty - this means we got
- # hit by a smooth^Wempty left-joined resultset. Just noop in that case
- # instead of producing a {}
- #
- my $has_def;
- for (@$row) {
- if (defined $_) {
- $has_def++;
- last;
+ my $columns = {};
+ my $rels = {};
+
+ foreach my $column ( sort keys %$row ) {
+ if ( $column =~ /^(.*?)\.(.*)$/ ) {
+ $rels->{$1} ||= {};
+ $rels->{$1}->{$2} = $row->{$column};
+ }
+ else {
+ $columns->{$column} = $row->{$column};
+ }
}
- }
- return undef unless $has_def;
- my @copy = @$row;
-
- # 'foo' => [ undef, 'foo' ]
- # 'foo.bar' => [ 'foo', 'bar' ]
- # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
-
- my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
-
- my %collapse = %{$self->{_attrs}{collapse}||{}};
-
- my @pri_index;
-
- # if we're doing collapsing (has_many prefetch) we need to grab records
- # until the PK changes, so fill @pri_index. if not, we leave it empty so
- # we know we don't have to bother.
-
- # the reason for not using the collapse stuff directly is because if you
- # had for e.g. two artists in a row with no cds, the collapse info for
- # both would be NULL (undef) so you'd lose the second artist
-
- # store just the index so we can check the array positions from the row
- # without having to contruct the full hash
-
- if (keys %collapse) {
- my %pri = map { ($_ => 1) } $self->result_source->primary_columns;
- foreach my $i (0 .. $#construct_as) {
- 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!)
+ foreach my $rel ( sort keys %$rels ) {
+ my $rel_info = $self->result_source->relationship_info($rel);
+ $rels->{$rel} =
+ $self->related_resultset($rel)->_unflatten_result( $rels->{$rel} );
+ $rels->{$rel} = [ $rels->{$rel} ]
+ if ( $rel_info->{attrs}->{accessor} eq 'multi' );
}
- }
- # no need to do an if, it'll be empty if @pri_index is empty anyway
+ return keys %$rels ? [ $columns, $rels ] : [$columns];
+}
- my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
-
- 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);
+sub _collapse_result {
+ my ( $self, $as_proto, $row_ref ) = @_;
+ my $has_def;
+ for (@$row_ref) {
+ if ( defined $_ ) {
+ $has_def++;
+ last;
+ }
}
+ return undef unless $has_def;
- push(@const_rows, \%const);
+ my $collapse = keys %{ $self->{_attrs}{collapse} || {} };
+ my $rows = [];
+ my @row = @$row_ref;
+ do {
+ my $i = 0;
+ my $row = { map { $_ => $row[ $i++ ] } @$as_proto };
+ $row = $self->_unflatten_result($row);
+ unless ( scalar @$rows ) {
+ push( @$rows, $row );
+ }
+ $collapse = undef unless ( $self->_merge_result( $rows, $row ) );
+ } while (
+ $collapse
+ && do { @row = $self->cursor->next; $self->{stashed_row} = \@row if @row; }
+ );
- } until ( # no pri_index => no collapse => drop straight out
- !@pri_index
- or
- do { # get another row, stash it, drop out if different PK
+ #use Data::Dumper; $Data::Dumper::Indent = 1; warn Dumper $rows->[0];
- @copy = $self->cursor->next;
- $self->{stashed_row} = \@copy;
+ return $rows->[0];
- # last thing in do block, counts as true if anything doesn't match
+}
- # check xor defined first for NULL vs. NOT NULL then if one is
- # defined the other must be so check string equality
+sub _merge_result {
+ my ( $self, $rows, $row ) = @_;
- grep {
- (defined $pri_vals{$_} ^ defined $copy[$_])
- || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
- } @pri_index;
- }
- );
-
- my $alias = $self->{attrs}{alias};
- my $info = [];
-
- my %collapse_pos;
-
- my @const_keys;
-
- 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;
- }
+ my ( $columns, $rels ) = @$row;
+ my $found = undef;
+ foreach my $seen (@$rows) {
+ my $match = 1;
+ foreach my $column ( keys %$columns ) {
+ if ( defined $columns->{$column}
+ && $seen->[0]->{$column} ne $columns->{$column} )
+ {
+ $match = 0;
+ last;
}
- }
- if (exists $collapse{$cur}) {
- $target = $target->[-1];
- }
}
- $target->[0] = $data;
- } else {
- $info->[0] = $const->{$key};
- }
+ if ($match) {
+ $found = $seen;
+ last;
+ }
}
- }
+ if ($found) {
+ foreach my $rel ( keys %$rels ) {
+ my $old_rows = $found->[1]->{$rel};
+ if ( ref $rels->{$rel}->[0] eq 'HASH' ) {
+ $self->_merge_result( [ $found->[1]->{$rel} ],
+ [ $rels->{$rel}->[0] ] );
+ }
+ else {
+ $self->_merge_result( $found->[1]->{$rel}, $rels->{$rel}->[0] );
+ }
+ }
+ }
+ else {
+ push( @$rows, $row );
+ return undef;
+ }
- return $info;
+ return 1;
}
+
=head2 result_source
=over 4
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm 2009-08-21 12:19:07 UTC (rev 7360)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm 2009-08-21 12:19:41 UTC (rev 7361)
@@ -1392,19 +1392,7 @@
"Can't prefetch has_many ${pre} (join cond too complex)")
unless ref($rel_info->{cond}) eq 'HASH';
my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
- if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
- keys %{$collapse}) {
- my ($last) = ($fail =~ /([^\.]+)$/);
- carp (
- "Prefetching multiple has_many rels ${last} and ${pre} "
- .(length($as_prefix)
- ? "at the same level (${as_prefix}) "
- : "at top level "
- )
- . 'will explode the number of row objects retrievable via ->next or ->all. '
- . 'Use at your own risk.'
- );
- }
+
#my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
# values %{$rel_info->{cond}};
$collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
@@ -1476,19 +1464,7 @@
"Can't prefetch has_many ${pre} (join cond too complex)")
unless ref($rel_info->{cond}) eq 'HASH';
my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
- if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
- keys %{$collapse}) {
- my ($last) = ($fail =~ /([^\.]+)$/);
- carp (
- "Prefetching multiple has_many rels ${last} and ${pre} "
- .(length($as_prefix)
- ? "at the same level (${as_prefix}) "
- : "at top level "
- )
- . 'will explode the number of row objects retrievable via ->next or ->all. '
- . 'Use at your own risk.'
- );
- }
+
#my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
# values %{$rel_info->{cond}};
$collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
More information about the Bast-commits
mailing list