X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=5e4b8b5487da4e8bf0f3a4c40420a959d1504c57;hp=f060d4558bb95304bb763db1b5e073da95b416eb;hb=1605376709663b035385b41828ce13ae3ed45a4d;hpb=47a435d239f7a6d8b5770698e6ae785c2f56b66a diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index f060d45..5e4b8b5 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -6,7 +6,6 @@ use base qw/DBIx::Class/; use Carp::Clan qw/^DBIx::Class/; use DBIx::Class::Exception; use Data::Page; -use Storable; use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultSourceHandle; use Hash::Merge (); @@ -22,6 +21,7 @@ use namespace::clean; BEGIN { # De-duplication in _merge_attr() is disabled, but left in for reference + # (the merger is used for other things that ought not to be de-duped) *__HM_DEDUP = sub () { 0 }; } @@ -30,7 +30,7 @@ use overload 'bool' => "_bool", fallback => 1; -__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/); +__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/); =head1 NAME @@ -196,8 +196,8 @@ sub new { return $class->new_result(@_) if ref $class; my ($source, $attrs) = @_; - $source = $source->handle - unless $source->isa('DBIx::Class::ResultSourceHandle'); + $source = $source->resolve + if $source->isa('DBIx::Class::ResultSourceHandle'); $attrs = { %{$attrs||{}} }; if ($attrs->{page}) { @@ -206,22 +206,18 @@ sub new { $attrs->{alias} ||= 'me'; - # Creation of {} and bless separated to mitigate RH perl bug - # see https://bugzilla.redhat.com/show_bug.cgi?id=196836 - my $self = { - _source_handle => $source, + my $self = bless { + result_source => $source, cond => $attrs->{where}, pager => undef, - attrs => $attrs - }; - - bless $self, $class; + attrs => $attrs, + }, $class; $self->result_class( - $attrs->{result_class} || $source->resolve->result_class + $attrs->{result_class} || $source->result_class ); - return $self; + $self; } =head2 search @@ -305,6 +301,7 @@ always return a resultset, even in list context. =cut +my $callsites_warned; sub search_rs { my $self = shift; @@ -314,9 +311,15 @@ sub search_rs { } my $call_attrs = {}; - $call_attrs = pop(@_) if ( - @_ > 1 and ( ! defined $_[-1] or ref $_[-1] eq 'HASH' ) - ); + if (@_ > 1) { + if (ref $_[-1] eq 'HASH') { + # copy for _normalize_selection + $call_attrs = { %{ pop @_ } }; + } + elsif (! defined $_[-1] ) { + pop @_; # search({}, undef) + } + } # see if we can keep the cache (no $rs changes) my $cache; @@ -331,27 +334,63 @@ sub search_rs { $cache = $self->get_cache; } + my $rsrc = $self->result_source; + my $old_attrs = { %{$self->{attrs}} }; my $old_having = delete $old_attrs->{having}; my $old_where = delete $old_attrs->{where}; - # reset the selector list - if (List::Util::first { exists $call_attrs->{$_} } qw{columns select as}) { - delete @{$old_attrs}{qw{select as columns +select +as +columns include_columns}}; - } + my $new_attrs = { %$old_attrs }; - my $new_attrs = { %{$old_attrs}, %{$call_attrs} }; + # take care of call attrs (only if anything is changing) + if (keys %$call_attrs) { - # merge new attrs into inherited - foreach my $key (qw/join prefetch/) { - next unless exists $call_attrs->{$key}; - $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key}); - } - foreach my $key (qw/+select +as +columns include_columns bind/) { - next unless exists $call_attrs->{$key}; - $new_attrs->{$key} = $self->_merge_attr($old_attrs->{$key}, $call_attrs->{$key}); + $self->throw_exception ('_trailing_select is not a public attribute - do not use it in search()') + if ( exists $call_attrs->{_trailing_select} or exists $call_attrs->{'+_trailing_select'} ); + + my @selector_attrs = qw/select as columns cols +select +as +columns include_columns _trailing_select +_trailing_select/; + + # Normalize the selector list (operates on the passed-in attr structure) + # Need to do it on every chain instead of only once on _resolved_attrs, in + # order to separate 'as'-ed from blind 'select's + $self->_normalize_selection ($call_attrs); + + # start with blind overwriting merge, exclude selector attrs + $new_attrs = { %{$old_attrs}, %{$call_attrs} }; + delete @{$new_attrs}{@selector_attrs}; + + # reset the current selector list if new selectors are supplied + if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { + delete @{$old_attrs}{@selector_attrs}; + } + + for (@selector_attrs) { + $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_}) + if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} ); + } + + # older deprecated name, use only if {columns} is not there + if (my $c = delete $new_attrs->{cols}) { + if ($new_attrs->{columns}) { + carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'"; + } + else { + $new_attrs->{columns} = $c; + } + } + + + # join/prefetch use their own crazy merging heuristics + foreach my $key (qw/join prefetch/) { + $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key}) + if exists $call_attrs->{$key}; + } + + # stack binds together + $new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ]; } + # rip apart the rest of @_, parse a condition my $call_cond = do { @@ -370,8 +409,17 @@ sub search_rs { } if @_; - carp 'search( %condition ) is deprecated, use search( \%condition ) instead' - if (@_ > 1 and ! $self->result_source->result_class->isa('DBIx::Class::CDBICompat') ); + if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) { + # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas) + my $callsite = do { + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + carp; + $w + }; + carp 'search( %condition ) is deprecated, use search( \%condition ) instead' + unless $callsites_warned->{$callsite}++; + } for ($old_where, $call_cond) { if (defined $_) { @@ -387,13 +435,104 @@ sub search_rs { ) } - my $rs = (ref $self)->new($self->result_source, $new_attrs); + my $rs = (ref $self)->new($rsrc, $new_attrs); $rs->set_cache($cache) if ($cache); return $rs; } +sub _normalize_selection { + my ($self, $attrs) = @_; + + # legacy syntax + $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns}) + if exists $attrs->{include_columns}; + + # Keep the X vs +X separation until _resolved_attrs time - this allows to + # delay the decision on whether to use a default select list ($rsrc->columns) + # allowing stuff like the remove_columns helper to work + # + # select/as +select/+as pairs need special handling - the amount of select/as + # elements in each pair does *not* have to be equal (think multicolumn + # selectors like distinct(foo, bar) ). If the selector is bare (no 'as' + # supplied at all) - try to infer the alias, either from the -as parameter + # of the selector spec, or use the parameter whole if it looks like a column + # name (ugly legacy heuristic). If all fails - leave the selector bare (which + # is ok as well), but transport it over a separate attribute to make sure it is + # the last thing in the select list, thus unable to throw off the corresponding + # 'as' chain + for my $pref ('', '+') { + + my ($sel, $as) = map { + my $key = "${pref}${_}"; + + my $val = [ ref $attrs->{$key} eq 'ARRAY' + ? @{$attrs->{$key}} + : $attrs->{$key} || () + ]; + delete $attrs->{$key}; + $val; + } qw/select as/; + + if (! @$as and ! @$sel ) { + next; + } + elsif (@$as and ! @$sel) { + $self->throw_exception( + "Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select" + ); + } + elsif( ! @$as ) { + # no as part supplied at all - try to deduce + # if any @$as has been supplied we assume the user knows what (s)he is doing + # and blindly keep stacking up pieces + my (@new_sel, @new_trailing); + for (@$sel) { + if ( ref $_ eq 'HASH' and exists $_->{-as} ) { + push @$as, $_->{-as}; + push @new_sel, $_; + } + # assume any plain no-space, no-parenthesis string to be a column spec + # FIXME - this is retarded but is necessary to support shit like 'count(foo)' + elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) { + push @$as, $_; + push @new_sel, $_; + } + # if all else fails - shove the selection to the trailing stack and move on + else { + push @new_trailing, $_; + } + } + + @$sel = @new_sel; + $attrs->{"${pref}_trailing_select"} = $self->_merge_attr($attrs->{"${pref}_trailing_select"}, \@new_trailing) + if @new_trailing; + } + elsif (@$as < @$sel) { + $self->throw_exception( + "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select" + ); + } + + # now see what the result for this pair looks like: + if (@$as == @$sel) { + + # if balanced - treat as a columns entry + $attrs->{"${pref}columns"} = $self->_merge_attr( + $attrs->{"${pref}columns"}, + [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ] + ); + } + else { + # unbalanced - shove in select/as, not subject to deduplication in _resolved_attrs + $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel); + $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as); + } + } + +} + sub _stack_cond { my ($self, $left, $right) = @_; if (defined $left xor defined $right) { @@ -558,7 +697,7 @@ sub find { next if $keyref eq 'ARRAY'; # has_many for multi_create my $rel_q = $rsrc->_resolve_condition( - $relinfo->{cond}, $val, $key + $relinfo->{cond}, $val, $key, $key ); die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH'; @related{keys %$rel_q} = values %$rel_q; @@ -600,7 +739,7 @@ sub find { }++; push @unique_queries, try { - $self->_build_unique_cond ($c_name, $call_cond) + $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls') } || (); } @@ -658,8 +797,9 @@ sub _qualify_cond_columns { return \%aliased; } +my $callsites_warned_ucond; sub _build_unique_cond { - my ($self, $constraint_name, $extra_cond) = @_; + my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_; my @c_cols = $self->result_source->unique_constraint_columns($constraint_name); @@ -671,15 +811,45 @@ sub _build_unique_cond { }; # trim out everything not in $columns - $final_cond = { map { $_ => $final_cond->{$_} } @c_cols }; - - if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) { + $final_cond = { map { + exists $final_cond->{$_} + ? ( $_ => $final_cond->{$_} ) + : () + } @c_cols }; + + if (my @missing = grep + { ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) } + (@c_cols) + ) { $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s", $constraint_name, join (', ', map { "'$_'" } @missing), ) ); } + if ( + !$croak_on_null + and + !$ENV{DBIC_NULLABLE_KEY_NOWARN} + and + my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond) + ) { + my $callsite = do { + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + carp; + $w + }; + + carp ( sprintf ( + "NULL/undef values supplied for requested unique constraint '%s' (NULL " + . 'values in column(s): %s). This is almost certainly not what you wanted, ' + . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.', + $constraint_name, + join (', ', map { "'$_'" } @undefs), + )) unless $callsites_warned_ucond->{$callsite}++; + } + return $final_cond; } @@ -1276,6 +1446,7 @@ sub _count_rs { # overwrite the selector (supplied by the storage) $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs); $tmp_attrs->{as} = 'count'; + delete @{$tmp_attrs}{qw/columns _trailing_select/}; my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); @@ -1293,7 +1464,7 @@ sub _count_subq_rs { 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 select _prefetch_select as order_by for/}; + delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range _trailing_select order_by for/}; # if we multi-prefetch we group_by primary keys only as this is what we would # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless @@ -1507,7 +1678,7 @@ sub _rs_update_delete { my $attrs = $self->_resolved_attrs_copy; - delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_select as/; + delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/; $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ]; if ($needs_group_by_subq) { @@ -1763,21 +1934,24 @@ sub populate { push(@created, $self->create($item)); } return wantarray ? @created : \@created; - } else { + } + else { my $first = $data->[0]; # if a column is a registered relationship, and is a non-blessed hash/array, consider # it relationship data my (@rels, @columns); + my $rsrc = $self->result_source; + my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships }; for (keys %$first) { my $ref = ref $first->{$_}; - $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH') + $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH') ? push @rels, $_ : push @columns, $_ ; } - my @pks = $self->result_source->primary_columns; + my @pks = $rsrc->primary_columns; ## do the belongs_to relationships foreach my $index (0..$#$data) { @@ -1795,11 +1969,12 @@ sub populate { foreach my $rel (@rels) { next unless ref $data->[$index]->{$rel} eq "HASH"; my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel}); - my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)}; + my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)}; my $related = $result->result_source->_resolve_condition( - $result->result_source->relationship_info($reverse)->{cond}, + $reverse_relinfo->{cond}, $self, $result, + $rel, ); delete $data->[$index]->{$rel}; @@ -1816,8 +1991,8 @@ sub populate { my @inherit_data = values %$rs_data; ## do bulk insert on current row - $self->result_source->storage->insert_bulk( - $self->result_source, + $rsrc->storage->insert_bulk( + $rsrc, [@columns, @inherit_cols], [ map { [ @$_{@columns}, @inherit_data ] } @$data ], ); @@ -1825,18 +2000,20 @@ sub populate { ## do the has_many relationships foreach my $item (@$data) { + my $main_row; + foreach my $rel (@rels) { - next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY"; + next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} }; - my $parent = $self->find({map { $_ => $item->{$_} } @pks}) - || $self->throw_exception('Cannot find the relating object.'); + $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks}); - my $child = $parent->$rel; + my $child = $main_row->$rel; my $related = $child->result_source->_resolve_condition( - $parent->result_source->relationship_info($rel)->{cond}, + $rels->{$rel}{cond}, $child, - $parent, + $main_row, + $rel, ); my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel}); @@ -2129,7 +2306,6 @@ sub new_result { @$cols_from_relations ? (-cols_from_relations => $cols_from_relations) : (), - -source_handle => $self->_source_handle, -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED ); @@ -2169,7 +2345,13 @@ sub _merge_with_rscond { while ( my($col, $value) = each %implied ) { my $vref = ref $value; - if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') { + if ( + $vref eq 'HASH' + and + keys(%$value) == 1 + and + (keys %$value)[0] eq '=' + ) { $new_data{$col} = $value->{'='}; } elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) { @@ -2943,8 +3125,8 @@ sub as_subselect_rs { return $fresh_rs->search( {}, { from => [{ $attrs->{alias} => $self->as_query, - -alias => $attrs->{alias}, - -source_handle => $self->result_source->handle, + -alias => $attrs->{alias}, + -rsrc => $self->result_source, }], alias => $attrs->{alias}, }); @@ -2994,8 +3176,8 @@ sub _chain_relationship { ); $from = [{ - -source_handle => $source->handle, - -alias => $attrs->{alias}, + -rsrc => $source, + -alias => $attrs->{alias}, $attrs->{alias} => $rs_copy->as_query, }]; delete @{$attrs}{@force_subq_attrs, qw/where bind/}; @@ -3006,7 +3188,7 @@ sub _chain_relationship { } else { $from = [{ - -source_handle => $source->handle, + -rsrc => $source, -alias => $attrs->{alias}, $attrs->{alias} => $source->from, }]; @@ -3071,134 +3253,53 @@ sub _resolved_attrs { my $source = $self->result_source; my $alias = $attrs->{alias}; -######## -# resolve selectors, this one is quite hairy - - my $selection_pieces; + # one last pass of normalization + $self->_normalize_selection($attrs); - $attrs->{columns} ||= delete $attrs->{cols} - if exists $attrs->{cols}; + # default selection list + $attrs->{columns} = [ $source->columns ] + unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as _trailing_select/; - # disassemble columns / +columns - ( - $selection_pieces->{columns}{select}, - $selection_pieces->{columns}{as}, - $selection_pieces->{'+columns'}{select}, - $selection_pieces->{'+columns'}{as}, - ) = map - { - my (@sel, @as); - - for my $colbit (@$_) { + # merge selectors together + for (qw/columns select as _trailing_select/) { + $attrs->{$_} = $self->_merge_attr($attrs->{$_}, $attrs->{"+$_"}) + if $attrs->{$_} or $attrs->{"+$_"}; + } - if (ref $colbit eq 'HASH') { - for my $as (keys %$colbit) { - push @sel, $colbit->{$as}; - push @as, $as; - } - } - elsif ($colbit) { - push @sel, $colbit; - push @as, $colbit; + # disassemble columns + my (@sel, @as); + if (my $cols = delete $attrs->{columns}) { + for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) { + if (ref $c eq 'HASH') { + for my $as (keys %$c) { + push @sel, $c->{$as}; + push @as, $as; } } - - (\@sel, \@as) - } - ( - (ref $attrs->{columns} eq 'ARRAY' ? delete $attrs->{columns} : [ delete $attrs->{columns} ]), - # include_columns is a legacy add-on to +columns - [ map { ref $_ eq 'ARRAY' ? @$_ : ($_ || () ) } delete @{$attrs}{qw/+columns include_columns/} ] ) - ; - - # make copies of select/as and +select/+as - ( - $selection_pieces->{'select/as'}{select}, - $selection_pieces->{'select/as'}{as}, - $selection_pieces->{'+select/+as'}{select}, - $selection_pieces->{'+select/+as'}{as}, - ) = map - { $_ ? [ ref $_ eq 'ARRAY' ? @$_ : $_ ] : [] } - ( delete @{$attrs}{qw/select as +select +as/} ) - ; - - # default to * only when neither no non-plus selectors are available - if ( - ! @{$selection_pieces->{'select/as'}{select}} - and - ! @{$selection_pieces->{'columns'}{select}} - ) { - for ($source->columns) { - push @{$selection_pieces->{'select/as'}{select}}, $_; - push @{$selection_pieces->{'select/as'}{as}}, $_; + else { + push @sel, $c; + push @as, $c; + } } } - # final composition order (important) - my @sel_pairs = grep { - $selection_pieces->{$_} - && - ( - ( $selection_pieces->{$_}{select} && @{$selection_pieces->{$_}{select}} ) - || - ( $selection_pieces->{$_}{as} && @{$selection_pieces->{$_}{as}} ) - ) - } qw|columns select/as +columns +select/+as|; - - # fill in missing as bits for each pair - # if it's the last pair we can let things slide ( bare +select is sadly popular) - my $out_of_sync; - - for my $i (0 .. $#sel_pairs) { - - my $pairname = $sel_pairs[$i]; - - my ($sel, $as) = @{$selection_pieces->{$pairname}}{qw/select as/}; + # when trying to weed off duplicates later do not go past this point - + # everything added from here on is unbalanced "anyone's guess" stuff + my $dedup_stop_idx = $#as; - $self->throw_exception( - "Unable to assemble final selection list: $pairname specified in addition to unbalanced $sel_pairs[$i-1]" - ) if ($out_of_sync); - - if (@$sel == @$as) { - next; - } - elsif (@$sel < @$as) { - $self->throw_exception( - "More 'as' elements than 'select' elements for $pairname, unable to continue" - ); - } - else { - # try to deduce the 'as' part, will work only if all the selectors are "plain", or contain an explicit -as - # if we can not deduce something - stop right there and leave the rest of the selector un-as'ed - # if there is an extra selection pair coming after that - it will die due to out_of_sync being set - for my $j ($#$as+1 .. $#$sel) { - if (my $ref = ref $sel->[$j]) { - if ($ref eq 'HASH' and exists $sel->[$j]{-as}) { - push @$as, $sel->[$j]{-as}; - } - else { - $out_of_sync++; - last; - } - } - else { - push @$as, $sel->[$j]; - } - } - } - } + push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] } + if $attrs->{as}; + push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] } + if $attrs->{select}; # assume all unqualified selectors to apply to the current alias (legacy stuff) - # disqualify all $alias.col as-bits (collapser mandated) - for (values %$selection_pieces) { - $_->{select} = [ map { (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" } @{$_->{select}} ]; - $_->{as} = [ map { $_ =~ /^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$_->{as}} ]; + for (@sel) { + $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_"; } - # merge everything - for (@sel_pairs) { - $attrs->{select} = $self->_merge_attr ($attrs->{select}, $selection_pieces->{$_}{select}); - $attrs->{as} = $self->_merge_attr ($attrs->{as}, $selection_pieces->{$_}{as}); + # disqualify all $alias.col as-bits (collapser mandated) + for (@as) { + $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_; } # de-duplicate the result (remove *identical* select/as pairs) @@ -3206,16 +3307,15 @@ sub _resolved_attrs { # not using a c-style for as the condition is prone to shrinkage my $seen; my $i = 0; - while ($i <= $#{$attrs->{as}} ) { - my ($sel, $as) = map { $attrs->{$_}[$i] } (qw/select as/); - - if ($seen->{"$sel \x00\x00 $as"}++) { - splice @$_, $i, 1 - for @{$attrs}{qw/select as/}; + while ($i <= $dedup_stop_idx) { + if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) { + splice @sel, $i, 1; + splice @as, $i, 1; + $dedup_stop_idx--; } - elsif ($seen->{$as}++) { + elsif ($seen->{$as[$i]}++) { $self->throw_exception( - "inflate_result() alias '$as' specified twice with different SQL-side {select}-ors" + "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors" ); } else { @@ -3223,13 +3323,12 @@ sub _resolved_attrs { } } -## selector resolution done -######## - + $attrs->{select} = \@sel; + $attrs->{as} = \@as; $attrs->{from} ||= [{ - -source_handle => $source->handle, - -alias => $self->{attrs}{alias}, + -rsrc => $source, + -alias => $self->{attrs}{alias}, $self->{attrs}{alias} => $source->from, }]; @@ -3238,7 +3337,7 @@ sub _resolved_attrs { $self->throw_exception ('join/prefetch can not be used with a custom {from}') if ref $attrs->{from} ne 'ARRAY'; - my $join = delete $attrs->{join} || {}; + my $join = (delete $attrs->{join}) || {}; if ( defined $attrs->{prefetch} ) { $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} ); @@ -3278,15 +3377,20 @@ sub _resolved_attrs { carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); } else { + # distinct affects only the main selection part, not what prefetch may + # add below. However trailing is not yet a part of the selection as + # prefetch must insert before it $attrs->{group_by} = $source->storage->_group_over_selection ( - @{$attrs}{qw/from select order_by/} + $attrs->{from}, + [ @{$attrs->{select}||[]}, @{$attrs->{_trailing_select}||[]} ], + $attrs->{order_by}, ); } } $attrs->{collapse} ||= {}; - if ( my $prefetch = delete $attrs->{prefetch} ) { - $prefetch = $self->_merge_joinpref_attr( {}, $prefetch ); + if ($attrs->{prefetch}) { + my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ); my $prefetch_ordering = []; @@ -3315,15 +3419,22 @@ sub _resolved_attrs { $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); # 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; } + + push @{ $attrs->{select} }, @{$attrs->{_trailing_select}} + if $attrs->{_trailing_select}; + # 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 @@ -3463,13 +3574,13 @@ sub _merge_joinpref_attr { my ($defl, $defr) = map { defined $_ } (@_[0,1]); if ($defl xor $defr) { - return $defl ? $_[0] : $_[1]; + return [ $defl ? $_[0] : $_[1] ]; } elsif (! $defl) { - return (); + return []; } elsif (__HM_DEDUP and $_[0] eq $_[1]) { - return $_[0]; + return [ $_[0] ]; } else { return [$_[0], $_[1]]; @@ -3481,8 +3592,9 @@ sub _merge_joinpref_attr { return [$_[0], @{$_[1]}] }, HASH => sub { - return $_[1] if !defined $_[0]; - return $_[0] if !keys %{$_[1]}; + return [] if !defined $_[0] and !keys %{$_[1]}; + return [ $_[1] ] if !defined $_[0]; + return [ $_[0] ] if !keys %{$_[1]}; return [$_[0], $_[1]] }, }, @@ -3508,20 +3620,23 @@ sub _merge_joinpref_attr { }, HASH => { SCALAR => sub { - return $_[0] if !defined $_[1]; - return $_[1] if !keys %{$_[0]}; + return [] if !keys %{$_[0]} and !defined $_[1]; + return [ $_[0] ] if !defined $_[1]; + return [ $_[1] ] if !keys %{$_[0]}; return [$_[0], $_[1]] }, ARRAY => sub { - return $_[0] if !@{$_[1]}; + return [] if !keys %{$_[0]} and !@{$_[1]}; + return [ $_[0] ] if !@{$_[1]}; return $_[1] if !keys %{$_[0]}; return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; return [ $_[0], @{$_[1]} ]; }, HASH => sub { - return $_[0] if !keys %{$_[1]}; - return $_[1] if !keys %{$_[0]}; - return $_[0] if $_[0] eq $_[1]; + return [] if !keys %{$_[0]} and !keys %{$_[1]}; + return [ $_[0] ] if !keys %{$_[1]}; + return [ $_[1] ] if !keys %{$_[0]}; + return [ $_[0] ] if $_[0] eq $_[1]; return [ $_[0], $_[1] ]; }, } @@ -3533,17 +3648,6 @@ sub _merge_joinpref_attr { } } -sub result_source { - my $self = shift; - - if (@_) { - $self->_source_handle($_[0]->handle); - } else { - $self->_source_handle->resolve; - } -} - - sub STORABLE_freeze { my ($self, $cloning) = @_; my $to_serialize = { %$self }; @@ -3551,7 +3655,7 @@ sub STORABLE_freeze { # A cursor in progress can't be serialized (and would make little sense anyway) delete $to_serialize->{cursor}; - return nfreeze($to_serialize); + nfreeze($to_serialize); } # need this hook for symmetry @@ -3560,7 +3664,7 @@ sub STORABLE_thaw { %$self = %{ thaw($serialized) }; - return $self; + $self; } @@ -3573,8 +3677,8 @@ See L for details. sub throw_exception { my $self=shift; - if (ref $self && $self->_source_handle->schema) { - $self->_source_handle->schema->throw_exception(@_) + if (ref $self and my $rsrc = $self->result_source) { + $rsrc->throw_exception(@_) } else { DBIx::Class::Exception->throw(@_);