From: Peter Rabbitson Date: Mon, 16 Apr 2012 01:01:03 +0000 (+0200) Subject: Merge branch 'master' into topic/constructor_rewrite X-Git-Tag: v0.08240~29 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=fe0708a2d68b5d34b6bc6f7e70164c3e569f1dd0;hp=4b8da207a3460216711d73987feaa13f7107ecc3 Merge branch 'master' into topic/constructor_rewrite --- diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 0d6906f..d8dcfca 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -829,7 +829,7 @@ sub find { # Run the query, passing the result_class since it should propagate for find my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); - if (keys %{$rs->_resolved_attrs->{collapse}}) { + if ($rs->_resolved_attrs->{collapse}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; return $row; @@ -1038,7 +1038,7 @@ sub single { my $attrs = $self->_resolved_attrs_copy; - if (keys %{$attrs->{collapse}}) { + if ($attrs->{collapse}) { $self->throw_exception( 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead' ); @@ -1061,7 +1061,10 @@ sub single { $attrs->{where}, $attrs ); - return (@data ? ($self->_construct_object(@data))[0] : undef); + return @data + ? ($self->_construct_objects(@data))[0] + : undef + ; } @@ -1238,141 +1241,361 @@ sub next { : $self->cursor->next ); return undef unless (@row); - my ($row, @more) = $self->_construct_object(@row); + my ($row, @more) = $self->_construct_objects(@row); $self->{stashed_objects} = \@more if @more; return $row; } -sub _construct_object { +# takes a single DBI-row of data and coinstructs as many objects +# as the resultset attributes call for. +# This can be a bit of an action at a distance - it takes as an argument +# the *current* cursor-row (already taken off the $sth), but if +# collapsing is requested it will keep advancing the cursor either +# 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, + }; + } + } + + - my $info = $self->_collapse_result($self->{_attrs}{as}, \@row) + $container = $res_index->{$main_ident}{container}; + }; + + push @$container, [ @{$me_pref_col}[0,1] ]; + + + + } 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); + } + } +=cut + + my $mepref_structs = $self->_collapse_result($attrs->{as}, \@row, $keep_collapsing) or return (); - my @new = $self->result_class->inflate_result($self->result_source, @$info); - @new = $self->{_attrs}{record_filter}->(@new) - if exists $self->{_attrs}{record_filter}; - return @new; + + 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); + + if (my $f = $attrs->{record_filter}) { + @objs = map { $f->($_) } @objs; + } + + return @objs; } + sub _collapse_result { - my ($self, $as_proto, $row) = @_; + 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 @copy = @$row; + my @row = @$row_ref; + do { + my $row = $parser->( \@row ); - # 'foo' => [ undef, 'foo' ] - # 'foo.bar' => [ 'foo', 'bar' ] - # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] + # init register + $self->_check_register( $register, $row ) unless ( keys %$register ); - my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; + $self->_merge_result( $result, $row, $rel_register ) + if ( !$collapse + || ( $collapse = $self->_check_register( $register, $row ) ) ); - my %collapse = %{$self->{_attrs}{collapse}||{}}; + } 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 + ); + return $result; +} - 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 +# 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; +} - # store just the index so we can check the array positions from the row - # without having to contruct the full hash +sub _merge_result { + my ( $self, $result, $row, $register ) = @_; + return @$result = @$row if ( @$result == 0 ); # initialize with $row - if (keys %collapse) { - my %pri = map { ($_ => 1) } $self->result_source->_pri_cols; - 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!) + 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. - # no need to do an if, it'll be empty if @pri_index is empty anyway +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]; - my %pri_vals = map { ($_ => $copy[$_]) } @pri_index; +} + +# _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 @const_rows; + 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; } + ); - do { # no need to check anything at the front, we always want the first row + die Dumper \@to_collapse; - my %const; - foreach my $this_as (@construct_as) { - $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); + # 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; + } - push(@const_rows, \%const); + # still didn't fully collapse + $self->throw_exception ('Resultset collapse failed (theoretically impossible). Maybe a wrong collapse_ident...?') + if (@to_collapse > 1); - } until ( # no pri_index => no collapse => drop straight out - !@pri_index - or - do { # get another row, stash it, drop out if different PK + return $to_collapse[0]; +} - @copy = $self->cursor->next; - $self->{stashed_row} = \@copy; - # last thing in do block, counts as true if anything doesn't match +# 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 ) = @_; - # check xor defined first for NULL vs. NOT NULL then if one is - # defined the other must be so check string equality + my $attrs = $self->_resolved_attrs; + my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/}; - grep { - (defined $pri_vals{$_} ^ defined $copy[$_]) - || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) - } @pri_index; - } - ); + die Dumper [$as_proto, $row_ref, $keep_collapsing, $set_ident ]; - my $alias = $self->{attrs}{alias}; - my $info = []; - my %collapse_pos; + my @cur_row = @$row_ref; + my (@to_collapse, $last_ident); - my @const_keys; + do { + my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) }; - 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}; - } - } + # 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 = 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; } - return $info; } =head2 result_source @@ -1543,7 +1766,7 @@ sub _count_subq_rs { # if we multi-prefetch we group_by something unique, as this is what we would # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless - if ( keys %{$attrs->{collapse}} ) { + if ( $attrs->{collapse} ) { $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{ $rsrc->_identifying_column_set || $self->throw_exception( 'Unable to construct a unique group_by criteria properly collapsing the ' @@ -1663,30 +1886,32 @@ sub all { $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); } - return @{ $self->get_cache } if $self->get_cache; + if (my $c = $self->get_cache) { + return @$c; + } - my @obj; + my @objects; - if (keys %{$self->_resolved_attrs->{collapse}}) { + 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_object to survive the approach + # _construct_objects to survive the approach $self->cursor->reset; my @row = $self->cursor->next; while (@row) { - push(@obj, $self->_construct_object(@row)); + push(@objects, $self->_construct_objects(@row)); @row = (exists $self->{stashed_row} ? @{delete $self->{stashed_row}} : $self->cursor->next); } } else { - @obj = map { $self->_construct_object(@$_) } $self->cursor->all; + @objects = map { $self->_construct_objects(@$_) } $self->cursor->all; } - $self->set_cache(\@obj) if $self->{attrs}{cache}; + $self->set_cache(\@objects) if $self->{attrs}{cache}; - return @obj; + return @objects; } =head2 reset @@ -3435,15 +3660,17 @@ sub _resolved_attrs { } } - $attrs->{collapse} ||= {}; - if ($attrs->{prefetch}) { + # generate selections based on the prefetch helper + my $prefetch; + $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) + if defined $attrs->{prefetch}; + + if ($prefetch) { $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") if $attrs->{_dark_selector}; - my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ); - - my $prefetch_ordering = []; + $attrs->{collapse} = 1; # this is a separate structure (we don't look in {from} directly) # as the resolver needs to shift things off the lists to work @@ -3466,8 +3693,7 @@ sub _resolved_attrs { } } - my @prefetch = - $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); + my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); # we need to somehow mark which columns came from prefetch if (@prefetch) { @@ -3477,9 +3703,31 @@ sub _resolved_attrs { push @{ $attrs->{select} }, (map { $_->[0] } @prefetch); push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); + } - push( @{$attrs->{order_by}}, @$prefetch_ordering ); - $attrs->{_collapse_order_by} = \@$prefetch_ordering; + # run through the resulting joinstructure (starting from our current slot) + # and unset collapse if proven unnesessary + if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') { + + if (@{$attrs->{from}} > 1) { + + # find where our table-spec starts and consider only things after us + my @fromlist = @{$attrs->{from}}; + while (@fromlist) { + my $t = shift @fromlist; + $t = $t->[0] if ref $t eq 'ARRAY'; #me vs join from-spec mismatch + last if ($t->{-alias} && $t->{-alias} eq $alias); + } + + for (@fromlist) { + $attrs->{collapse} = ! $_->[0]{-is_single} + and last; + } + } + else { + # no joins - no collapse + $attrs->{collapse} = 0; + } } diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm index c4efd0f..8a92b2f 100644 --- a/lib/DBIx/Class/ResultSetColumn.pm +++ b/lib/DBIx/Class/ResultSetColumn.pm @@ -94,7 +94,7 @@ sub new { # {collapse} would mean a has_many join was injected, which in turn means # we need to group *IF WE CAN* (only if the column in question is unique) - if (!$orig_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) { + if (!$orig_attrs->{group_by} && $orig_attrs->{collapse}) { if ($colmap->{$select} and $rsrc->_identifying_column_set([$colmap->{$select}])) { $new_attrs->{group_by} = [ $select ]; diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 2df04ca..31b7eec 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -3,6 +3,8 @@ package DBIx::Class::ResultSource; use strict; use warnings; +use base qw/DBIx::Class/; + use DBIx::Class::ResultSet; use DBIx::Class::ResultSourceHandle; @@ -14,8 +16,6 @@ use List::Util 'first'; use Scalar::Util qw/blessed weaken isweak/; use namespace::clean; -use base qw/DBIx::Class/; - __PACKAGE__->mk_group_accessors(simple => qw/ source_name name source_info _ordered_columns _columns _primaries _unique_constraints @@ -1751,7 +1751,7 @@ sub _resolve_condition { # prefixed relative to the current source, in accordance with where they appear # in the supplied relationships. sub _resolve_prefetch { - my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_; + my ($self, $pre, $alias, $alias_map, $order, $pref_path) = @_; $pref_path ||= []; if (not defined $pre or not length $pre) { @@ -1759,15 +1759,15 @@ sub _resolve_prefetch { } elsif( ref $pre eq 'ARRAY' ) { return - map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) } + map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, [ @$pref_path ] ) } @$pre; } elsif( ref $pre eq 'HASH' ) { my @ret = map { - $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ), + $self->_resolve_prefetch($_, $alias, $alias_map, $order, [ @$pref_path ] ), $self->related_source($_)->_resolve_prefetch( - $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] ) + $pre->{$_}, "${alias}.$_", $alias_map, $order, [ @$pref_path, $_] ) } keys %$pre; return @ret; } @@ -1798,27 +1798,11 @@ sub _resolve_prefetch { 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->_pri_cols ]; - # action at a distance. prepending the '.' allows simpler code - # in ResultSet->_collapse_result my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); } keys %{$rel_info->{cond}}; + push @$order, map { "${as}.$_" } @key; if (my $rel_order = $rel_info->{attrs}{order_by}) { @@ -1853,6 +1837,412 @@ sub _resolve_prefetch { } } +# 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) = @_; + + # for comprehensible error messages put ourselves at the head of the relationship chain + $rel_chain ||= [ $self->source_name ]; + + # record top-level fully-qualified column index + $as_fq_idx ||= { %$as }; + + my ($my_cols, $rel_cols); + for (keys %$as) { + if ($_ =~ /^ ([^\.]+) \. (.+) /x) { + $rel_cols->{$1}{$2} = 1; + } + else { + $my_cols->{$_} = {}; # important for ||= below + } + } + + my $relinfo; + # 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 $inf = $self->relationship_info ($rel); + + $relinfo->{$rel}{is_single} = $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi'; + $relinfo->{$rel}{is_inner} = ( $inf->{attrs}{join_type} || '' ) !~ /^left/i; + $relinfo->{$rel}{rsrc} = $rel_src; + + my $cond = $inf->{cond}; + + if ( + ref $cond eq 'HASH' + and + keys %$cond + and + ! List::Util::first { $_ !~ /^foreign\./ } (keys %$cond) + and + ! List::Util::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 + } + } + } + + # if the parent is already defined, assume all of its related FKs are selected + # (even if they in fact are NOT in the select list). Keep a record of what we + # assumed, and if any such phantom-column becomes part of our own collapser, + # throw everything assumed-from-parent away and replace with the collapser of + # the parent (whatever it may be) + my $assumed_from_parent; + unless ($parent_info->{underdefined}) { + $assumed_from_parent->{columns} = { map + # only add to the list if we do not already select said columns + { ! exists $my_cols->{$_} ? ( $_ => 1 ) : () } + values %{$parent_info->{rel_condition} || {}} + }; + + $my_cols->{$_} = { via_collapse => $parent_info->{collapse_on} } + for keys %{$assumed_from_parent->{columns}}; + } + + # get colinfo for everything + if ($my_cols) { + $my_cols->{$_}{colinfo} = ( + $self->has_column ($_) ? $self->column_info ($_) : undef + ) for keys %$my_cols; + } + + my $collapse_map; + + # try to resolve based on our columns (plus already inserted FK bridges) + if ( + $my_cols + and + my $uset = $self->_unique_column_set ($my_cols) + ) { + # 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} : {} }, + (map + { + my $fqc = join ('.', + @{$rel_chain}[1 .. $#$rel_chain], + ( $my_cols->{$_}{via_fk} || $_ ), + ); + + $fqc => $as_fq_idx->{$fqc}; + } + keys %$uset + ), + }; + } + + # 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}) { + my @candidates; + + for my $rel (keys %$relinfo) { + next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); + + if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse ( + $rel_cols->{$rel}, + $as_fq_idx, + [ @$rel_chain, $rel ], + { underdefined => 1 } + )) { + push @candidates, $rel_collapse->{-collapse_on}; + } + } + + # get the set with least amount of columns + # 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); + } + } + + # 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} + 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 + } + # nothing down the chain resolved - can't calculate a collapse-map + elsif (! $collapse_map->{-collapse_on}) { + $self->throw_exception ( sprintf + "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns", + $self->source_name, + @$rel_chain > 1 + ? sprintf (' (last member of the %s chain)', join ' -> ', @$rel_chain ) + : '' + , + ); + } + + + # 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->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ( + { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) }, + + $as_fq_idx, + + [ @$rel_chain, $rel], + + { + collapse_on => { %{$collapse_map->{-collapse_on}} }, + + rel_condition => $relinfo->{$rel}{fk_map}, + + # 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}, + }, + ); + } + + return $collapse_map; +} + +sub _unique_column_set { + my ($self, $cols) = @_; + + my %unique = $self->unique_constraints; + + # always prefer the PK first, and then shortest constraints first + USET: + for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) { + next unless $set && @$set; + + for (@$set) { + next USET unless ($cols->{$_} && $cols->{$_}{colinfo} && !$cols->{$_}{colinfo}{is_nullable} ); + } + + return { map { $_ => 1 } @$set }; + } + + return undef; +} + +# Takes an arrayref of {as} dbic column aliases and the collapse and select +# 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 +# ::ResultSet::_collapse_result. +# +# $me_pref_clps->[0] is always returned (even if as an empty hash with no +# rowdata), however branches of related data in $me_pref_clps->[1] may be +# pruned short of what was originally requested based on {as}, depending +# on: +# +# * If collapse is requested, a definitive collapse map is calculated for +# every relationship "fold-point", consisting of a set of values (which +# may not even be contained in the future 'me' of said relationship +# (for example a cd.artist_id defines the related inner-joined artist)). +# Thus a definedness check is carried on all collapse-condition values +# and if at least one is undef it is assumed that we are dealing with a +# NULLed right-side of a left-join, so we don't return a related data +# container at all, which implies no related objects +# +# * If we are not collapsing, there is no constraint on having a selector +# uniquely identifying all possible objects, and the user might have very +# well requested a column that just *happens* to be all NULLs. What we do +# in this case is fallback to the old behavior (which is a potential FIXME) +# by always returning a data container, but only filling it with columns +# IFF at least one of them is defined. This way we do not get an object +# with a bunch of has_column_loaded to undef, but at the same time do not +# further relationships based off this "null" object (e.g. in case the user +# deliberately skipped link-table values). I am pretty sure there are some +# tests that codify this behavior, need to find the exact testname. +# +# For an example of this coderef in action (and to see its guts) look at +# t/prefetch/_internals.t +# +# This is a huge performance win, as we call the same code for +# every row returned from the db, thus avoiding repeated method +# lookups when traversing relationships +# +# Also since the coderef is completely stateless (the returned structure is +# always fresh on every new invocation) this is a very good opportunity for +# memoization if further speed improvements are needed +# +# The way we construct this coderef is somewhat fugly, although I am not +# sure if the string eval is *that* bad of an idea. The alternative is to +# have a *very* large number of anon coderefs calling each other in a twisty +# maze, whereas the current result is a nice, smooth, single-pass function. +# In any case - the output of this thing is meticulously micro-tested, so +# any sort of rewrite should be relatively easy +# +sub _mk_row_parser { + my ($self, $as, $with_collapse, $select) = @_; + + my $as_indexed = { map + { $as->[$_] => $_ } + ( 0 .. $#$as ) + }; + + # calculate collapse fold-points if needed + my $collapse_on = do { + # 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); + + } if $with_collapse; + + 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; +} + +{ + my $visit_as_dumper; # keep our own DD object around so we don't have to fitz with quoting + + sub __visit_as { + my ($self, $as, $collapse_on, $known_defined) = @_; + $known_defined ||= {}; + + # 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} || {}} ); + + my $my_cols = {}; + my $rel_cols; + for (keys %$as) { + if ($_ =~ /^ ([^\.]+) \. (.+) /x) { + $rel_cols->{$1}{$2} = $as->{$_}; + } + else { + $my_cols->{$_} = $as->{$_}; + } + } + + 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}} + ) + ) + ; + } + + 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' + ; + + my $me = { + map { $_ => "__VALPOS__$my_cols->{$_}__" } (keys %$my_cols) + }; + + 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}; + + # 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 { + require Data::Dumper; + Data::Dumper->new([]) + ->Purity (1) + ->Pad ('') + ->Useqq (0) + ->Terse (1) + ->Quotekeys (1) + ->Deepcopy (1) + ->Deparse (0) + ->Maxdepth (0) + ->Indent (0) + }; + for ($me, $clps) { + $_ = $visit_as_dumper->Values ([$_])->Dump; + } + + 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 @rv_list = ($me, $rels, $clps); + pop @rv_list while ($rv_list[-1] eq 'undef'); # strip trailing undefs + + # 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); + } +} + =head2 related_source =over 4 diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 1bfb38f..edc4b1c 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -1173,19 +1173,6 @@ sub inflate_result { my @pre_objects; for my $me_pref (@pre_vals) { - - # FIXME - this should not be necessary - # the collapser currently *could* return bogus elements with all - # columns set to undef - my $has_def; - for (values %{$me_pref->[0]}) { - if (defined $_) { - $has_def++; - last; - } - } - next unless $has_def; - push @pre_objects, $pre_source->result_class->inflate_result( $pre_source, @$me_pref ); diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index b107d24..993748d 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -2175,8 +2175,8 @@ sub _select_args { # see if we need to tear the prefetch apart otherwise delegate the limiting to the # storage, unless software limit was requested if ( - #limited has_many - ( $attrs->{rows} && keys %{$attrs->{collapse}} ) + # limited collapsing has_many + ( $attrs->{rows} && $attrs->{collapse} ) || # grouped prefetch (to satisfy group_by == select) ( $attrs->{group_by} diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index ec6a32f..9f2a623 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -84,7 +84,7 @@ sub _adjust_select_args_for_complex_prefetch { # 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}} ) { + 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] ]; diff --git a/t/90join_torture.t b/t/90join_torture.t index 17d5116..0692c3a 100644 --- a/t/90join_torture.t +++ b/t/90join_torture.t @@ -3,34 +3,62 @@ use warnings; use Test::More; use Test::Exception; + use lib qw(t/lib); use DBICTest; use DBIC::SqlMakerTest; my $schema = DBICTest->init_schema(); - { - my $rs = $schema->resultset( 'CD' )->search( - { - 'producer.name' => 'blah', - 'producer_2.name' => 'foo', - }, - { - 'join' => [ - { cd_to_producer => 'producer' }, - { cd_to_producer => 'producer' }, - ], - 'prefetch' => [ - 'artist', - { cd_to_producer => 'producer' }, - ], - } - ); - - lives_ok { - my @rows = $rs->all(); - }; - } +lives_ok (sub { + my $rs = $schema->resultset( 'CD' )->search( + { + 'producer.name' => 'blah', + 'producer_2.name' => 'foo', + }, + { + 'join' => [ + { cd_to_producer => 'producer' }, + { cd_to_producer => 'producer' }, + ], + 'prefetch' => [ + 'artist', + { cd_to_producer => { producer => 'producer_to_cd' } }, + ], + } + ); + + my @executed = $rs->all(); + + is_same_sql_bind ( + $rs->as_query, + '( + SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, + artist.artistid, artist.name, artist.rank, artist.charfield, + cd_to_producer.cd, cd_to_producer.producer, cd_to_producer.attribute, + producer.producerid, producer.name, + producer_to_cd.cd, producer_to_cd.producer, producer_to_cd.attribute + FROM cd me + LEFT JOIN cd_to_producer cd_to_producer + ON cd_to_producer.cd = me.cdid + LEFT JOIN producer producer + ON producer.producerid = cd_to_producer.producer + LEFT JOIN cd_to_producer producer_to_cd + ON producer_to_cd.producer = producer.producerid + LEFT JOIN cd_to_producer cd_to_producer_2 + ON cd_to_producer_2.cd = me.cdid + LEFT JOIN producer producer_2 + 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' ], + ], + ); +}, 'Complex join parsed/executed properly'); my @rs1a_results = $schema->resultset("Artist")->search_related('cds', {title => 'Forkful of bees'}, {order_by => 'title'}); is($rs1a_results[0]->title, 'Forkful of bees', "bare field conditions okay after search related"); diff --git a/t/inflate/hri.t b/t/inflate/hri.t index eaf9128..1dca9c2 100644 --- a/t/inflate/hri.t +++ b/t/inflate/hri.t @@ -87,7 +87,7 @@ sub check_cols_of { my @dbic_reltable = $dbic_obj->$col; my @hashref_reltable = @{$datahashref->{$col}}; - is (scalar @dbic_reltable, scalar @hashref_reltable, 'number of related entries'); + is (scalar @hashref_reltable, scalar @dbic_reltable, 'number of related entries'); # for my $index (0..scalar @hashref_reltable) { for my $index (0..scalar @dbic_reltable) { diff --git a/t/lib/DBICTest/Schema/CD.pm b/t/lib/DBICTest/Schema/CD.pm index 0cbf55a..cb4cc3f 100644 --- a/t/lib/DBICTest/Schema/CD.pm +++ b/t/lib/DBICTest/Schema/CD.pm @@ -50,6 +50,9 @@ __PACKAGE__->belongs_to( single_track => 'DBICTest::Schema::Track', 'single_trac { join_type => 'left'} ); +# add a non-left single relationship for the complex prefetch tests +__PACKAGE__->belongs_to( existing_single_track => 'DBICTest::Schema::Track', 'single_track'); + __PACKAGE__->has_many( tracks => 'DBICTest::Schema::Track' ); __PACKAGE__->has_many( tags => 'DBICTest::Schema::Tag', undef, diff --git a/t/lib/DBICTest/Schema/LyricVersion.pm b/t/lib/DBICTest/Schema/LyricVersion.pm index 2a409ab..d497659 100644 --- a/t/lib/DBICTest/Schema/LyricVersion.pm +++ b/t/lib/DBICTest/Schema/LyricVersion.pm @@ -19,6 +19,7 @@ __PACKAGE__->add_columns( }, ); __PACKAGE__->set_primary_key('id'); +__PACKAGE__->add_unique_constraint ([qw/lyric_id text/]); __PACKAGE__->belongs_to('lyric', 'DBICTest::Schema::Lyrics', 'lyric_id'); 1; diff --git a/t/prefetch/_internals.t b/t/prefetch/_internals.t new file mode 100644 index 0000000..3de15e3 --- /dev/null +++ b/t/prefetch/_internals.t @@ -0,0 +1,390 @@ +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; +use B::Deparse; + + +my $schema = DBICTest->init_schema(no_deploy => 1); + +my ($as, $vals, @pairs); + +# artwork-artist deliberately mixed around +@pairs = ( + 'artwork_to_artist.artist_id' => '2', + + 'cd_id' => '1', + + 'artwork_to_artist.artwork_cd_id' => '1', + + 'cd.artist' => '1', + 'cd.cdid' => '1', + 'cd.title' => 'Spoonful of bees', + + 'cd.artist.artistid' => '7', + 'cd.artist.name' => 'Caterwauler McCrae', + 'artwork_to_artist.artist.name' => 'xenowhinycide', +); +while (@pairs) { + push @$as, shift @pairs; + push @$vals, shift @pairs; +} + +my $parser = $schema->source ('Artwork')->_mk_row_parser($as, 'collapse requested'); + +is_deeply ( + $parser->($vals), + [ + { + cd_id => 1, + }, + + { + artwork_to_artist => [ + { + artist_id => 2, + artwork_cd_id => 1, + }, + { + artist => [ + { + name => 'xenowhinycide', + }, + undef, + [ 2, 1 ], # inherited from artwork_to_artist (child-parent definition) + ], + }, + [ 2, 1 ] # artwork_to_artist own data, in selection order + ], + + cd => [ + { + artist => 1, + cdid => 1, + title => 'Spoonful of bees', + }, + { + artist => [ + { + artistid => 7, + name => 'Caterwauler McCrae', + }, + undef, + [ 7 ], # our own id + ] + }, + [ 1 ], # our cdid fk + ] + }, + [ 1 ], # our id + ], + 'generated row parser works as expected', +); + +undef $_ for ($as, $vals); +@pairs = ( + 'name' => 'Caterwauler McCrae', + 'cds.tracks.cd' => '3', + 'cds.tracks.title' => 'Fowlin', + 'cds.tracks.cd_single.title' => 'Awesome single', +); +while (@pairs) { + push @$as, shift @pairs; + push @$vals, shift @pairs; +} +$parser = $schema->source ('Artist')->_mk_row_parser($as); + +is_deeply ( + $parser->($vals), + [ + { + name => 'Caterwauler McCrae' + }, + { + cds => [ + {}, + { + tracks => [ + { + cd => 3, + title => 'Fowlin' + }, + { + cd_single => [ + { + title => 'Awesome single', + }, + ], + }, + ] + } + ] + } + ], + 'generated parser works as expected over missing joins (no collapse)', +); + +undef $_ for ($as, $vals); +@pairs = ( + 'tracks.lyrics.lyric_versions.text' => 'unique when combined with the lyric collapsable by the 1:1 tracks-parent', + 'existing_single_track.cd.artist.artistid' => 'artist_id (gives uniq. to its entire parent chain)', + 'existing_single_track.cd.artist.cds.year' => 'non-unique cds col (year)', + 'year' => 'non unique main year', + 'genreid' => 'non-unique/nullable main genid', + 'tracks.title' => 'non-unique title (missing multicol const. part)', + 'existing_single_track.cd.artist.cds.cdid' => 'cds unique id col to give uniquiness to ...tracks.title below', + 'latest_cd' => 'random function (not a colname)', + 'existing_single_track.cd.artist.cds.tracks.title' => 'unique track title (when combined with ...cds.cdid above)', + 'existing_single_track.cd.artist.cds.genreid' => 'nullable cds col (genreid)', +); +while (@pairs) { + push @$as, shift @pairs; + push @$vals, shift @pairs; +} + +is_deeply ( + $schema->source ('CD')->_resolve_collapse ( { map { $as->[$_] => $_ } (0 .. $#$as) } ), + { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + }, + + existing_single_track => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + }, + + cd => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + }, + + artist => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + }, + + cds => { + -collapse_on => { + 'existing_single_track.cd.artist.cds.cdid' => 6, + }, + + tracks => { + -collapse_on => { + 'existing_single_track.cd.artist.cds.cdid' => 6, + 'existing_single_track.cd.artist.cds.tracks.title' => 8, + } + } + } + } + } + }, + tracks => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + 'tracks.title' => 5, + }, + + lyrics => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + 'tracks.title' => 5, + }, + + lyric_versions => { + -collapse_on => { + 'existing_single_track.cd.artist.artistid' => 1, + 'tracks.title' => 5, + 'tracks.lyrics.lyric_versions.text' => 0, + }, + }, + }, + } + }, + 'Correct collapse map constructed', +); + + +$parser = $schema->source ('CD')->_mk_row_parser ($as, 'add collapse data'); + +is_deeply ( + $parser->($vals), + [ + { + latest_cd => 'random function (not a colname)', + year => 'non unique main year', + genreid => 'non-unique/nullable main genid' + }, + { + existing_single_track => [ + {}, + { + cd => [ + {}, + { + artist => [ + { artistid => 'artist_id (gives uniq. to its entire parent chain)' }, + { + cds => [ + { + cdid => 'cds unique id col to give uniquiness to ...tracks.title below', + year => 'non-unique cds col (year)', + genreid => 'nullable cds col (genreid)' + }, + { + tracks => [ + { + title => 'unique track title (when combined with ...cds.cdid above)' + }, + undef, + [ + 'cds unique id col to give uniquiness to ...tracks.title below', + 'unique track title (when combined with ...cds.cdid above)', + ], + ] + }, + [ 'cds unique id col to give uniquiness to ...tracks.title below' ], + ] + }, + [ 'artist_id (gives uniq. to its entire parent chain)' ], + ] + }, + [ 'artist_id (gives uniq. to its entire parent chain)' ], + ] + }, + [ 'artist_id (gives uniq. to its entire parent chain)' ], + ], + tracks => [ + { + title => 'non-unique title (missing multicol const. part)' + }, + { + lyrics => [ + {}, + { + lyric_versions => [ + { + text => 'unique when combined with the lyric collapsable by the 1:1 tracks-parent', + }, + undef, + [ + 'unique when combined with the lyric collapsable by the 1:1 tracks-parent', + 'artist_id (gives uniq. to its entire parent chain)', + 'non-unique title (missing multicol const. part)', + ], + ], + }, + [ + 'artist_id (gives uniq. to its entire parent chain)', + 'non-unique title (missing multicol const. part)', + ], + ], + }, + [ + 'artist_id (gives uniq. to its entire parent chain)', + 'non-unique title (missing multicol const. part)', + ], + ], + }, + [ 'artist_id (gives uniq. to its entire parent chain)' ], + ], + 'Proper row parser constructed', +); + +# 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; + [ + { + genreid => $_[0][4], + latest_cd => $_[0][7], + year => $_[0][3] + }, + { + + existing_single_track => [ + {}, + { + cd => [ + {}, + { + artist => [ + { + artistid => $_[0][1] + }, + { + + !defined($_[0][6]) ? () : ( + cds => [ + { + cdid => $_[0][6], + genreid => $_[0][9], + year => $_[0][2] + }, + { + + !defined($_[0][8]) ? () : ( + tracks => [ + { + title => $_[0][8] + }, + undef, + [ $_[0][6], $_[0][8] ] + ]) + + }, + [ $_[0][6] ] + ]), + + }, + [ $_[0][1] ], + ], + }, + [ $_[0][1] ], + ], + }, + [ $_[0][1] ], + ], + + !defined($_[0][5]) ? () : ( + tracks => [ + { + title => $_[0][5], + }, + { + + lyrics => [ + {}, + { + + !defined($_[0][0]) ? () : ( + lyric_versions => [ + { + text => $_[0][0] + }, + undef, + [ $_[0][0], $_[0][1], $_[0][5] ], + ]), + + }, + [ $_[0][1], $_[0][5] ], + ], + + }, + [ $_[0][1], $_[0][5] ], + ]), + }, + [ $_[0][1] ], + ]; + }), + 'Deparsed version of the parser coderef looks correct', +); + +done_testing; diff --git a/t/prefetch/incomplete.t b/t/prefetch/incomplete.t index c2a2b15..36f259f 100644 --- a/t/prefetch/incomplete.t +++ b/t/prefetch/incomplete.t @@ -21,7 +21,7 @@ lives_ok(sub { prefetch => [ qw/ cds / ], order_by => [ { -desc => 'me.name' }, 'cds.title' ], select => [qw/ me.name cds.title / ], - } + }, ); is ($rs->count, 2, 'Correct number of collapsed artists'); @@ -32,6 +32,57 @@ lives_ok(sub { }, 'explicit prefetch on a keyless object works'); +lives_ok ( sub { + + my $rs = $schema->resultset('CD')->search( + {}, + { + order_by => [ { -desc => 'me.year' } ], + } + ); + my $years = [qw/ 2001 2001 1999 1998 1997/]; + + is_deeply ( + [ $rs->search->get_column('me.year')->all ], + $years, + 'Expected years (at least one duplicate)', + ); + + my @cds_and_tracks; + for my $cd ($rs->all) { + my $data->{year} = $cd->year; + 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_cds_and_tracks; + for my $cd ($pref_rs->all) { + my $data = { $cd->get_columns }; + for my $tr ($cd->tracks->all) { + push @{$data->{tracks}}, { $tr->get_columns }; + } + push @pref_cds_and_tracks, $data; + } + + is_deeply ( + \@pref_cds_and_tracks, + \@cds_and_tracks, + 'Correct collapsing on non-unique primary object' + ); + + is_deeply ( + [ $pref_rs->search ({}, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' })->all ], + \@cds_and_tracks, + 'Correct HRI collapsing on non-unique primary object' + ); + +}, 'weird collapse lives'); + + lives_ok(sub { # test implicit prefetch as well diff --git a/t/prefetch/manual.t b/t/prefetch/manual.t new file mode 100644 index 0000000..9502421 --- /dev/null +++ b/t/prefetch/manual.t @@ -0,0 +1,33 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; + +my $schema = DBICTest->init_schema(); + +my $rs = $schema->resultset ('CD')->search ({}, { + join => [ 'tracks', { single_track => { cd => { artist => { cds => 'tracks' } } } } ], + collapse => 1, + columns => [ + { 'year' => 'me.year' }, # non-unique + { 'genreid' => 'me.genreid' }, # nullable + { 'tracks.title' => 'tracks.title' }, # non-unique (no me.id) + { 'single_track.cd.artist.cds.cdid' => 'cds.cdid' }, # to give uniquiness to ...tracks.title below + { 'single_track.cd.artist.artistid' => 'artist.artistid' }, # uniqufies entire parental chain + { '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 + { 'title' => 'me.title' }, # uniquiness for me + { 'artist' => 'me.artist' }, # uniquiness for me + ], + result_class => 'DBIx::Class::ResultClass::HashRefInflator', +}); + +use Data::Dumper::Concise; +die Dumper [$rs->all]; + + diff --git a/t/prefetch/multiple_hasmany.t b/t/prefetch/multiple_hasmany.t index a123208..31b2585 100644 --- a/t/prefetch/multiple_hasmany.t +++ b/t/prefetch/multiple_hasmany.t @@ -4,98 +4,80 @@ use warnings; use Test::More; use lib qw(t/lib); use DBICTest; -use IO::File; my $schema = DBICTest->init_schema(); my $sdebug = $schema->storage->debug; -# once the following TODO is complete, remove the 2 warning tests immediately -# after the TODO block -# (the TODO block itself contains tests ensuring that the warns are removed) -TODO: { - local $TODO = 'Prefetch of multiple has_many rels at the same level (currently warn to protect the clueless git)'; +#( 1 -> M + M ) +my $cd_rs = $schema->resultset('CD')->search( { 'me.title' => 'Forkful of bees' } ); +my $pr_cd_rs = $cd_rs->search( {}, { prefetch => [qw/tracks tags/], } ); - #( 1 -> M + M ) - my $cd_rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' }); - my $pr_cd_rs = $cd_rs->search ({}, { - prefetch => [qw/tracks tags/], - }); +my $tracks_rs = $cd_rs->first->tracks; +my $tracks_count = $tracks_rs->count; - my $tracks_rs = $cd_rs->first->tracks; - my $tracks_count = $tracks_rs->count; +my ( $pr_tracks_rs, $pr_tracks_count ); - my ($pr_tracks_rs, $pr_tracks_count); +my $queries = 0; +$schema->storage->debugcb( sub { $queries++ } ); +$schema->storage->debug(1); - my $queries = 0; - $schema->storage->debugcb(sub { $queries++ }); - $schema->storage->debug(1); - - my $o_mm_warn; - { - local $SIG{__WARN__} = sub { $o_mm_warn = shift }; - $pr_tracks_rs = $pr_cd_rs->first->tracks; - }; - $pr_tracks_count = $pr_tracks_rs->count; - - ok(! $o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)'); - - is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query'); - $schema->storage->debugcb (undef); - $schema->storage->debug ($sdebug); - - is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)'); - is ($pr_tracks_rs->all, $tracks_rs->all, 'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)'); - - #( M -> 1 -> M + M ) - my $note_rs = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' }); - my $pr_note_rs = $note_rs->search ({}, { - prefetch => { - cd => [qw/tracks tags/] - }, - }); - - my $tags_rs = $note_rs->first->cd->tags; - my $tags_count = $tags_rs->count; - - my ($pr_tags_rs, $pr_tags_count); - - $queries = 0; - $schema->storage->debugcb(sub { $queries++ }); - $schema->storage->debug(1); - - my $m_o_mm_warn; - { - local $SIG{__WARN__} = sub { $m_o_mm_warn = shift }; - $pr_tags_rs = $pr_note_rs->first->cd->tags; - }; - $pr_tags_count = $pr_tags_rs->count; - - ok(! $m_o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)'); - - is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query'); - $schema->storage->debugcb (undef); - $schema->storage->debug ($sdebug); - - is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)'); - is($pr_tags_rs->all, $tags_rs->all, 'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)'); -} - -# remove this closure once the TODO above is working +my $o_mm_warn; { - my $warn_re = qr/will explode the number of row objects retrievable via/; - - my (@w, @dummy); - local $SIG{__WARN__} = sub { $_[0] =~ $warn_re ? push @w, @_ : warn @_ }; - - my $rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' }, { prefetch => [qw/tracks tags/] }); - @w = (); - @dummy = $rs->first; - is (@w, 1, 'warning on attempt prefetching several same level has_manys (1 -> M + M)'); - - my $rs2 = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' }, { prefetch => { cd => [qw/tags tracks/] } }); - @w = (); - @dummy = $rs2->first; - is (@w, 1, 'warning on attempt prefetching several same level has_manys (M -> 1 -> M + M)'); -} + local $SIG{__WARN__} = sub { $o_mm_warn = shift }; + $pr_tracks_rs = $pr_cd_rs->first->tracks; +}; +$pr_tracks_count = $pr_tracks_rs->count; + +ok( !$o_mm_warn, +'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)' +); + +is( $queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query' ); +$schema->storage->debugcb(undef); +$schema->storage->debug($sdebug); + +is( $pr_tracks_count, $tracks_count, +'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)' +); +is( $pr_tracks_rs->all, $tracks_rs->all, +'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)' +); + +#( M -> 1 -> M + M ) +my $note_rs = + $schema->resultset('LinerNotes')->search( { notes => 'Buy Whiskey!' } ); +my $pr_note_rs = + $note_rs->search( {}, { prefetch => { cd => [qw/tracks tags/] }, } ); + +my $tags_rs = $note_rs->first->cd->tags; +my $tags_count = $tags_rs->count; + +my ( $pr_tags_rs, $pr_tags_count ); + +$queries = 0; +$schema->storage->debugcb( sub { $queries++ } ); +$schema->storage->debug(1); + +my $m_o_mm_warn; +{ + local $SIG{__WARN__} = sub { $m_o_mm_warn = shift }; + $pr_tags_rs = $pr_note_rs->first->cd->tags; +}; +$pr_tags_count = $pr_tags_rs->count; + +ok( !$m_o_mm_warn, +'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)' +); + +is( $queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query' ); +$schema->storage->debugcb(undef); +$schema->storage->debug($sdebug); + +is( $pr_tags_count, $tags_count, +'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)' +); +is( $pr_tags_rs->all, $tags_rs->all, +'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)' +); done_testing; diff --git a/t/prefetch/multiple_hasmany_torture.t b/t/prefetch/multiple_hasmany_torture.t new file mode 100644 index 0000000..973df8b --- /dev/null +++ b/t/prefetch/multiple_hasmany_torture.t @@ -0,0 +1,303 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; + +my $schema = DBICTest->init_schema(); + +my $mo_rs = $schema->resultset('Artist')->search( + { 'me.artistid' => 4 }, + { + prefetch => [ + { + cds => [ + { tracks => { cd_single => 'tracks' } }, + { cd_to_producer => 'producer' } + ] + }, + { artwork_to_artist => 'artwork' } + ], + + result_class => 'DBIx::Class::ResultClass::HashRefInflator', + } +); + + +$schema->resultset('Artist')->create( + { + name => 'mo', + rank => '1337', + cds => [ + { + title => 'Song of a Foo', + year => '1999', + tracks => [ + { + title => 'Foo Me Baby One More Time', + }, + { + title => 'Foo Me Baby One More Time II', + }, + { + title => 'Foo Me Baby One More Time III', + }, + { + title => 'Foo Me Baby One More Time IV', + cd_single => + { artist => 1, title => 'MO! Single', year => 2021, tracks => [ + { title => 'singled out' }, { title => 'still alone' }, + ] }, + } + ], + cd_to_producer => [ + { producer => { name => 'riba' } }, + { producer => { name => 'sushi' } }, + ] + }, + { + title => 'Song of a Foo II', + year => '2002', + tracks => [ + { + title => 'Quit Playing Games With My Heart', + }, + { + title => 'Bar Foo', + }, + { + title => 'Foo Bar', + cd_single => + { artist => 2, title => 'MO! Single', year => 2020, tracks => [ + { title => 'singled out' }, { title => 'still alone' }, + ] }, + } + ], + cd_to_producer => [ + { producer => { name => 'riba' } }, + { producer => { name => 'sushi' } }, + ], + } + ], + artwork_to_artist => + [ { artwork => { cd_id => 1 } }, { artwork => { cd_id => 2 } } ] + } +); + +my $mo = $mo_rs->next; + +is( @{$mo->{cds}}, 2, 'two CDs' ); + +is_deeply( + $mo, + { + 'cds' => [ + { + 'single_track' => undef, + 'tracks' => [ + { + 'small_dt' => undef, + 'cd' => '6', + 'position' => '1', + 'trackid' => '19', + 'title' => 'Foo Me Baby One More Time', + 'cd_single' => undef, + 'last_updated_on' => undef, + 'last_updated_at' => undef + }, + { + 'small_dt' => undef, + 'cd' => '6', + 'position' => '2', + 'trackid' => '20', + 'title' => 'Foo Me Baby One More Time II', + 'cd_single' => undef, + 'last_updated_on' => undef, + 'last_updated_at' => undef + }, + { + 'small_dt' => undef, + 'cd' => '6', + 'position' => '3', + 'trackid' => '21', + 'title' => 'Foo Me Baby One More Time III', + 'cd_single' => undef, + 'last_updated_on' => undef, + 'last_updated_at' => undef + }, + { + 'small_dt' => undef, + 'cd' => '6', + 'position' => '4', + 'trackid' => '22', + 'title' => 'Foo Me Baby One More Time IV', + 'last_updated_on' => undef, + 'last_updated_at' => undef, + 'cd_single' => { + 'single_track' => '22', + 'artist' => '1', + 'cdid' => '7', + 'title' => 'MO! Single', + 'genreid' => undef, + 'year' => '2021', + 'tracks' => [ + { + 'small_dt' => undef, + 'cd' => '7', + 'position' => '1', + 'title' => 'singled out', + 'trackid' => '23', + 'last_updated_at' => undef, + 'last_updated_on' => undef + }, + { + 'small_dt' => undef, + 'cd' => '7', + 'position' => '2', + 'title' => 'still alone', + 'trackid' => '24', + 'last_updated_at' => undef, + 'last_updated_on' => undef + }, + ], + }, + } + ], + 'artist' => '4', + 'cdid' => '6', + 'cd_to_producer' => [ + { + 'attribute' => undef, + 'cd' => '6', + 'producer' => { + 'name' => 'riba', + 'producerid' => '4' + } + }, + { + 'attribute' => undef, + 'cd' => '6', + 'producer' => { + 'name' => 'sushi', + 'producerid' => '5' + } + } + ], + 'title' => 'Song of a Foo', + 'genreid' => undef, + 'year' => '1999' + }, + { + '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', + 'title' => 'Quit Playing Games With My Heart', + 'last_updated_on' => undef, + 'last_updated_at' => undef, + 'cd_single' => undef, + }, + { + 'small_dt' => undef, + 'cd' => '8', + 'position' => '3', + 'trackid' => '27', + 'title' => 'Foo Bar', + 'last_updated_on' => undef, + 'last_updated_at' => undef, + 'cd_single' => { + 'single_track' => '27', + 'artist' => '2', + 'cdid' => '9', + 'title' => 'MO! Single', + 'genreid' => undef, + 'year' => '2020', + 'tracks' => [ + { + 'small_dt' => undef, + 'cd' => '9', + 'position' => '1', + 'title' => 'singled out', + 'trackid' => '28', + 'last_updated_at' => undef, + 'last_updated_on' => undef + }, + { + 'small_dt' => undef, + 'cd' => '9', + 'position' => '2', + 'title' => 'still alone', + 'trackid' => '29', + 'last_updated_at' => undef, + 'last_updated_on' => undef + }, + ], + + }, + }, + ], + 'artist' => '4', + 'cdid' => '8', + 'cd_to_producer' => [ + { + 'attribute' => undef, + 'cd' => '8', + 'producer' => { + 'name' => 'riba', + 'producerid' => '4' + } + }, + { + 'attribute' => undef, + 'cd' => '8', + 'producer' => { + 'name' => 'sushi', + 'producerid' => '5' + } + } + ], + 'title' => 'Song of a Foo II', + 'genreid' => undef, + 'year' => '2002' + } + ], + 'artistid' => '4', + 'charfield' => undef, + 'name' => 'mo', + 'artwork_to_artist' => [ + { + 'artwork' => { 'cd_id' => '1' }, + 'artist_id' => '4', + 'artwork_cd_id' => '1' + }, + { + 'artwork' => { 'cd_id' => '2' }, + 'artist_id' => '4', + 'artwork_cd_id' => '2' + } + ], + 'rank' => '1337' + } +); + +done_testing;