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";
}
}
- 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);
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
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}.$_", ] }
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(
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',
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 }
);
}
$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');
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);
}
$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');
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 = ();
projects / dbsrgits/DBIx-Class.git / commitdiff