$schema->deploy;
my $rs = $schema->resultset ('Artist');
-$rs->populate ([ map { { name => "Art_$_"} } (1 .. 10000) ]);
+
+my $hri_rs = $rs->search ({}, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' } );
+
+#DB::enable_profile();
+#my @foo = $hri_rs->all;
+#DB::disable_profile();
+#exit;
my $dbh = $schema->storage->dbh;
my $sql = sprintf ('SELECT %s FROM %s %s',
$rs->_resolved_attrs->{alias},
);
-my $compdbi = sub {
- my @r = $schema->storage->dbh->selectall_arrayref ('SELECT * FROM ' . ${$rs->as_query}->[0] )
-} if $rs->can ('as_query');
-
-cmpthese(-3, {
- Cursor => sub { $rs->reset; my @r = $rs->cursor->all },
- HRI => sub { $rs->reset; my @r = $rs->search ({}, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' } )->all },
- RowObj => sub { $rs->reset; my @r = $rs->all },
- RawDBI => sub { my @r = $dbh->selectall_arrayref ($sql) },
- $compdbi ? (CompDBI => $compdbi) : (),
-});
+for (1,10,20,50,200,2500,10000) {
+ $rs->delete;
+ $rs->populate ([ map { { name => "Art_$_"} } (1 .. $_) ]);
+ print "\nRetrieval of $_ rows\n";
+ bench();
+}
+
+sub bench {
+ cmpthese(-3, {
+ Cursor => sub { my @r = $rs->cursor->all },
+ HRI => sub { my @r = $hri_rs->all },
+ RowObj => sub { my @r = $rs->all },
+ DBI_AoH => sub { my @r = @{ $dbh->selectall_arrayref ($sql, { Slice => {} }) } },
+ DBI_AoA=> sub { my @r = @{ $dbh->selectall_arrayref ($sql) } },
+ });
+}
my $attrs = $self->_resolved_attrs_copy;
- if ($attrs->{collapse}) {
- $self->throw_exception(
- 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
- );
- }
+ $self->throw_exception(
+ 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
+ ) if $attrs->{collapse};
if ($where) {
if (defined $attrs->{where}) {
}
}
- my @data = $self->result_source->storage->select_single(
+ my $data = [ $self->result_source->storage->select_single(
$attrs->{from}, $attrs->{select},
$attrs->{where}, $attrs
- );
+ )];
- return @data
- ? ($self->_construct_objects(@data))[0]
- : undef
- ;
+ return @$data ? $self->_construct_objects($data)->[0] : undef;
}
sub next {
my ($self) = @_;
+
if (my $cache = $self->get_cache) {
$self->{all_cache_position} ||= 0;
return $cache->[$self->{all_cache_position}++];
}
+
if ($self->{attrs}{cache}) {
delete $self->{pager};
$self->{all_cache_position} = 1;
return ($self->all)[0];
}
- if ($self->{stashed_objects}) {
- my $obj = shift(@{$self->{stashed_objects}});
- delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
- return $obj;
- }
- my @row = (
- exists $self->{stashed_row}
- ? @{delete $self->{stashed_row}}
- : $self->cursor->next
- );
- return undef unless (@row);
- my ($row, @more) = $self->_construct_objects(@row);
- $self->{stashed_objects} = \@more if @more;
- return $row;
+
+ return shift(@{$self->{stashed_objects}}) if @{ $self->{stashed_objects}||[] };
+
+ $self->{stashed_objects} = $self->_construct_objects
+ or return undef;
+
+ return shift @{$self->{stashed_objects}};
}
# takes a single DBI-row of data and coinstructs as many objects
# until the current row-object is assembled (the collapser was able to
# order the result sensibly) OR until the cursor is exhausted (an
# unordered collapsing resultset effectively triggers ->all)
-
-# FIXME: why the *FUCK* do we pass around DBI data by copy?! Sadly needs
-# assessment before changing...
-#
sub _construct_objects {
- my ($self, @row) = @_;
- my $attrs = $self->_resolved_attrs;
- my $keep_collapsing = $attrs->{collapse};
-
- my $res_index;
-=begin
- do {
- my $me_pref_col = $attrs->{_row_parser}->($row_ref);
-
- my $container;
- if ($keep_collapsing) {
-
- # FIXME - we should be able to remove these 2 checks after the design validates
- $self->throw_exception ('Collapsing without a top-level collapse-set... can not happen')
- unless @{$me_ref_col->[2]};
- $self->throw_exception ('Top-level collapse-set contains a NULL-value... can not happen')
- if grep { ! defined $_ } @{$me_pref_col->[2]};
-
- my $main_ident = join "\x00", @{$me_pref_col->[2]};
-
- if (! $res_index->{$main_ident}) {
- # this is where we bail out IFF we are ordered, and the $main_ident changes
-
- $res_index->{$main_ident} = {
- all_me_pref => [,
- index => scalar keys %$res_index,
- };
- }
- }
-
-
-
- $container = $res_index->{$main_ident}{container};
- };
-
- push @$container, [ @{$me_pref_col}[0,1] ];
-
+ my ($self, $fetched_row, $fetch_all) = @_;
-
- } while (
- $keep_collapsing
- &&
- do { $row_ref = [$self->cursor->next]; $self->{stashed_row} = $row_ref if @$row_ref; scalar @$row_ref }
- );
-
- # attempt collapse all rows with same collapse identity
- if (@to_collapse > 1) {
- my @collapsed;
- while (@to_collapse) {
- $self->_merge_result(\@collapsed, shift @to_collapse);
- }
+ my $attrs = $self->_resolved_attrs;
+ my $unordered = 0; # will deal with this later
+
+ # this will be used as both initial raw-row collector AND as a RV of
+ # _construct_objects. Not regrowing the # array twice matters a lot...
+ # a suprising amount actually
+ my $rows;
+
+ # $fetch_all implies all() which means all stashes have been cleared
+ # and the cursor reset
+ if ($fetch_all) {
+ # FIXME - we can do better, cursor->all (well a diff. method) should return a ref
+ $rows = [ $self->cursor->all ];
+ }
+ elsif ($unordered) {
+ $rows = [
+ $fetched_row||(),
+ @{ delete $self->{stashed_rows} || []},
+ $self->cursor->all,
+ ];
+ }
+ else { # simple single object
+ $rows = [ $fetched_row || ( @{$self->{stashed_rows}||[]} ? shift @{$self->{stashed_rows}} : [$self->cursor->next] ) ];
}
-=cut
- my $mepref_structs = $self->_collapse_result($attrs->{as}, \@row, $keep_collapsing)
- or return ();
+ return undef unless @{$rows->[0]||[]};
my $rsrc = $self->result_source;
my $res_class = $self->result_class;
- my $inflator = $res_class->can ('inflate_result');
-
- my @objs =
- $res_class->$inflator ($rsrc, @$mepref_structs);
+ my $inflator = $res_class->can ('inflate_result')
+ or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method");
+
+ # construct a much simpler array->hash folder for the one-table cases right here
+ if ($attrs->{_single_object_inflation} and ! $attrs->{collapse}) {
+ # FIXME this is a very very very hot spot
+ # while rather optimal we can *still* do much better, by
+ # building a smarter [Row|HRI]::inflate_result(), and
+ # switch to feeding it data via some leaner interface
+ #
+ my $infmap = $attrs->{as};
+ my @as_idx = 0..$#$infmap;
+ for my $r (@$rows) {
+ $r = [{ map { $infmap->[$_] => $r->[$_] } @as_idx }]
+ }
- if (my $f = $attrs->{record_filter}) {
- @objs = map { $f->($_) } @objs;
+ # FIXME - this seems to be faster than the hashmapper aove, especially
+ # on more rows, but need a better bench-environment to confirm
+ #eval sprintf (
+ # '$_ = [{ %s }] for @$rows',
+ # join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap )
+ #);
}
-
- return @objs;
-}
-
-
-sub _collapse_result {
- my ( $self, $as_proto, $row_ref, $keep_collapsing ) = @_;
- my $collapse = $self->_resolved_attrs->{collapse};
- my $parser = $self->result_source->_mk_row_parser( $as_proto, $collapse );
- my $result = [];
- my $register = {};
- my $rel_register = {};
-
- my @row = @$row_ref;
- do {
- my $row = $parser->( \@row );
-
- # init register
- $self->_check_register( $register, $row ) unless ( keys %$register );
-
- $self->_merge_result( $result, $row, $rel_register )
- if ( !$collapse
- || ( $collapse = $self->_check_register( $register, $row ) ) );
-
- } while (
- $collapse
- && do { @row = $self->cursor->next; $self->{stashed_row} = \@row if @row; }
-
- # run this as long as there is a next row and we are not yet done collapsing
+ else {
+ push @$rows, @{$self->{stashed_rows}||[]};
+
+ $rsrc->_mk_row_parser({
+ inflate_map => $attrs->{as},
+ selection => $attrs->{select},
+ collapse => $attrs->{collapse},
+ unordered => $unordered,
+ })->(
+ $rows, # modify in-place, shrinking/extending as necessary
+ ($attrs->{collapse} and ! $fetch_all and ! $unordered)
+ ? (
+ sub { my @r = $self->cursor->next or return undef; \@r },
+ ($self->{stashed_rows} = []), # this is where we empty things and prepare for leftovers
+ )
+ : ()
+ ,
);
- return $result;
-}
-
-
-
-# Taubenschlag
-sub _check_register {
- my ( $self, $register, $obj ) = @_;
- return undef unless ( ref $obj eq 'ARRAY' && ref $obj->[2] eq 'ARRAY' );
- my @ids = @{ $obj->[2] };
- while ( defined( my $id = shift @ids ) ) {
- return $register->{$id} if ( exists $register->{$id} && !@ids );
- $register->{$id} = @ids ? {} : $obj unless ( exists $register->{$id} );
- $register = $register->{$id};
- }
- return undef;
-}
-
-sub _merge_result {
- my ( $self, $result, $row, $register ) = @_;
- return @$result = @$row if ( @$result == 0 ); # initialize with $row
-
- my ( undef, $rels, $ids ) = @$result;
- my ( undef, $new_rels, $new_ids ) = @$row;
-
- my @rels = keys %{ { %{$rels||{} }, %{ $new_rels||{} } } };
- foreach my $rel (@rels) {
- $register = $register->{$rel} ||= {};
-
- my $new_data = $new_rels->{$rel};
- my $data = $rels->{$rel};
- @$data = [@$data] unless ( ref $data->[0] eq 'ARRAY' );
-
- $self->_check_register( $register, $data->[0] )
- unless ( keys %$register );
-
- if ( my $found = $self->_check_register( $register, $new_data ) ) {
- $self->_merge_result( $found, $new_data, $register );
- }
- else {
- push( @$data, $new_data );
- }
- }
- return 1;
-}
-
-=begin
-
-# two arguments: $as_proto is an arrayref of column names,
-# $row_ref is an arrayref of the data. If none of the row data
-# is defined we return undef (that's copied from the old
-# _collapse_result). Next we decide whether we need to collapse
-# the resultset (i.e. we prefetch something) or not. $collapse
-# indicates that. The do-while loop will run once if we do not need
-# to collapse the result and will run as long as _merge_result returns
-# a true value. It will return undef if the current added row does not
-# match the previous row. A bit of stashing and cursor magic is
-# required so that the cursor is not mixed up.
-
-# "$rows" is a bit misleading. In the end, there should only be one
-# element in this arrayref.
-
-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;
-
- my $collapse = $self->_resolved_attrs->{collapse};
- my $rows = [];
- my @row = @$row_ref;
- do {
- my $i = 0;
- my $row = { map { $_ => $row[ $i++ ] } @$as_proto };
- $row = $self->result_source->_parse_row($row, $collapse);
- 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; }
- );
-
- return $rows->[0];
-
-}
-
-# _merge_result accepts an arrayref of rows objects (again, an arrayref of two elements)
-# and a row object which should be merged into the first object.
-# First we try to find out whether $row is already in $rows. If this is the case
-# we try to merge them by iteration through their relationship data. We call
-# _merge_result again on them, so they get merged.
-
-# If we don't find the $row in $rows, we append it to $rows and return undef.
-# _merge_result returns 1 otherwise (i.e. $row has been found in $rows).
-
-sub _merge_result {
- my ( $self, $rows, $row ) = @_;
- my ( $columns, $rels ) = @$row;
- my $found = undef;
- foreach my $seen (@$rows) {
- my $match = 1;
- foreach my $column ( keys %$columns ) {
- if ( defined $seen->[0]->{$column} ^ defined $columns->{$column}
- or defined $columns->{$column}
- && $seen->[0]->{$column} ne $columns->{$column} )
- {
-
- $match = 0;
- last;
- }
- }
- if ($match) {
- $found = $seen;
- last;
- }
- }
- if ($found) {
- foreach my $rel ( keys %$rels ) {
- my $old_rows = $found->[1]->{$rel};
- $self->_merge_result(
- ref $found->[1]->{$rel}->[0] eq 'HASH' ? [ $found->[1]->{$rel} ]
- : $found->[1]->{$rel},
- ref $rels->{$rel}->[0] eq 'HASH' ? [ $rels->{$rel}->[0], $rels->{$rel}->[1] ]
- : $rels->{$rel}->[0]
- );
-
- my $attrs = $self->_resolved_attrs;
- my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/};
-
- # FIXME this is temporary, need to calculate in _resolved_attrs
- $set_ident ||= { me => [ $self->result_source->_pri_cols ], pref => {} };
-
- my @cur_row = @$row_ref;
- my (@to_collapse, $last_ident);
-
- do {
- my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) };
-
- # see if we are switching to another object
- # this can be turned off and things will still work
- # since _merge_prefetch knows about _collapse_ident
-# my $cur_ident = [ @{$row_hr}{@$set_ident} ];
- my $cur_ident = [];
- $last_ident ||= $cur_ident;
-
-# if ($keep_collapsing = Test::Deep::eq_deeply ($cur_ident, $last_ident)) {
-# push @to_collapse, $self->result_source->_parse_row (
-# $row_hr,
-# );
-# }
- } while (
- $keep_collapsing
- &&
- do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; }
- );
-
- die Dumper \@to_collapse;
-
-
- # attempt collapse all rows with same collapse identity
- if (@to_collapse > 1) {
- my @collapsed;
- while (@to_collapse) {
- $self->_merge_result(\@collapsed, shift @to_collapse);
- }
- @to_collapse = @collapsed;
}
- # still didn't fully collapse
- $self->throw_exception ('Resultset collapse failed (theoretically impossible). Maybe a wrong collapse_ident...?')
- if (@to_collapse > 1);
-
- return $to_collapse[0];
-}
-
-
-# two arguments: $as_proto is an arrayref of 'as' column names,
-# $row_ref is an arrayref of the data. The do-while loop will run
-# once if we do not need to collapse the result and will run as long as
-# _merge_result returns a true value. It will return undef if the
-# current added row does not match the previous row, which in turn
-# means we need to stash the row for the subsequent ->next call
-sub _collapse_result {
- my ( $self, $as_proto, $row_ref ) = @_;
-
- my $attrs = $self->_resolved_attrs;
- my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/};
-
- die Dumper [$as_proto, $row_ref, $keep_collapsing, $set_ident ];
-
-
- my @cur_row = @$row_ref;
- my (@to_collapse, $last_ident);
-
- do {
- my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) };
-
- # see if we are switching to another object
- # this can be turned off and things will still work
- # since _merge_prefetch knows about _collapse_ident
-# my $cur_ident = [ @{$row_hr}{@$set_ident} ];
- my $cur_ident = [];
- $last_ident ||= $cur_ident;
+ $_ = $res_class->$inflator($rsrc, @$_) for @$rows;
-# if ($keep_collapsing = eq_deeply ($cur_ident, $last_ident)) {
-# push @to_collapse, $self->result_source->_parse_row (
-# $row_hr,
-# );
-# }
- } while (
- $keep_collapsing
- &&
- do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; }
- );
-
- # attempt collapse all rows with same collapse identity
-}
-=cut
-
-# Takes an arrayref of me/pref pairs and a new me/pref pair that should
-# be merged on a preexisting matching me (or should be pushed into $merged
-# as a new me/pref pair for further invocations). It should be possible to
-# use this function to collapse complete ->all results, provided _collapse_result() is adjusted
-# to provide everything to this sub not to barf when $merged contains more than one
-# arrayref)
-sub _merge_prefetch {
- my ($self, $merged, $next_row) = @_;
-
- unless (@$merged) {
- push @$merged, $next_row;
- return;
+ # CDBI compat stuff
+ if ($attrs->{record_filter}) {
+ $_ = $attrs->{record_filter}->($_) for @$rows;
}
+ return $rows;
}
=head2 result_source
sub all {
my $self = shift;
if(@_) {
- $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
+ $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
}
+ delete $self->{stashed_rows};
+ delete $self->{stashed_objects};
+
if (my $c = $self->get_cache) {
return @$c;
}
- my @objects;
-
- if ($self->_resolved_attrs->{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_objects to survive the approach
- $self->cursor->reset;
- my @row = $self->cursor->next;
- while (@row) {
- push(@objects, $self->_construct_objects(@row));
- @row = (exists $self->{stashed_row}
- ? @{delete $self->{stashed_row}}
- : $self->cursor->next);
- }
- } else {
- @objects = map { $self->_construct_objects(@$_) } $self->cursor->all;
- }
+ $self->cursor->reset;
+
+ my $objs = $self->_construct_objects(undef, 'fetch_all') || [];
- $self->set_cache(\@objects) if $self->{attrs}{cache};
+ $self->set_cache($objs) if $self->{attrs}{cache};
- return @objects;
+ return @$objs;
}
=head2 reset
sub reset {
my ($self) = @_;
- delete $self->{_attrs} if exists $self->{_attrs};
+ delete $self->{_attrs};
+ delete $self->{stashed_rows};
+ delete $self->{stashed_objects};
+
$self->{all_cache_position} = 0;
$self->cursor->reset;
return $self;
my $existing_group_by = delete $attrs->{group_by};
# make a new $rs selecting only the PKs (that's all we really need for the subq)
- delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/;
+ delete $attrs->{$_} for qw/collapse select _prefetch_selector_range as/;
$attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
$attrs->{group_by} = \ ''; # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
my $subrs = (ref $self)->new($rsrc, $attrs);
if (my $cache = $self->get_cache) {
if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
- $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
+ $new_cache = [ map { @{$_->related_resultset($rel)->get_cache||[]} }
@$cache ];
}
}
if $attrs->{select};
# assume all unqualified selectors to apply to the current alias (legacy stuff)
- for (@sel) {
- $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_";
- }
+ $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel;
- # disqualify all $alias.col as-bits (collapser mandated)
- for (@as) {
- $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_;
- }
+ # disqualify all $alias.col as-bits (inflate-map mandated)
+ $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as;
# de-duplicate the result (remove *identical* select/as pairs)
# and also die on duplicate {as} pointing to different {select}s
}
}
+ $attrs->{_single_object_inflation} = ! List::Util::first { $_ =~ /\./ } @{$attrs->{as}};
# if both page and offset are specified, produce a combined offset
# even though it doesn't make much sense, this is what pre 081xx has
use strict;
use warnings;
-use base qw/DBIx::Class/;
+use base 'DBIx::Class';
use DBIx::Class::ResultSet;
use DBIx::Class::ResultSourceHandle;
use Try::Tiny;
use List::Util 'first';
use Scalar::Util qw/blessed weaken isweak/;
+use B 'perlstring';
+
use namespace::clean;
__PACKAGE__->mk_group_accessors(simple => qw/
,
-join_path => [@$jpath, { $join => $as } ],
-is_single => (
- $rel_info->{attrs}{accessor}
- &&
+ (! $rel_info->{attrs}{accessor})
+ or
first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
),
-alias => $as,
my $rel_info = $self->relationship_info( $pre );
$self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
unless $rel_info;
+
my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
my $rel_source = $self->related_source($pre);
}
}
+# adding a dep on MoreUtils *just* for this is retarded
+my $unique_numlist = sub { [ sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }} ] };
+
+# This error must be thrown from two distinct codepaths, joining them is
+# rather hard. Go for this hack instead.
+my $get_related_source = sub {
+ my ($rsrc, $rel, $relcols) = @_;
+ try {
+ $rsrc->related_source ($rel)
+ } catch {
+ $rsrc->throw_exception(sprintf(
+ "Can't inflate prefetch into non-existent relationship '%s' from '%s', "
+ . "check the inflation specification (columns/as) ending in '...%s.%s'.",
+ $rel,
+ $rsrc->source_name,
+ $rel,
+ (sort { length($a) <=> length ($b) } keys %$relcols)[0],
+ ))};
+};
+
# Takes a selection list and generates a collapse-map representing
# row-object fold-points. Every relationship is assigned a set of unique,
# non-nullable columns (which may *not even be* from the same resultset)
# and the collapser will use this information to correctly distinguish
# data of individual to-be-row-objects.
sub _resolve_collapse {
- my ($self, $as, $as_fq_idx, $rel_chain, $parent_info) = @_;
+ my ($self, $as, $as_fq_idx, $rel_chain, $parent_info, $node_idx_ref) = @_;
# for comprehensible error messages put ourselves at the head of the relationship chain
$rel_chain ||= [ $self->source_name ];
# run through relationships, collect metadata, inject non-left fk-bridges from
# *INNER-JOINED* children (if any)
for my $rel (keys %$rel_cols) {
- my $rel_src = $self->related_source ($rel);
+ my $rel_src = $get_related_source->($self, $rel, $rel_cols->{$rel});
+
my $inf = $self->relationship_info ($rel);
$relinfo->{$rel}{is_single} = $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi';
and
keys %$cond
and
- ! List::Util::first { $_ !~ /^foreign\./ } (keys %$cond)
+ ! first { $_ !~ /^foreign\./ } (keys %$cond)
and
- ! List::Util::first { $_ !~ /^self\./ } (values %$cond)
+ ! first { $_ !~ /^self\./ } (values %$cond)
) {
for my $f (keys %$cond) {
my $s = $cond->{$f};
$_ =~ s/^ (?: foreign | self ) \.//x for ($f, $s);
$relinfo->{$rel}{fk_map}{$s} = $f;
- $my_cols->{$s} ||= { via_fk => "$rel.$f" } # need to know source from *our* pov
- if ($relinfo->{$rel}{is_inner} && defined $rel_cols->{$rel}{$f}); # only if it is inner and in fact selected of course
+ # need to know source from *our* pov, hnce $rel.
+ $my_cols->{$s} ||= { via_fk => "$rel.$f" } if (
+ defined $rel_cols->{$rel}{$f} # in fact selected
+ and
+ (! $node_idx_ref or $relinfo->{$rel}{is_inner}) # either top-level or an inner join
+ );
}
}
}
# get colinfo for everything
if ($my_cols) {
- $my_cols->{$_}{colinfo} = (
- $self->has_column ($_) ? $self->column_info ($_) : undef
- ) for keys %$my_cols;
+ my $ci = $self->columns_info;
+ $my_cols->{$_}{colinfo} = $ci->{$_} for keys %$my_cols;
}
my $collapse_map;
# see if the resulting collapser relies on any implied columns,
# and fix stuff up if this is the case
- my $parent_collapser_used;
-
- if (List::Util::first
- { exists $assumed_from_parent->{columns}{$_} }
- keys %$uset
- ) {
- # remove implied stuff from the uset, we will inject the equivalent collapser a bit below
- delete @{$uset}{keys %{$assumed_from_parent->{columns}}};
- $parent_collapser_used = 1;
- }
-
- $collapse_map->{-collapse_on} = {
- %{ $parent_collapser_used ? $parent_info->{collapse_on} : {} },
+ my $parent_collapser_used = defined delete @{$uset}{keys %{$assumed_from_parent->{columns}}};
+ $collapse_map->{-node_id} = $unique_numlist->(
+ $parent_collapser_used ? @{$parent_info->{collapse_on}} : (),
(map
{
my $fqc = join ('.',
( $my_cols->{$_}{via_fk} || $_ ),
);
- $fqc => $as_fq_idx->{$fqc};
+ $as_fq_idx->{$fqc};
}
keys %$uset
),
- };
+ );
}
- # don't know how to collapse - keep descending down 1:1 chains - if
+ # Stil don't know how to collapse - keep descending down 1:1 chains - if
# a related non-LEFT 1:1 is resolvable - its condition will collapse us
# too
- unless ($collapse_map->{-collapse_on}) {
+ unless ($collapse_map->{-node_id}) {
my @candidates;
for my $rel (keys %$relinfo) {
[ @$rel_chain, $rel ],
{ underdefined => 1 }
)) {
- push @candidates, $rel_collapse->{-collapse_on};
+ push @candidates, $rel_collapse->{-node_id};
}
}
# FIXME - maybe need to implement a data type order as well (i.e. prefer several ints
# to a single varchar)
if (@candidates) {
- ($collapse_map->{-collapse_on}) = sort { keys %$a <=> keys %$b } (@candidates);
+ ($collapse_map->{-node_id}) = sort { scalar @$a <=> scalar @$b } (@candidates);
}
}
# Still dont know how to collapse - see if the parent passed us anything
# (i.e. reuse collapser over 1:1)
- unless ($collapse_map->{-collapse_on}) {
- $collapse_map->{-collapse_on} = $parent_info->{collapse_on}
+ unless ($collapse_map->{-node_id}) {
+ $collapse_map->{-node_id} = $parent_info->{collapse_on}
if $parent_info->{collapser_reusable};
}
-
# stop descending into children if we were called by a parent for first-pass
# and don't despair if nothing was found (there may be other parallel branches
# to dive into)
if ($parent_info->{underdefined}) {
- return $collapse_map->{-collapse_on} ? $collapse_map : undef
+ return $collapse_map->{-node_id} ? $collapse_map : undef
}
# nothing down the chain resolved - can't calculate a collapse-map
- elsif (! $collapse_map->{-collapse_on}) {
+ elsif (! $collapse_map->{-node_id}) {
$self->throw_exception ( sprintf
"Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns",
$self->source_name,
);
}
-
# If we got that far - we are collapsable - GREAT! Now go down all children
# a second time, and fill in the rest
- for my $rel (keys %$relinfo) {
+ $collapse_map->{-is_optional} = 1 if $parent_info->{is_optional};
+ $collapse_map->{-node_index} = ${ $node_idx_ref ||= \do { my $x = 1 } }++; # this is *deliberately* not 0-based
+
+ my (@id_sets, $multis_in_chain);
+ for my $rel (sort keys %$relinfo) {
$collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse (
{ map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) },
[ @$rel_chain, $rel],
{
- collapse_on => { %{$collapse_map->{-collapse_on}} },
+ collapse_on => [ @{$collapse_map->{-node_id}} ],
rel_condition => $relinfo->{$rel}{fk_map},
+ is_optional => $collapse_map->{-is_optional},
+
# if this is a 1:1 our own collapser can be used as a collapse-map
# (regardless of left or not)
- collapser_reusable => $relinfo->{$rel}{is_single},
+ collapser_reusable => $relinfo->{$rel}{is_single},
},
+
+ $node_idx_ref,
);
+
+ $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single};
+ $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner};
+ push @id_sets, @{ $collapse_map->{$rel}{-branch_id} };
}
+ $collapse_map->{-branch_id} = $unique_numlist->( @id_sets, @{$collapse_map->{-node_id}} );
+
return $collapse_map;
}
}
# Takes an arrayref of {as} dbic column aliases and the collapse and select
-# attributes from the same $rs (the slector requirement is a temporary
+# attributes from the same $rs (the slector requirement is a temporary
# workaround), and returns a coderef capable of:
# my $me_pref_clps = $coderef->([$rs->cursor->next])
# Where the $me_pref_clps arrayref is the future argument to
# any sort of rewrite should be relatively easy
#
sub _mk_row_parser {
- my ($self, $as, $with_collapse, $select) = @_;
+ my ($self, $args) = @_;
- my $as_indexed = { map
- { $as->[$_] => $_ }
- ( 0 .. $#$as )
+ my $inflate_index = { map
+ { $args->{inflate_map}[$_] => $_ }
+ ( 0 .. $#{$args->{inflate_map}} )
};
- # calculate collapse fold-points if needed
- my $collapse_on = do {
+ my ($parser_src);
+ if ($args->{collapse}) {
+ # FIXME - deal with unorderedness
+ # unordered => $unordered
+
+ my $collapse_map = $self->_resolve_collapse (
+ # FIXME
+ # only consider real columns (not functions) during collapse resolution
+ # this check shouldn't really be here, as fucktards are not supposed to
+ # alias random crap to existing column names anyway, but still - just in
+ # case
+ # FIXME !!!! - this does not yet deal with unbalanced selectors correctly
+ # (it is now trivial as the attrs specify where things go out of sync)
+ { map
+ { ref $args->{selection}[$inflate_index->{$_}] ? () : ( $_ => $inflate_index->{$_} ) }
+ keys %$inflate_index
+ }
+ );
+
+ my $unrolled_top_branch_id_indexes = join (', ', @{$collapse_map->{-branch_id}});
+
+ my ($sequenced_top_branch_id, $sequenced_top_node_id) = map
+ { join ('', map { "{'\xFF__IDVALPOS__${_}__\xFF'}" } @$_ ) }
+ $collapse_map->{-branch_id}, $collapse_map->{-node_id}
+ ;
+
+ my $rolled_out_assemblers = __visit_infmap_collapse (
+ $inflate_index, $collapse_map
+ );
+
+ my @sprintf_args = (
+ $unrolled_top_branch_id_indexes,
+ $sequenced_top_branch_id,
+ $sequenced_top_node_id,
+ $rolled_out_assemblers,
+ $sequenced_top_node_id,
+ );
+ $parser_src = sprintf (<<'EOS', @sprintf_args);
+
+### BEGIN STRING EVAL
+ my ($rows_pos, $result_pos, $cur_row, @cur_row_id_values, $is_new_res, @collapse_idx) = (0,0);
+
+ # this loop is a bit arcane - the rationale is that the passed in
+ # $_[0] will either have only one row (->next) or will have all
+ # rows already pulled in (->all and/or unordered). Given that the
+ # result can be rather large - we reuse the same already allocated
+ # array, since the collapsed prefetch is smaller by definition.
+ # At the end we cut the leftovers away and move on.
+ while ($cur_row =
+ ($rows_pos >= 0 and $_[0][$rows_pos++] or do { $rows_pos = -1; 0 } )
+ ||
+ ($_[1] and $_[1]->())
+ ) {
+
# FIXME
- # only consider real columns (not functions) during collapse resolution
- # this check shouldn't really be here, as fucktards are not supposed to
- # alias random crap to existing column names anyway, but still - just in
- # case (also saves us from select/as mismatches which need fixing as well...)
-
- my $plain_as = { %$as_indexed };
- for (keys %$plain_as) {
- delete $plain_as->{$_} if ref $select->[$plain_as->{$_}];
- }
- $self->_resolve_collapse ($plain_as);
+ # optimize this away when we know we have no undefs in the collapse map
+ $cur_row_id_values[$_] = defined $cur_row->[$_] ? $cur_row->[$_] : "\xFF\xFFN\xFFU\xFFL\xFFL\xFF\xFF"
+ for (%s); # the top branch_id includes all id values
- } if $with_collapse;
+ # check top branch for doubling via a has_many non-selecting join or something
+ # 0 is reserved for this (node indexes start from 1)
+ next if $collapse_idx[0]%s++;
- my $perl = $self->__visit_as ($as_indexed, $collapse_on);
- my $cref = eval "sub { $perl }"
- or die "Oops! _mk_row_parser generated invalid perl:\n$@\n\n$perl\n";
- return $cref;
-}
+ $is_new_res = ! $collapse_idx[1]%s;
-{
- my $visit_as_dumper; # keep our own DD object around so we don't have to fitz with quoting
+ # lazify
+ # fire on ordered only
+# if ($is_new_res = ! $collapse_idx[1]{$cur_row_id_values[2]}) {
+# }
- sub __visit_as {
- my ($self, $as, $collapse_on, $known_defined) = @_;
- $known_defined ||= {};
+ %s
- # prepopulate the known defined map with our own collapse value positions
- # the rationale is that if an Artist needs column 0 to be uniquely
- # identified, and related CDs need columns 0 and 1, by the time we get to
- # CDs we already know that column 0 is defined (otherwise there would be
- # no related CDs as there is no Artist in the 1st place). So we use this
- # index to cut on repetitive defined() checks.
- $known_defined->{$_}++ for ( values %{$collapse_on->{-collapse_on} || {}} );
+ $_[0][$result_pos++] = $collapse_idx[1]%s
+ if $is_new_res;
+ }
- my $my_cols = {};
- my $rel_cols;
- for (keys %$as) {
- if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
- $rel_cols->{$1}{$2} = $as->{$_};
- }
- else {
- $my_cols->{$_} = $as->{$_};
- }
- }
+ splice @{$_[0]}, $result_pos; # truncate the passed in array for cases of collapsing ->all()
- my @relperl;
- for my $rel (sort keys %$rel_cols) {
- my $rel_node = $self->__visit_as($rel_cols->{$rel}, $collapse_on->{$rel}, {%$known_defined} );
-
- my @null_checks;
- if ($collapse_on->{$rel}{-collapse_on}) {
- @null_checks = map
- { "(! defined '__VALPOS__${_}__')" }
- ( grep
- { ! $known_defined->{$_} }
- ( sort
- { $a <=> $b }
- values %{$collapse_on->{$rel}{-collapse_on}}
- )
- )
- ;
- }
+### END STRING EVAL
+EOS
- if (@null_checks) {
- push @relperl, sprintf ( '(%s) ? () : ( %s => %s )',
- join (' || ', @null_checks ),
- $rel,
- $rel_node,
- );
- }
- else {
- push @relperl, "$rel => $rel_node";
- }
- }
- my $rels = @relperl
- ? sprintf ('{ %s }', join (',', @relperl))
- : 'undef'
- ;
+ # change the quoted placeholders to unquoted alias-references
+ $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /sprintf ('$cur_row->[%d]', $1)/gex;
+ $parser_src =~ s/ \' \xFF__IDVALPOS__(\d+)__\xFF \' /sprintf ('$cur_row_id_values[%d]', $1)/gex;
+ }
- my $me = {
- map { $_ => "__VALPOS__$my_cols->{$_}__" } (keys %$my_cols)
- };
+ else {
+ $parser_src = sprintf(
+ '$_ = %s for @{$_[0]}',
+ __visit_infmap_simple($inflate_index, { rsrc => $self }), # need the $rsrc to determine left-ness
+ );
- my $clps = undef; # funny thing, but this prevents a memory leak, I guess it's Data::Dumper#s fault (mo)
- $clps = [
- map { "__VALPOS__${_}__" } ( sort { $a <=> $b } (values %{$collapse_on->{-collapse_on}}) )
- ] if $collapse_on->{-collapse_on};
+ # change the quoted placeholders to unquoted alias-references
+ $parser_src =~ s/ \' \xFF__VALPOS__(\d+)__\xFF \' /sprintf ('$_->[%d]', $1)/gex;
+ }
+ eval "sub { no strict; no warnings; $parser_src }" or die "$@\n\n$parser_src";
+}
+
+{
+ # keep our own DD object around so we don't have to fitz with quoting
+ my $dumper_obj;
+ my $visit_dump = sub {
# we actually will be producing functional perl code here,
# thus no second-guessing of what these globals might have
# been set to. DO NOT CHANGE!
- $visit_as_dumper ||= do {
+ ($dumper_obj ||= do {
require Data::Dumper;
Data::Dumper->new([])
->Purity (1)
->Deparse (0)
->Maxdepth (0)
->Indent (0)
- };
- for ($me, $clps) {
- $_ = $visit_as_dumper->Values ([$_])->Dump;
+ })->Values ([shift])->Dump,
+ };
+
+ sub __visit_infmap_simple {
+ my ($val_idx, $args) = @_;
+
+ my $my_cols = {};
+ my $rel_cols;
+ for (keys %$val_idx) {
+ if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
+ $rel_cols->{$1}{$2} = $val_idx->{$_};
+ }
+ else {
+ $my_cols->{$_} = $val_idx->{$_};
+ }
+ }
+ my @relperl;
+ for my $rel (sort keys %$rel_cols) {
+
+ my $rel_rsrc = $get_related_source->($args->{rsrc}, $rel, $rel_cols->{$rel});
+
+ #my $optional = $args->{is_optional};
+ #$optional ||= ($args->{rsrc}->relationship_info($rel)->{attrs}{join_type} || '') =~ /^left/i;
+
+ push @relperl, join ' => ', perlstring($rel), __visit_infmap_simple($rel_cols->{$rel}, {
+ non_top => 1,
+ #is_optional => $optional,
+ rsrc => $rel_rsrc,
+ });
+
+ # FIXME SUBOPTIMAL - disabled to satisfy t/resultset/inflate_result_api.t
+ #if ($optional and my @branch_null_checks = map
+ # { "(! defined '\xFF__VALPOS__${_}__\xFF')" }
+ # sort { $a <=> $b } values %{$rel_cols->{$rel}}
+ #) {
+ # $relperl[-1] = sprintf ( '(%s) ? ( %s => [] ) : ( %s )',
+ # join (' && ', @branch_null_checks ),
+ # perlstring($rel),
+ # $relperl[-1],
+ # );
+ #}
+ }
+
+ my $me_struct = keys %$my_cols
+ ? $visit_dump->({ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) })
+ : 'undef'
+ ;
+
+ return sprintf '[%s]', join (',',
+ $me_struct,
+ @relperl ? sprintf ('{ %s }', join (',', @relperl)) : (),
+ );
+ }
+
+ sub __visit_infmap_collapse {
+ my ($val_idx, $collapse_map, $parent_info) = @_;
+
+ my $my_cols = {};
+ my $rel_cols;
+ for (keys %$val_idx) {
+ if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
+ $rel_cols->{$1}{$2} = $val_idx->{$_};
+ }
+ else {
+ $my_cols->{$_} = $val_idx->{$_};
+ }
}
- unless ($collapse_on->{-collapse_on}) { # we are not collapsing, insert a definedness check on 'me'
- $me = sprintf ( '(%s) ? %s : {}',
- join (' || ', map { "( defined '__VALPOS__${_}__')" } (sort { $a <=> $b } values %$my_cols) ),
- $me,
+ my $sequenced_node_id = join ('', map
+ { "{'\xFF__IDVALPOS__${_}__\xFF'}" }
+ @{$collapse_map->{-node_id}}
+ );
+
+ my $me_struct = keys %$my_cols
+ ? $visit_dump->([{ map { $_ => "\xFF__VALPOS__$my_cols->{$_}__\xFF" } (keys %$my_cols) }])
+ : 'undef'
+ ;
+ my $node_idx_ref = sprintf '$collapse_idx[%d]%s', $collapse_map->{-node_index}, $sequenced_node_id;
+
+ my $parent_idx_ref = sprintf( '$collapse_idx[%d]%s[1]{%s}',
+ @{$parent_info}{qw/node_idx sequenced_node_id/},
+ perlstring($parent_info->{relname}),
+ ) if $parent_info;
+
+ my @src;
+ if ($collapse_map->{-node_index} == 1) {
+ push @src, sprintf( '%s ||= %s;',
+ $node_idx_ref,
+ $me_struct,
+ );
+ }
+ elsif ($collapse_map->{-is_single}) {
+ push @src, sprintf ( '%s = %s ||= %s;',
+ $parent_idx_ref,
+ $node_idx_ref,
+ $me_struct,
+ );
+ }
+ else {
+ push @src, sprintf('push @{%s}, %s = %s if !%s;',
+ $parent_idx_ref,
+ $node_idx_ref,
+ $me_struct,
+ $node_idx_ref,
);
}
- my @rv_list = ($me, $rels, $clps);
- pop @rv_list while ($rv_list[-1] eq 'undef'); # strip trailing undefs
+ #my $known_defined = { %{ $parent_info->{known_defined} || {} } };
+ #$known_defined->{$_}++ for @{$collapse_map->{-node_id}};
- # change the quoted placeholders to unquoted alias-references
- $_ =~ s/ \' __VALPOS__(\d+)__ \' /sprintf ('$_[0][%d]', $1)/gex
- for grep { defined $_ } @rv_list;
- return sprintf '[%s]', join (',', @rv_list);
+ for my $rel (sort keys %$rel_cols) {
+
+ push @src, sprintf( '%s[1]{%s} ||= [];', $node_idx_ref, perlstring($rel) );
+
+ push @src, __visit_infmap_collapse($rel_cols->{$rel}, $collapse_map->{$rel}, {
+ node_idx => $collapse_map->{-node_index},
+ sequenced_node_id => $sequenced_node_id,
+ relname => $rel,
+ #known_defined => $known_defined,
+ });
+
+ # FIXME SUBOPTIMAL - disabled to satisfy t/resultset/inflate_result_api.t
+ #if ($collapse_map->{$rel}{-is_optional} and my @null_checks = map
+ # { "(! defined '\xFF__VALPOS__${_}__\xFF')" }
+ # sort { $a <=> $b } grep
+ # { ! $known_defined->{$_} }
+ # @{$collapse_map->{$rel}{-node_id}}
+ #) {
+ # $src[-1] = sprintf( '(%s) or %s',
+ # join (' || ', @null_checks ),
+ # $src[-1],
+ # );
+ #}
+ }
+
+ join "\n", @src;
}
}
foreach my $pre (keys %{$prefetch||{}}) {
- my (@pre_vals, $is_multi);
- if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
- $is_multi = 1;
+ my @pre_vals;
+ if (! @{$prefetch->{$pre}}) {
+ # nothing, empty @pre_vals is put in the caches
+ }
+ elsif (ref $prefetch->{$pre}[0] eq 'ARRAY') {
@pre_vals = @{$prefetch->{$pre}};
}
else {
@pre_vals = $prefetch->{$pre};
}
- my $pre_source = try {
- $source->related_source($pre)
- }
- catch {
- $class->throw_exception(sprintf
-
- "Can't inflate manual prefetch into non-existent relationship '%s' from '%s', "
- . "check the inflation specification (columns/as) ending in '%s.%s'.",
-
- $pre,
- $source->source_name,
- $pre,
- (keys %{$pre_vals[0][0]})[0] || 'something.something...',
- );
- };
+ my $pre_source = $source->related_source($pre);
my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
- or $class->throw_exception("No accessor type declared for prefetched $pre");
-
- if (! $is_multi and $accessor eq 'multi') {
- $class->throw_exception("Manual prefetch (via select/columns) not supported with accessor 'multi'");
- }
+ or $class->throw_exception("No accessor type declared for prefetched relationship '$pre'");
my @pre_objects;
for my $me_pref (@pre_vals) {
- push @pre_objects, $pre_source->result_class->inflate_result(
- $pre_source, @$me_pref
- );
+
+ # FIXME SUBOPTIMAL - the new row parsers can very well optimize
+ # this away entirely, and *never* return such empty rows.
+ # For now we maintain inflate_result API backcompat
+ next unless first { defined $_ } values %{$me_pref->[0]};
+
+ push @pre_objects, $pre_source->result_class->inflate_result(
+ $pre_source, @$me_pref
+ );
}
if ($accessor eq 'single') {
delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
my $inner_attrs = { %$attrs, _is_internal_subuery => 1 };
- delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range _collapse_order_by select as/;
-
-
- # bring over all non-collapse-induced order_by into the inner query (if any)
- # the outer one will have to keep them all
- delete $inner_attrs->{order_by};
- if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}||[]} ) {
- $inner_attrs->{order_by} = [
- @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
- ];
- }
+ delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range select as/;
# generate the inner/outer select lists
# for inside we consider only stuff *not* brought in by the prefetch
delete $weak_registry->{$slot}
unless $cleared->{hash_merge_singleton}{$weak_registry->{$slot}{weakref}{behavior}}++;
}
+ elsif (
+ $slot =~ /^Data::Dumper/
+ and
+ $weak_registry->{$slot}{stacktrace} =~ /\QDBIx::Class::ResultSource::_mk_row_parser/
+ ) {
+ # there should be only one D::D object (used to construct the rowparser)
+ # more would indicate trouble
+ delete $weak_registry->{$slot}
+ unless $cleared->{mk_row_parser_dd_singleton}++;
+ }
elsif (DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and $slot =~ /^__TxnScopeGuard__FIXUP__/) {
delete $weak_registry->{$slot}
}
push @objs, $tag->id; #warn "tag: ", $tag->ID;
}
-is_deeply( \@objs, [ 1 ], 'second cd has correct tags' );
+is_deeply( \@objs, [ 2, 5, 8 ], 'third cd has correct tags' );
$tags = $cds->next->tags;
@objs = ();
push @objs, $tag->id; #warn "tag: ", $tag->ID;
}
-is_deeply( \@objs, [ 2, 5, 8 ], 'third cd has correct tags' );
+is_deeply( \@objs, [ 1 ], 'second cd has correct tags' );
is( $queries, 0, 'no additional SQL statements while checking nested data' );
'prefetch properly collapses amount of rows from get_column',
);
+$rs->reset;
+my $pob_rs = $rs->search({}, {
+ select => ['me.title', 'tracks.title'],
+ prefetch => 'tracks',
+ order_by => [{-asc => ['position']}],
+ group_by => ['me.title', 'tracks.title'],
+});
+is_same_sql_bind (
+ $pob_rs->get_column("me.title")->as_query,
+ '(SELECT me.title FROM (SELECT me.title, tracks.title FROM cd me LEFT JOIN track tracks ON tracks.cd = me.cdid GROUP BY me.title, tracks.title ORDER BY position ASC) me)',
+ [],
+ 'Correct SQL for prefetch/order_by/group_by'
+);
+
done_testing;
ON producer_2.producerid = cd_to_producer_2.producer
JOIN artist artist ON artist.artistid = me.artist
WHERE ( ( producer.name = ? AND producer_2.name = ? ) )
- ORDER BY cd_to_producer.cd, producer_to_cd.producer
)',
[
- [ 'producer.name' => 'blah' ],
- [ 'producer_2.name' => 'foo' ],
+ [ { sqlt_datatype => 'varchar', dbic_colname => 'producer.name', sqlt_size => 100 }
+ => 'blah' ],
+ [ { sqlt_datatype => 'varchar', dbic_colname => 'producer_2.name', sqlt_size => 100 }
+ => 'foo' ],
],
);
throws_ok {
$artist_rs->first
- } qr/Can't locate object method "inflate_result" via package "IWillExplode"/,
+ } qr/\QInflator IWillExplode does not provide an inflate_result() method/,
'IWillExplode explodes on inflate';
my $cd_rs = $artist_rs->related_resultset('cds');
use lib qw(t/lib);
use DBICTest;
-plan tests => 2;
-
my $schema = DBICTest->init_schema();
-my $track_no_lyrics = $schema->resultset ('Track')
- ->search ({ 'lyrics.lyric_id' => undef }, { join => 'lyrics' })
- ->first;
-
-my $lyric = $track_no_lyrics->create_related ('lyrics', {
- lyric_versions => [
- { text => 'english doubled' },
- { text => 'english doubled' },
- ],
+my $link = $schema->resultset ('Link')->create ({
+ url => 'loldogs!',
+ bookmarks => [
+ { link => 'Mein Hund ist schwul'},
+ { link => 'Mein Hund ist schwul'},
+ ]
});
-is ($lyric->lyric_versions->count, 2, "Two identical has_many's created");
+is ($link->bookmarks->count, 2, "Two identical default-insert has_many's created");
-my $link = $schema->resultset ('Link')->create ({
+$link = $schema->resultset ('Link')->create ({
url => 'lolcats!',
bookmarks => [
{},
]
});
is ($link->bookmarks->count, 2, "Two identical default-insert has_many's created");
+
+done_testing;
use strict;
use warnings;
-use Data::Dumper;
-BEGIN { $Data::Dumper::Sortkeys = 1 }; # so we can compare the deparsed coderefs below
-
use Test::More;
use lib qw(t/lib);
use DBICTest;
push @$vals, shift @pairs;
}
-my $parser = $schema->source ('Artwork')->_mk_row_parser($as, 'collapse requested');
+=begin
+
+my $parser = $schema->source ('Artwork')->_mk_row_parser({
+ inflate_map => $as,
+ collapse => 1,
+});
is_deeply (
$parser->($vals),
'generated row parser works as expected',
);
+#=begin
+
undef $_ for ($as, $vals);
@pairs = (
'name' => 'Caterwauler McCrae',
'generated parser works as expected over missing joins (no collapse)',
);
+=cut
+
undef $_ for ($as, $vals);
@pairs = (
'tracks.lyrics.lyric_versions.text' => 'unique when combined with the lyric collapsable by the 1:1 tracks-parent',
is_deeply (
$schema->source ('CD')->_resolve_collapse ( { map { $as->[$_] => $_ } (0 .. $#$as) } ),
{
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- },
+ -node_index => 1,
+ -node_id => [ 1 ], # existing_single_track.cd.artist.artistid
+ -branch_id => [ 0, 1, 5, 6, 8 ],
existing_single_track => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- },
+ -node_index => 2,
+ -node_id => [ 1 ], # existing_single_track.cd.artist.artistid
+ -branch_id => [ 1, 6, 8 ],
+ -is_single => 1,
cd => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- },
+ -node_index => 3,
+ -node_id => [ 1 ], # existing_single_track.cd.artist.artistid
+ -branch_id => [ 1, 6, 8 ],
+ -is_single => 1,
artist => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- },
+ -node_index => 4,
+ -node_id => [ 1 ], # existing_single_track.cd.artist.artistid
+ -branch_id => [ 1, 6, 8 ],
+ -is_single => 1,
cds => {
- -collapse_on => {
- 'existing_single_track.cd.artist.cds.cdid' => 6,
- },
+ -node_index => 5,
+ -node_id => [ 6 ], # existing_single_track.cd.artist.cds.cdid
+ -branch_id => [ 6, 8 ],
+ -is_optional => 1,
tracks => {
- -collapse_on => {
- 'existing_single_track.cd.artist.cds.cdid' => 6,
- 'existing_single_track.cd.artist.cds.tracks.title' => 8,
- }
+ -node_index => 6,
+ -node_id => [ 6, 8 ], # existing_single_track.cd.artist.cds.cdid, existing_single_track.cd.artist.cds.tracks.title
+ -branch_id => [ 6, 8 ],
+ -is_optional => 1,
}
}
}
}
},
tracks => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- 'tracks.title' => 5,
- },
+ -node_index => 7,
+ -node_id => [ 1, 5 ], # existing_single_track.cd.artist.artistid, tracks.title
+ -branch_id => [ 0, 1, 5 ],
+ -is_optional => 1,
lyrics => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- 'tracks.title' => 5,
- },
+ -node_index => 8,
+ -node_id => [ 1, 5 ], # existing_single_track.cd.artist.artistid, tracks.title
+ -branch_id => [ 0, 1, 5 ],
+ -is_single => 1,
+ -is_optional => 1,
lyric_versions => {
- -collapse_on => {
- 'existing_single_track.cd.artist.artistid' => 1,
- 'tracks.title' => 5,
- 'tracks.lyrics.lyric_versions.text' => 0,
- },
+ -node_index => 9,
+ -node_id => [ 0, 1, 5 ], # tracks.lyrics.lyric_versions.text, existing_single_track.cd.artist.artistid, tracks.title
+ -branch_id => [ 0, 1, 5 ],
+ -is_optional => 1,
},
},
}
'Correct collapse map constructed',
);
+done_testing;
+__END__
+=cut
-$parser = $schema->source ('CD')->_mk_row_parser ($as, 'add collapse data');
+my $parser = $schema->source ('CD')->_mk_row_parser ({ inflate_map => $as, collapse => 1 });
+
+=begin
is_deeply (
$parser->($vals),
'Proper row parser constructed',
);
+=cut
+
# For extra insanity test/showcase the parser's guts:
my $deparser = B::Deparse->new;
is (
$deparser->coderef2text ($parser),
$deparser->coderef2text ( sub { package DBIx::Class::ResultSource;
+ my $rows = [];
+ while (1) {
+ my $r = (shift @{$_[0]->{row_stash}}) || ($_[0]->{next_row} and $_[0]->{next_row}->()) || last;
+
+ }
+ return $rows
+
+
[
{
genreid => $_[0][4],
LEFT JOIN track tracks
ON tracks.cd = me.cdid
WHERE me.artist != ?
- ORDER BY tracks.cd
)',
[
LEFT JOIN track tracks
ON tracks.cd = me.cdid
WHERE me.artist != ?
- ORDER BY tracks.cd
)',
[
LEFT JOIN track tracks ON tracks.cd = me.cdid
LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
WHERE ( me.cdid IS NOT NULL )
- ORDER BY track_count DESC, maxtr ASC, tracks.cd
+ ORDER BY track_count DESC, maxtr ASC
)',
[[$ROWS => 2]],
'next() query generated expected SQL',
ORDER BY cdid
) me
LEFT JOIN tags tags ON tags.cd = me.cdid
- ORDER BY cdid, tags.cd, tags.tag
+ ORDER BY cdid
)',
[],
'Prefetch + distinct resulted in correct group_by',
ORDER BY tags.tag ASC LIMIT ?)
me
LEFT JOIN tags tags ON tags.cd = me.cdid
- ORDER BY tags.tag ASC, tags.cd, tags.tag
+ ORDER BY tags.tag ASC
)
}, [[$ROWS => 1]]);
}
# only the requested me.name column will be fetched.
# reference sql with select => [...]
- # SELECT me.name, cds.title, cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track FROM ...
+ # SELECT me.name, cds.title, me.artistid, cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track FROM ...
my $rs = $schema->resultset('Artist')->search(
{ 'cds.title' => { '!=', 'Generic Manufactured Singles' } },
{
prefetch => [ qw/ cds / ],
order_by => [ { -desc => 'me.name' }, 'cds.title' ],
- select => [qw/ me.name cds.title / ],
+ select => [qw/ me.name cds.title me.artistid / ],
},
);
is ($we_are_goth->cds->first->title, 'Come Be Depressed With Us', 'Correct cd for artist');
}, 'explicit prefetch on a keyless object works');
-
lives_ok ( sub {
my $rs = $schema->resultset('CD')->search(
my @cds_and_tracks;
for my $cd ($rs->all) {
- my $data->{year} = $cd->year;
+ my $data = { year => $cd->year, cdid => $cd->cdid };
for my $tr ($cd->tracks->all) {
push @{$data->{tracks}}, { $tr->get_columns };
}
push @cds_and_tracks, $data;
}
- my $pref_rs = $rs->search ({}, { columns => ['year'], prefetch => 'tracks' });
+ my $pref_rs = $rs->search ({}, { columns => [qw/year cdid/], prefetch => 'tracks' });
my @pref_cds_and_tracks;
for my $cd ($pref_rs->all) {
sub {
$schema->resultset('Track')->search({}, { join => { cd => 'artist' }, '+columns' => 'artist.name' } )->next;
},
- qr|\QCan't inflate manual prefetch into non-existent relationship 'artist' from 'Track', check the inflation specification (columns/as) ending in 'artist.name'|,
+ qr|\QCan't inflate prefetch into non-existent relationship 'artist' from 'Track', check the inflation specification (columns/as) ending in '...artist.name'|,
'Sensible error message on mis-specified "as"',
);
JOIN artist artist ON artist.artistid = me.artist
LEFT JOIN cd cds ON cds.artist = artist.artistid
LEFT JOIN artist artist_2 ON artist_2.artistid = cds.artist
- ORDER BY cds.artist, cds.year ASC
)',
[],
);
use lib qw(t/lib);
use DBICTest;
-my $schema = DBICTest->init_schema();
+my $schema = DBICTest->init_schema(no_populate => 1);
+
+$schema->resultset('CD')->create({
+ title => 'Equinoxe',
+ year => 1978,
+ artist => { name => 'JMJ' },
+ genre => { name => 'electro' },
+ tracks => [
+ { title => 'e1' },
+ { title => 'e2' },
+ { title => 'e3' },
+ ],
+ single_track => {
+ title => 'o1',
+ cd => {
+ title => 'Oxygene',
+ year => 1976,
+ artist => {
+ name => 'JMJ',
+ cds => [
+ {
+ title => 'Magnetic Fields',
+ year => 1981,
+ genre => { name => 'electro' },
+ tracks => [
+ { title => 'm1' },
+ { title => 'm2' },
+ { title => 'm3' },
+ { title => 'm4' },
+ ],
+ },
+ ],
+ },
+ tracks => [
+ { title => 'o2', position => 2}, # the position should not be here, bug in MC
+ ],
+ },
+ },
+});
my $rs = $schema->resultset ('CD')->search ({}, {
join => [ 'tracks', { single_track => { cd => { artist => { cds => 'tracks' } } } } ],
{ 'single_track.cd.artist.cds.year' => 'cds.year' }, # non-unique
{ 'single_track.cd.artist.cds.genreid' => 'cds.genreid' }, # nullable
{ 'single_track.cd.artist.cds.tracks.title' => 'tracks_2.title' }, # unique when combined with ...cds.cdid above
- { 'latest_cd' => { max => 'cds.year' } }, # random function
+ { 'latest_cd' => \ "(SELECT MAX(year) FROM cd)" }, # random function
{ 'title' => 'me.title' }, # uniquiness for me
{ 'artist' => 'me.artist' }, # uniquiness for me
],
- result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ order_by => [{ -desc => 'cds.year' }, { -desc => 'me.title'} ],
});
-use Data::Dumper::Concise;
-die Dumper [$rs->all];
+my $hri_rs = $rs->search({}, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' });
+
+is_deeply (
+ [$hri_rs->all],
+ [
+ {
+ artist => 1,
+ genreid => 1,
+ latest_cd => 1981,
+ single_track => {
+ cd => {
+ artist => {
+ artistid => 1,
+ cds => [
+ {
+ cdid => 1,
+ genreid => 1,
+ tracks => [
+ {
+ title => "m1"
+ },
+ {
+ title => "m2"
+ },
+ {
+ title => "m3"
+ },
+ {
+ title => "m4"
+ }
+ ],
+ year => 1981
+ },
+ {
+ cdid => 3,
+ genreid => 1,
+ tracks => [
+ {
+ title => "e1"
+ },
+ {
+ title => "e2"
+ },
+ {
+ title => "e3"
+ }
+ ],
+ year => 1978
+ },
+ {
+ cdid => 2,
+ genreid => undef,
+ tracks => [
+ {
+ title => "o1"
+ },
+ {
+ title => "o2"
+ }
+ ],
+ year => 1976
+ }
+ ]
+ }
+ }
+ },
+ title => "Equinoxe",
+ tracks => [
+ {
+ title => "e1"
+ },
+ {
+ title => "e2"
+ },
+ {
+ title => "e3"
+ }
+ ],
+ year => 1978
+ },
+ {
+ artist => 1,
+ genreid => undef,
+ latest_cd => 1981,
+ single_track => undef,
+ title => "Oxygene",
+ tracks => [
+ {
+ title => "o1"
+ },
+ {
+ title => "o2"
+ }
+ ],
+ year => 1976
+ },
+ {
+ artist => 1,
+ genreid => 1,
+ latest_cd => 1981,
+ single_track => undef,
+ title => "Magnetic Fields",
+ tracks => [
+ {
+ title => "m1"
+ },
+ {
+ title => "m2"
+ },
+ {
+ title => "m3"
+ },
+ {
+ title => "m4"
+ }
+ ],
+ year => 1981
+ },
+ ],
+ 'W00T, manual prefetch with collapse works'
+);
+
+my $row = $rs->next;
+
+TODO: {
+ local $TODO = 'Something is wrong with filter type rels, they throw on incomplete objects >.<';
+
+ lives_ok {
+ is_deeply (
+ { $row->single_track->get_columns },
+ {},
+ 'empty intermediate object ok',
+ )
+ } 'no exception';
+}
+is ($rs->cursor->next, undef, 'cursor exhausted');
+done_testing;
],
result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+
+ order_by => [qw/tracks.position tracks.trackid producer.producerid/],
}
);
-
$schema->resultset('Artist')->create(
{
name => 'mo',
'single_track' => undef,
'tracks' => [
{
- 'small_dt' => undef,
'cd' => '6',
'position' => '1',
'trackid' => '19',
'last_updated_at' => undef
},
{
- 'small_dt' => undef,
'cd' => '6',
'position' => '2',
'trackid' => '20',
'last_updated_at' => undef
},
{
- 'small_dt' => undef,
'cd' => '6',
'position' => '3',
'trackid' => '21',
'last_updated_at' => undef
},
{
- 'small_dt' => undef,
'cd' => '6',
'position' => '4',
'trackid' => '22',
'year' => '2021',
'tracks' => [
{
- 'small_dt' => undef,
'cd' => '7',
'position' => '1',
'title' => 'singled out',
'last_updated_on' => undef
},
{
- 'small_dt' => undef,
'cd' => '7',
'position' => '2',
'title' => 'still alone',
{
'single_track' => undef,
'tracks' => [
- # FIXME
- # although the positional ordering is correct, SQLite seems to return
- # the rows randomly if an ORDER BY is not supplied. Of course ordering
- # by right side of prefetch joins is not yet possible, thus we just hope
- # that the order is stable
- {
- 'small_dt' => undef,
- 'cd' => '8',
- 'position' => '2',
- 'trackid' => '26',
- 'title' => 'Bar Foo',
- 'cd_single' => undef,
- 'last_updated_on' => undef,
- 'last_updated_at' => undef
- },
{
- 'small_dt' => undef,
'cd' => '8',
'position' => '1',
'trackid' => '25',
'cd_single' => undef,
},
{
- 'small_dt' => undef,
+ 'cd' => '8',
+ 'position' => '2',
+ 'trackid' => '26',
+ 'title' => 'Bar Foo',
+ 'cd_single' => undef,
+ 'last_updated_on' => undef,
+ 'last_updated_at' => undef
+ },
+ {
'cd' => '8',
'position' => '3',
'trackid' => '27',
'year' => '2020',
'tracks' => [
{
- 'small_dt' => undef,
'cd' => '9',
'position' => '1',
'title' => 'singled out',
'last_updated_on' => undef
},
{
- 'small_dt' => undef,
'cd' => '9',
'position' => '2',
'title' => 'still alone',
{ "$ar.rank" => 13 },
{
prefetch => [ 'tracks' ],
- order_by => [ { -asc => "$ar.name" }, "$ar.artistid DESC" ],
- offset => 3,
+ order_by => [ 'tracks.position DESC', { -asc => "$ar.name" }, "$ar.artistid DESC" ],
+ offset => 13,
rows => 3,
},
);
FROM artist me
JOIN cd cds_unordered
ON cds_unordered.artist = me.artistid
+ LEFT JOIN track tracks
+ ON tracks.cd = cds_unordered.cdid
WHERE ( me.rank = ? )
- ORDER BY me.name ASC, me.artistid DESC
+ ORDER BY tracks.position DESC, me.name ASC, me.artistid DESC
LIMIT ?
OFFSET ?
) cds_unordered
LEFT JOIN track tracks
ON tracks.cd = cds_unordered.cdid
WHERE ( me.rank = ? )
- ORDER BY me.name ASC, me.artistid DESC, tracks.cd
+ ORDER BY tracks.position DESC, me.name ASC, me.artistid DESC
)},
[
[ { sqlt_datatype => 'integer', dbic_colname => 'me.rank' } => 13 ],
[ $ROWS => 3 ],
- [ $OFFSET => 3 ],
+ [ $OFFSET => 13 ],
[ { sqlt_datatype => 'integer', dbic_colname => 'me.rank' } => 13 ],
],
'correct SQL on limited prefetch over search_related ordered by root',
'cd' => '4',
'last_updated_at' => undef,
'last_updated_on' => undef,
- 'position' => '1',
- 'title' => 'Boring Name',
- 'trackid' => '10'
+ 'position' => '3',
+ 'title' => 'No More Ideas',
+ 'trackid' => '12'
},
{
'cd' => '4',
'cd' => '4',
'last_updated_at' => undef,
'last_updated_on' => undef,
- 'position' => '3',
- 'title' => 'No More Ideas',
- 'trackid' => '12'
+ 'position' => '1',
+ 'title' => 'Boring Name',
+ 'trackid' => '10'
}
],
'year' => '2001'
'cd' => '5',
'last_updated_at' => undef,
'last_updated_on' => undef,
- 'position' => '1',
- 'title' => 'Sad',
- 'trackid' => '13'
- },
- {
- 'cd' => '5',
- 'last_updated_at' => undef,
- 'last_updated_on' => undef,
'position' => '3',
'title' => 'Suicidal',
'trackid' => '15'
'position' => '2',
'title' => 'Under The Weather',
'trackid' => '14'
+ },
+ {
+ 'cd' => '5',
+ 'last_updated_at' => undef,
+ 'last_updated_on' => undef,
+ 'position' => '1',
+ 'title' => 'Sad',
+ 'trackid' => '13'
}
],
'year' => '1998'
$schema->storage->debugcb(sub { $queries++ });
$schema->storage->debug(1);
-
my $pref = $schema->resultset ('Artist')
->search ({ 'me.artistid' => $artist->id }, { prefetch => { cds => 'genre' } })
->next;
is ($pref->cds->count, 3, 'Correct number of CDs prefetched');
is ($pref->cds->search_related ('genre')->count, 1, 'Only one of the prefetched cds has a prefetched genre');
-
is ($queries, 1, 'All happened within one query only');
$schema->storage->debugcb($orig_cb);
$schema->storage->debug(0);
-
done_testing;
WHERE artwork.cd_id IS NULL
OR tracks.title != ?
GROUP BY me.artistid + ?, me.artistid, me.name, cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track
- ORDER BY name DESC, cds.artist, cds.year ASC
+ ORDER BY name DESC
)',
[
$bind_int_resolved->(), # outer select
JOIN artist artist
ON artist.artistid = me.artist
WHERE ( ( artist.name = ? AND me.year = ? ) )
- ORDER BY tracks.cd
)',
[
[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'artist.name' } => 'foo' ],
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema(no_populate => 1);
+
+$schema->resultset('CD')->create({
+ title => 'Equinoxe',
+ year => 1978,
+ artist => { name => 'JMJ' },
+ genre => { name => 'electro' },
+ tracks => [
+ { title => 'e1' },
+ { title => 'e2' },
+ { title => 'e3' },
+ ],
+ single_track => {
+ title => 'o1',
+ cd => {
+ title => 'Oxygene',
+ year => 1976,
+ artist => {
+ name => 'JMJ',
+ cds => [
+ {
+ title => 'Magnetic Fields',
+ year => 1981,
+ genre => { name => 'electro' },
+ tracks => [
+ { title => 'm1' },
+ { title => 'm2' },
+ { title => 'm3' },
+ { title => 'm4' },
+ ],
+ },
+ ],
+ },
+ tracks => [
+ { title => 'o2', position => 2}, # the position should not be needed here, bug in MC
+ ],
+ },
+ },
+});
+
+{
+ package DBICTest::_IRCapture;
+ sub inflate_result { [@_[2,3]] };
+}
+
+is_deeply(
+ ([$schema->resultset ('CD')->search ({}, {
+ result_class => 'DBICTest::_IRCapture',
+ prefetch => { single_track => { cd => 'artist' } },
+ order_by => 'me.cdid',
+ })->all]),
+ [
+ [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { single_track => [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ {
+ artist => [
+ { artistid => undef, name => undef, charfield => undef, rank => undef }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { single_track => [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ {
+ artist => [
+ { artistid => undef, name => undef, charfield => undef, rank => undef }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { single_track => [
+ { trackid => 6, title => 'o1', position => 1, cd => 2, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ {
+ artist => [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ ],
+ 'Simple 1:1 descend with classic prefetch ok'
+);
+
+is_deeply(
+ [$schema->resultset ('CD')->search ({}, {
+ result_class => 'DBICTest::_IRCapture',
+ join => { single_track => { cd => 'artist' } },
+ columns => [
+ { 'year' => 'me.year' },
+ { 'genreid' => 'me.genreid' },
+ { 'single_track.cd.artist.artistid' => 'artist.artistid' },
+ { 'title' => 'me.title' },
+ { 'artist' => 'me.artist' },
+ ],
+ order_by => 'me.cdid',
+ })->all],
+ [
+ [
+ { artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { single_track => [
+ undef,
+ { cd => [
+ undef,
+ {
+ artist => [
+ { artistid => undef }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ [
+ { artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { single_track => [
+ undef,
+ { cd => [
+ undef,
+ {
+ artist => [
+ { artistid => undef }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ [
+ { artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { single_track => [
+ undef,
+ { cd => [
+ undef,
+ {
+ artist => [
+ { artistid => 1 }
+ ]
+ }
+ ] }
+ ] }
+ ],
+ ],
+ 'Simple 1:1 descend with missing selectors ok'
+);
+
+is_deeply(
+ ([$schema->resultset ('CD')->search ({}, {
+ result_class => 'DBICTest::_IRCapture',
+ prefetch => [ { single_track => { cd => { artist => { cds => 'tracks' } } } } ],
+ order_by => [qw/me.cdid tracks.trackid/],
+ })->all]),
+ [
+ [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { single_track => [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ {
+ artist => [
+ { artistid => undef, name => undef, charfield => undef, rank => undef },
+ { cds => [ [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ { tracks => [ [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ ] ] },
+ ]]},
+ ],
+ },
+ ] },
+ ] },
+ ],
+ [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { single_track => [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ {
+ artist => [
+ { artistid => undef, name => undef, charfield => undef, rank => undef },
+ { cds => [ [
+ { cdid => undef, single_track => undef, artist => undef, genreid => undef, year => undef, title => undef },
+ { tracks => [ [
+ { trackid => undef, title => undef, position => undef, cd => undef, last_updated_at => undef, last_updated_on => undef },
+ ] ] },
+ ]]},
+ ]
+ }
+ ] }
+ ] }
+ ],
+ [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { single_track => [
+ { trackid => 6, title => 'o1', position => 1, cd => 2, last_updated_at => undef, last_updated_on => undef },
+ { cd => [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ {
+ artist => [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { tracks => [
+ [ { trackid => 1, title => 'm1', position => 1, cd => 1, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 2, title => 'm2', position => 2, cd => 1, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 3, title => 'm3', position => 3, cd => 1, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 4, title => 'm4', position => 4, cd => 1, last_updated_at => undef, last_updated_on => undef } ],
+ ]},
+ ],
+ [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { tracks => [
+ [ { trackid => 5, title => 'o2', position => 2, cd => 2, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 6, title => 'o1', position => 1, cd => 2, last_updated_at => undef, last_updated_on => undef } ],
+ ]},
+ ],
+ [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { tracks => [
+ [ { trackid => 7, title => 'e1', position => 1, cd => 3, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 8, title => 'e2', position => 2, cd => 3, last_updated_at => undef, last_updated_on => undef } ],
+ [ { trackid => 9, title => 'e3', position => 3, cd => 3, last_updated_at => undef, last_updated_on => undef } ],
+ ]},
+ ],
+ ]},
+ ]
+ }
+ ] }
+ ] }
+ ],
+ ],
+ 'Collapsing 1:1 ending in chained has_many with classic prefetch ok'
+);
+
+is_deeply (
+ ([$schema->resultset ('Artist')->search ({}, {
+ result_class => 'DBICTest::_IRCapture',
+ join => { cds => 'tracks' },
+ '+columns' => [
+ (map { "cds.$_" } $schema->source('CD')->columns),
+ (map { +{ "cds.tracks.$_" => "tracks.$_" } } $schema->source('Track')->columns),
+ ],
+ order_by => [qw/cds.cdid tracks.trackid/],
+ })->all]),
+ [
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { tracks => [
+ { trackid => 1, title => 'm1', position => 1, cd => 1, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { tracks => [
+ { trackid => 2, title => 'm2', position => 2, cd => 1, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { tracks => [
+ { trackid => 3, title => 'm3', position => 3, cd => 1, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 1, single_track => undef, artist => 1, genreid => 1, year => 1981, title => "Magnetic Fields" },
+ { tracks => [
+ { trackid => 4, title => 'm4', position => 4, cd => 1, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { tracks => [
+ { trackid => 5, title => 'o2', position => 2, cd => 2, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 2, single_track => undef, artist => 1, genreid => undef, year => 1976, title => "Oxygene" },
+ { tracks => [
+ { trackid => 6, title => 'o1', position => 1, cd => 2, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { tracks => [
+ { trackid => 7, title => 'e1', position => 1, cd => 3, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { tracks => [
+ { trackid => 8, title => 'e2', position => 2, cd => 3, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ [
+ { artistid => 1, name => 'JMJ', charfield => undef, rank => 13 },
+ { cds => [
+ { cdid => 3, single_track => 6, artist => 1, genreid => 1, year => 1978, title => "Equinoxe" },
+ { tracks => [
+ { trackid => 9, title => 'e3', position => 3, cd => 3, last_updated_at => undef, last_updated_on => undef },
+ ]},
+ ]},
+ ],
+ ],
+ 'Non-Collapsing chained has_many ok'
+);
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff