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 ();
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 };
}
'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
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}) {
$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
=cut
+my $callsites_warned;
sub search_rs {
my $self = shift;
}
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;
$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 {
} 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 $_) {
)
}
- 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) {
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;
}++;
push @unique_queries, try {
- $self->_build_unique_cond ($c_name, $call_cond)
+ $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
} || ();
}
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);
};
# 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;
}
# 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');
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
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) {
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) {
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};
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 ],
);
## 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});
@$cols_from_relations
? (-cols_from_relations => $cols_from_relations)
: (),
- -source_handle => $self->_source_handle,
-result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
);
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) ) {
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},
});
);
$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/};
}
else {
$from = [{
- -source_handle => $source->handle,
+ -rsrc => $source,
-alias => $attrs->{alias},
$attrs->{alias} => $source->from,
}];
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)
# 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 {
}
}
-## 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,
}];
$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} );
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 = [];
$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
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]];
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]]
},
},
},
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] ];
},
}
}
}
-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 };
# 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
%$self = %{ thaw($serialized) };
- return $self;
+ $self;
}
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(@_);
projects / dbsrgits/DBIx-Class.git / blobdiff