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?a=commitdiff_plain;h=fe0708a2d68b5d34b6bc6f7e70164c3e569f1dd0;p=dbsrgits%2FDBIx-Class.git Merge branch 'master' into topic/constructor_rewrite --- fe0708a2d68b5d34b6bc6f7e70164c3e569f1dd0 diff --cc lib/DBIx/Class/ResultSet.pm index 39207b6,0d6906f..d8dcfca --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@@ -532,15 -807,29 +807,29 @@@ sub find # relationship } else { - my @unique_queries = $self->_unique_queries($input_query, $attrs); - $query = @unique_queries - ? [ map { $self->_add_alias($_, $alias) } @unique_queries ] - : $self->_add_alias($input_query, $alias); + # no key was specified - fall down to heuristics mode: + # run through all unique queries registered on the resultset, and + # 'OR' all qualifying queries together + my (@unique_queries, %seen_column_combinations); + for my $c_name ($rsrc->unique_constraint_names) { + next if $seen_column_combinations{ + join "\x00", sort $rsrc->unique_constraint_columns($c_name) + }++; + + push @unique_queries, try { + $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls') + } || (); + } + + $final_cond = @unique_queries + ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ] + : $self->_non_unique_find_fallback ($call_cond, $attrs) + ; } - # Run the query - my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs}); + # 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; @@@ -972,361 -1243,136 +1246,356 @@@ sub next 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; + - use List::MoreUtils; - my @rels = List::MoreUtils::uniq( keys %$rels, keys %$new_rels ); ++ 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 @@@ -1484,37 -1535,91 +1758,91 @@@ sub _count_subq_rs my ($self, $attrs) = @_; my $rsrc = $self->result_source; - $attrs ||= $self->_resolved_attrs_copy; + $attrs ||= $self->_resolved_attrs; my $sub_attrs = { %$attrs }; + # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it + delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/}; - # extra selectors do not go in the subquery and there is no point of ordering it - delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/; - - # if we multi-prefetch we group_by primary keys only as this is what we would + # 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->_pri_cols) ] + $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 ' + . 'has_many prefetch before count()' + ); + } ] } - $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $attrs); + # Calculate subquery selector + if (my $g = $sub_attrs->{group_by}) { - # this is so that the query can be simplified e.g. - # * ordering can be thrown away in things like Top limit - $sub_attrs->{-for_count_only} = 1; + my $sql_maker = $rsrc->storage->sql_maker; - my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs); + # necessary as the group_by may refer to aliased functions + my $sel_index; + for my $sel (@{$attrs->{select}}) { + $sel_index->{$sel->{-as}} = $sel + if (ref $sel eq 'HASH' and $sel->{-as}); + } - $attrs->{from} = [{ - -alias => 'count_subq', - -source_handle => $rsrc->handle, - count_subq => $sub_rs->as_query, - }]; + # anything from the original select mentioned on the group-by needs to make it to the inner selector + # also look for named aggregates referred in the having clause + # having often contains scalarrefs - thus parse it out entirely + my @parts = @$g; + if ($attrs->{having}) { + local $sql_maker->{having_bind}; + local $sql_maker->{quote_char} = $sql_maker->{quote_char}; + local $sql_maker->{name_sep} = $sql_maker->{name_sep}; + unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) { + $sql_maker->{quote_char} = [ "\x00", "\xFF" ]; + # if we don't unset it we screw up retarded but unfortunately working + # 'MAX(foo.bar)' => { '>', 3 } + $sql_maker->{name_sep} = ''; + } - # the subquery replaces this - delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/; + my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep); - return $self->_count_rs ($attrs); + my $sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }); + + # search for both a proper quoted qualified string, for a naive unquoted scalarref + # and if all fails for an utterly naive quoted scalar-with-function + while ($sql =~ / + $rquote $sep $lquote (.+?) $rquote + | + [\s,] \w+ \. (\w+) [\s,] + | + [\s,] $lquote (.+?) $rquote [\s,] + /gx) { + push @parts, ($1 || $2 || $3); # one of them matched if we got here + } + } + + for (@parts) { + my $colpiece = $sel_index->{$_} || $_; + + # unqualify join-based group_by's. Arcane but possible query + # also horrible horrible hack to alias a column (not a func.) + # (probably need to introduce SQLA syntax) + if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) { + my $as = $colpiece; + $as =~ s/\./__/; + $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) ); + } + push @{$sub_attrs->{select}}, $colpiece; + } + } + else { + my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns); + $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ]; + } + + return $rsrc->resultset_class + ->new ($rsrc, $sub_attrs) + ->as_subselect_rs + ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } }) + ->get_column ('count'); } sub _bool { @@@ -3189,9 -3435,15 +3660,17 @@@ sub _resolved_attrs } } - $attrs->{collapse} ||= {}; - if ($attrs->{prefetch}) { + # generate selections based on the prefetch helper - if ( my $prefetch = delete $attrs->{prefetch} ) { ++ 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 @@@ -3214,40 -3466,23 +3693,44 @@@ } } - 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 - $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ]; + if (@prefetch) { + my $sel_end = $#{$attrs->{select}}; + $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ]; + } - push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}}; + 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; + } } + # 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 # been doing diff --cc lib/DBIx/Class/ResultSetColumn.pm index ae704f9,c4efd0f..8a92b2f --- a/lib/DBIx/Class/ResultSetColumn.pm +++ b/lib/DBIx/Class/ResultSetColumn.pm @@@ -86,26 -94,13 +94,13 @@@ 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}) { - # scan for a constraint that would contain our column only - that'd be proof - # enough it is unique - my $constraints = { $rs->result_source->unique_constraints }; - for my $constraint_columns ( values %$constraints ) { - - next unless @$constraint_columns == 1; - - my $col = $constraint_columns->[0]; - my $fqcol = join ('.', $new_attrs->{alias}, $col); - - if ($col eq $select or $fqcol eq $select) { - $new_attrs->{group_by} = [ $select ]; - delete $new_attrs->{distinct}; # it is ignored when group_by is present - last; - } + if ($colmap->{$select} and $rsrc->_identifying_column_set([$colmap->{$select}])) { + $new_attrs->{group_by} = [ $select ]; + delete $new_attrs->{distinct}; # it is ignored when group_by is present } - - if (!$new_attrs->{group_by}) { + else { carp ( "Attempting to retrieve non-unique column '$column' on a resultset containing " . 'one-to-many joins will return duplicate results.' diff --cc lib/DBIx/Class/ResultSource.pm index 43419dc,2df04ca..31b7eec --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@@ -9,15 -7,28 +9,26 @@@ use DBIx::Class::ResultSet use DBIx::Class::ResultSourceHandle; use DBIx::Class::Exception; - use Carp::Clan qw/^DBIx::Class/; - - __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns - _columns _primaries _unique_constraints name resultset_attributes - schema from _relationships column_info_from_storage source_info - source_name sqlt_deploy_callback/); - - __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class - result_class/); + use DBIx::Class::Carp; + use DBIx::Class::GlobalDestruction; + use Try::Tiny; + 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 + _relationships resultset_attributes + column_info_from_storage + /); + + __PACKAGE__->mk_group_accessors(component_class => qw/ + resultset_class + result_class + /); + + __PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' ); =head1 NAME @@@ -1386,12 -1750,11 +1750,11 @@@ sub _resolve_condition # array of column names for each of those relationships. Column names are # 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) { + if (not defined $pre or not length $pre) { return (); } elsif( ref $pre eq 'ARRAY' ) { @@@ -1435,18 -1798,54 +1798,38 @@@ 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}}; - my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' - ? @{$rel_info->{attrs}{order_by}} - - : (defined $rel_info->{attrs}{order_by} - ? ($rel_info->{attrs}{order_by}) - : () - )); - push(@$order, map { "${as}.$_" } (@key, @ord)); ++ + push @$order, map { "${as}.$_" } @key; + + if (my $rel_order = $rel_info->{attrs}{order_by}) { + # this is kludgy and incomplete, I am well aware + # but the parent method is going away entirely anyway + # so sod it + my $sql_maker = $self->storage->sql_maker; + my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars; + my $sep = $sql_maker->name_sep; + + # install our own quoter, so we can catch unqualified stuff + local $sql_maker->{quote_char} = ["\x00", "\xFF"]; + + my $quoted_prefix = "\x00${as}\xFF"; + + for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) { + my @bind; + ($chunk, @bind) = @$chunk if ref $chunk; + + $chunk = "${quoted_prefix}${sep}${chunk}" + unless $chunk =~ /\Q$sep/; + + $chunk =~ s/\x00/$orig_ql/g; + $chunk =~ s/\xFF/$orig_qr/g; + push @$order, \[$chunk, @bind]; + } + } } return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } diff --cc lib/DBIx/Class/Row.pm index 16e7e59,1bfb38f..edc4b1c --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@@ -1090,8 -1148,44 +1148,31 @@@ sub inflate_result @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 $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'"); + } + 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 --cc lib/DBIx/Class/Storage/DBI.pm index 48e6785,b107d24..993748d --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@@ -1786,21 -2175,10 +2175,10 @@@ 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} ) || - # limited prefetch with RNO subqueries - ( - $attrs->{rows} - && - $sql_maker->limit_dialect eq 'RowNumberOver' - && - $attrs->{_prefetch_select} - && - @{$attrs->{_prefetch_select}} - ) - || - # grouped prefetch + # grouped prefetch (to satisfy group_by == select) ( $attrs->{group_by} && @{$attrs->{group_by}} diff --cc lib/DBIx/Class/Storage/DBIHacks.pm index 4b66c4e,ec6a32f..9f2a623 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@@ -74,7 -84,7 +84,7 @@@ sub _adjust_select_args_for_complex_pre # 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 --cc t/lib/DBICTest/Schema/CD.pm index 23cbcf9,0cbf55a..cb4cc3f --- a/t/lib/DBICTest/Schema/CD.pm +++ b/t/lib/DBICTest/Schema/CD.pm @@@ -42,13 -46,10 +46,13 @@@ __PACKAGE__->belongs_to( very_long_arti }); # in case this is a single-cd it promotes a track from another cd - __PACKAGE__->belongs_to( single_track => 'DBICTest::Schema::Track', 'single_track', - { join_type => 'left'} + __PACKAGE__->belongs_to( single_track => 'DBICTest::Schema::Track', 'single_track', + { 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 --cc t/prefetch/multiple_hasmany.t index 9c7bf38,a123208..31b2585 --- a/t/prefetch/multiple_hasmany.t +++ b/t/prefetch/multiple_hasmany.t @@@ -2,9 -2,9 +2,8 @@@ use strict use warnings; use Test::More; - use Test::Exception; use lib qw(t/lib); use DBICTest; -use IO::File; my $schema = DBICTest->init_schema(); my $sdebug = $schema->storage->debug;