}
$attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+ $attrs->{order_by} = [ $attrs->{order_by} ]
+ if $attrs->{order_by} && !ref($attrs->{order_by});
+ $attrs->{order_by} ||= [];
+
if (my $prefetch = delete $attrs->{prefetch}) {
foreach my $p (ref $prefetch eq 'ARRAY'
? (@{$prefetch}) : ($prefetch)) {
push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
unless $seen{$p};
}
- my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
+ my @prefetch = $source->resolve_prefetch(
+ $p, $attrs->{alias}, {}, $attrs->{order_by});
#die Dumper \@cols;
push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
$self->{all_cache_position} = 0;
return ($self->all)[0];
}
- my @row = $self->cursor->next;
+ my @row = delete $self->{stashed_row} || $self->cursor->next;
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
return $self->_construct_object(@row);
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
- if( $self->{attrs}->{cache} ) {
- while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
- $rs->all;
- #warn "$rel:", @{$rs->get_cache};
- }
- $self->build_rr( $self, $new );
- }
-
return $new;
}
-
-sub build_rr {
- # build related resultsets for supplied object
- my ( $self, $context, $obj ) = @_;
-
- my $re = qr/^\w+\./;
- while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {
- #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
- my @objs = ();
- my $map = {};
- my $cond = $context->result_source->relationship_info($rel)->{cond};
- keys %$cond;
- while( my( $rel_key, $pk ) = each(%$cond) ) {
- $rel_key =~ s/$re//;
- $pk =~ s/$re//;
- $map->{$rel_key} = $pk;
- }
-
- $rs->reset();
- while( my $rel_obj = $rs->next ) {
- while( my( $rel_key, $pk ) = each(%$map) ) {
- if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
- push @objs, $rel_obj;
- }
- }
- }
-
- my $rel_rs = $obj->related_resultset($rel);
- $rel_rs->{attrs}->{cache} = 1;
- $rel_rs->set_cache( \@objs );
-
- while( my $rel_obj = $rel_rs->next ) {
- $self->build_rr( $rs, $rel_obj );
- }
-
- }
-
-}
=head2 result_source
"search_related: result source '" . $self->result_source->name .
"' has no such relationship ${rel}")
unless $rel_obj; #die Dumper $self->{attrs};
- my $rs;
- if( $self->{attrs}->{cache} ) {
- $rs = $self->search(undef);
- }
- else {
- $rs = $self->search(undef, { join => $rel });
- }
+ my $rs = $self->search(undef, { join => $rel });
+ #if( $self->{attrs}->{cache} ) {
+ # $rs = $self->search(undef);
+ #}
+ #else {
+ #}
#use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
#use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
my $alias = (defined $rs->{attrs}{seen_join}{$rel}
=cut
sub resolve_prefetch {
- my ($self, $pre, $alias, $seen) = @_;
+ my ($self, $pre, $alias, $seen, $order) = @_;
$seen ||= {};
use Data::Dumper;
#$alias ||= $self->name;
#warn $alias, Dumper $pre;
if( ref $pre eq 'ARRAY' ) {
- return map { $self->resolve_prefetch( $_, $alias, $seen ) } @$pre;
+ return map { $self->resolve_prefetch( $_, $alias, $seen, $order ) } @$pre;
}
elsif( ref $pre eq 'HASH' ) {
my @ret =
map {
- $self->resolve_prefetch($_, $alias, $seen),
+ $self->resolve_prefetch($_, $alias, $seen, $order),
$self->related_source($_)->resolve_prefetch(
- $pre->{$_}, "${alias}.$_", $seen)
+ $pre->{$_}, "${alias}.$_", $seen, $order)
} keys %$pre;
#die Dumper \@ret;
return @ret;
}
elsif( ref $pre ) {
- $self->throw_exception( "don't know how to resolve prefetch reftype " . ref $pre);
+ $self->throw_exception(
+ "don't know how to resolve prefetch reftype ".ref($pre));
}
else {
my $count = ++$seen->{$pre};
my $as = ($count > 1 ? "${pre}_${count}" : $pre);
my $rel_info = $self->relationship_info( $pre );
- $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
+ $self->throw_exception( $self->name . " has no such relationship '$pre'" )
+ 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));
return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
- $self->related_source($pre)->columns;
+ $rel_source->columns;
#warn $alias, Dumper (\@ret);
#return @ret;
}
foreach my $pre (keys %{$prefetch||{}}) {
my $pre_val = $prefetch->{$pre};
my $pre_source = $source->related_source($pre);
- $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source;
- my $fetched;
- unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
- and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
- {
- $fetched = $pre_source->result_class->inflate_result(
- $pre_source, @{$prefetch->{$pre}});
- }
- my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
- $class->throw_exception("No accessor for prefetched $pre")
- unless defined $accessor;
- if ($accessor eq 'single') {
- $new->{_relationship_data}{$pre} = $fetched;
- } elsif ($accessor eq 'filter') {
- $new->{_inflated_column}{$pre} = $fetched;
- } elsif ($accessor eq 'multi') {
-
+ $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
+ unless $pre_source;
+ 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) {
+ next;
+ }
+ push(@pre_objects, $pre_source->result_class->inflate_result(
+ $pre_source, @{$pre_rec}));
+ }
+ $new->related_resultset($pre)->set_cache(\@pre_objects);
} else {
- $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+ my $fetched;
+ unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
+ and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
+ {
+ $fetched = $pre_source->result_class->inflate_result(
+ $pre_source, @{$pre_val});
+ }
+ my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
+ $class->throw_exception("No accessor for prefetched $pre")
+ unless defined $accessor;
+ if ($accessor eq 'single') {
+ $new->{_relationship_data}{$pre} = $fetched;
+ } elsif ($accessor eq 'filter') {
+ $new->{_inflated_column}{$pre} = $fetched;
+ } else {
+ $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+ }
}
}
return $new;
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 }
);
{
join => [ qw/ cds /],
prefetch => [qw/ cds /],
- cache => 1,
}
);
prefetch => {
cds => 'tags'
},
- cache => 1
}
);