use base qw/DBIx::Class/;
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
-use Scalar::Util qw/blessed weaken/;
+use Scalar::Util qw/blessed weaken reftype/;
use Try::Tiny;
use Data::Compare (); # no imports!!! guard against insane architecture
'bool' => "_bool",
fallback => 1;
+# this is real - CDBICompat overrides it with insanity
+# yes, prototype won't matter, but that's for now ;)
+sub _bool () { 1 }
+
__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
=head1 NAME
my $cache;
my %safe = (alias => 1, cache => 1);
if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
- ! defined $_[0]
+ ! defined $call_cond
or
- ref $_[0] eq 'HASH' && ! keys %{$_[0]}
+ ref $call_cond eq 'HASH' && ! keys %$call_cond
or
- ref $_[0] eq 'ARRAY' && ! @{$_[0]}
+ ref $call_cond eq 'ARRAY' && ! @$call_cond
)) {
$cache = $self->get_cache;
}
# older deprecated name, use only if {columns} is not there
if (my $c = delete $new_attrs->{cols}) {
+ carp_unique( "Resultset attribute 'cols' is deprecated, use 'columns' instead" );
if ($new_attrs->{columns}) {
carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
}
my ($self, $attrs) = @_;
# legacy syntax
- $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns})
- if exists $attrs->{include_columns};
+ if ( exists $attrs->{include_columns} ) {
+ carp_unique( "Resultset attribute 'include_columns' is deprecated, use '+columns' instead" );
+ $attrs->{'+columns'} = $self->_merge_attr(
+ $attrs->{'+columns'}, delete $attrs->{include_columns}
+ );
+ }
# columns are always placed first, however
$attrs->{where}, $attrs
)];
return undef unless @$data;
- $self->{stashed_rows} = [ $data ];
- $self->_construct_objects->[0];
+ $self->{_stashed_rows} = [ $data ];
+ $self->_construct_results->[0];
}
return ($self->all)[0];
}
- return shift(@{$self->{stashed_objects}}) if @{ $self->{stashed_objects}||[] };
+ return shift(@{$self->{_stashed_results}}) if @{ $self->{_stashed_results}||[] };
- $self->{stashed_objects} = $self->_construct_objects
+ $self->{_stashed_results} = $self->_construct_results
or return undef;
- return shift @{$self->{stashed_objects}};
+ return shift @{$self->{_stashed_results}};
}
-# Constructs as many objects as it can in one pass while respecting
+# Constructs as many results as it can in one pass while respecting
# cursor laziness. Several modes of operation:
#
-# * Always builds everything present in @{$self->{stashed_rows}}
+# * Always builds everything present in @{$self->{_stashed_rows}}
# * If called with $fetch_all true - pulls everything off the cursor and
-# builds all objects in one pass
+# builds all result structures (or objects) in one pass
# * If $self->_resolved_attrs->{collapse} is true, checks the order_by
# and if the resultset is ordered properly by the left side:
# * Fetches stuff off the cursor until the "master object" changes,
-# and saves the last extra row (if any) in @{$self->{stashed_rows}}
+# and saves the last extra row (if any) in @{$self->{_stashed_rows}}
# OR
# * Just fetches, and collapses/constructs everything as if $fetch_all
# was requested (there is no other way to collapse except for an
# eager cursor)
# * If no collapse is requested - just get the next row, construct and
# return
-sub _construct_objects {
+sub _construct_results {
my ($self, $fetch_all) = @_;
my $rsrc = $self->result_source;
my $attrs = $self->_resolved_attrs;
- if (!$fetch_all and ! $attrs->{order_by} and $attrs->{collapse}) {
+ if (
+ ! $fetch_all
+ and
+ ! $attrs->{order_by}
+ and
+ $attrs->{collapse}
+ and
+ my @pcols = $rsrc->primary_columns
+ ) {
# default order for collapsing unless the user asked for something
- $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} $rsrc->primary_columns ];
+ $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} @pcols ];
$attrs->{_ordered_for_collapse} = 1;
$attrs->{_order_is_artificial} = 1;
}
my $cursor = $self->cursor;
# this will be used as both initial raw-row collector AND as a RV of
- # _construct_objects. Not regrowing the array twice matters a lot...
- # a suprising amount actually
- my $rows = delete $self->{stashed_rows};
+ # _construct_results. Not regrowing the array twice matters a lot...
+ # a surprising amount actually
+ my $rows = delete $self->{_stashed_rows};
+
+ my $did_fetch_all = $fetch_all;
if ($fetch_all) {
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
} unless defined $attrs->{_ordered_for_collapse};
if (! $attrs->{_ordered_for_collapse}) {
- $fetch_all = 1;
+ $did_fetch_all = 1;
# instead of looping over ->next, use ->all in stealth mode
# *without* calling a ->reset afterwards
- # FIXME - encapsulation breach, got to be a better way
+ # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
if (! $cursor->{_done}) {
$rows = [ ($rows ? @$rows : ()), $cursor->all ];
$cursor->{_done} = 1;
}
}
- if (! $fetch_all and ! @{$rows||[]} ) {
+ if (! $did_fetch_all and ! @{$rows||[]} ) {
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
if (scalar (my @r = $cursor->next) ) {
$rows = [ \@r ];
return undef unless @{$rows||[]};
my @extra_collapser_args;
- if ($attrs->{collapse} and ! $fetch_all ) {
+ if ($attrs->{collapse} and ! $did_fetch_all ) {
@extra_collapser_args = (
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
sub { my @r = $cursor->next or return; \@r }, # how the collapser gets more rows
- ($self->{stashed_rows} = []), # where does it stuff excess
+ ($self->{_stashed_rows} = []), # where does it stuff excess
);
}
my $infmap = $attrs->{as};
- $self->{_result_inflator}{is_hri} = do { ( $inflator_cref == (
- require DBIx::Class::ResultClass::HashRefInflator
- &&
- DBIx::Class::ResultClass::HashRefInflator->can('inflate_result')
- ) ) ? 1 : 0
- } unless defined $self->{_result_inflator}{is_hri};
- if ($attrs->{_single_resultclass_inflation}) {
+ $self->{_result_inflator}{is_core_row} = ( (
+ $inflator_cref
+ ==
+ ( \&DBIx::Class::Row::inflate_result || die "No ::Row::inflate_result() - can't happen" )
+ ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_core_row};
+
+ $self->{_result_inflator}{is_hri} = ( (
+ ! $self->{_result_inflator}{is_core_row}
+ and
+ $inflator_cref == (
+ require DBIx::Class::ResultClass::HashRefInflator
+ &&
+ DBIx::Class::ResultClass::HashRefInflator->can('inflate_result')
+ )
+ ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri};
+
+
+ if (! $attrs->{_related_results_construction}) {
# construct a much simpler array->hash folder for the one-table cases right here
if ($self->{_result_inflator}{is_hri}) {
for my $r (@$rows) {
);
}
}
- # Special-case multi-object HRI (we always prune)
+ # Special-case multi-object HRI (we always prune, and there is no $inflator_cref pass)
elsif ($self->{_result_inflator}{is_hri}) {
( $self->{_row_parser}{hri} ||= $rsrc->_mk_row_parser({
eval => 1,
collapse => $attrs->{collapse},
premultiplied => $attrs->{_main_source_premultiplied},
hri_style => 1,
+ prune_null_branches => 1,
}) )->($rows, @extra_collapser_args);
}
# Regular multi-object
else {
+ my $parser_type = $self->{_result_inflator}{is_core_row} ? 'classic_pruning' : 'classic_nonpruning';
- ( $self->{_row_parser}{classic} ||= $rsrc->_mk_row_parser({
+ ( $self->{_row_parser}{$parser_type} ||= $rsrc->_mk_row_parser({
eval => 1,
inflate_map => $infmap,
selection => $attrs->{select},
collapse => $attrs->{collapse},
premultiplied => $attrs->{_main_source_premultiplied},
+ prune_null_branches => $self->{_result_inflator}{is_core_row},
}) )->($rows, @extra_collapser_args);
$_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows;
}
- # CDBI compat stuff
- if ($attrs->{record_filter}) {
- $_ = $attrs->{record_filter}->($_) for @$rows;
- }
+ # The @$rows check seems odd at first - why wouldn't we want to warn
+ # regardless? The issue is things like find() etc, where the user
+ # *knows* only one result will come back. In these cases the ->all
+ # is not a pessimization, but rather something we actually want
+ carp_unique(
+ 'Unable to properly collapse has_many results in iterator mode due '
+ . 'to order criteria - performed an eager cursor slurp underneath. '
+ . 'Consider using ->all() instead'
+ ) if ( ! $fetch_all and @$rows > 1 );
return $rows;
}
my ($self, $result_class) = @_;
if ($result_class) {
- unless (ref $result_class) { # don't fire this for an object
- $self->ensure_class_loaded($result_class);
+ # don't fire this for an object
+ $self->ensure_class_loaded($result_class)
+ unless ref($result_class);
+
+ if ($self->get_cache) {
+ carp_unique('Changing the result_class of a ResultSet instance with cached results is a noop - the cache contents will not be altered');
}
+ # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
+ elsif ($self->{cursor} && $self->{cursor}{_pos}) {
+ $self->throw_exception('Changing the result_class of a ResultSet instance with an active cursor is not supported');
+ }
+
$self->_result_class($result_class);
- # THIS LINE WOULD BE A BUG - this accessor specifically exists to
- # permit the user to set result class on one result set only; it only
- # chains if provided to search()
- #$self->{attrs}{result_class} = $result_class if ref $self;
delete $self->{_result_inflator};
}
my $tmp_attrs = { %$attrs };
# take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
- delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
+ delete @{$tmp_attrs}{qw/rows offset order_by _related_results_construction record_filter for/};
# overwrite the selector (supplied by the storage)
$tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $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/};
+ delete @{$sub_attrs}{qw/collapse columns as select _related_results_construction order_by for/};
# 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
->get_column ('count');
}
-sub _bool {
- return 1;
-}
=head2 count_literal
$self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
}
- delete @{$self}{qw/stashed_rows stashed_objects/};
+ delete @{$self}{qw/_stashed_rows _stashed_results/};
if (my $c = $self->get_cache) {
return @$c;
$self->cursor->reset;
- my $objs = $self->_construct_objects('fetch_all') || [];
+ my $objs = $self->_construct_results('fetch_all') || [];
$self->set_cache($objs) if $self->{attrs}{cache};
sub reset {
my ($self) = @_;
- delete @{$self}{qw/stashed_rows stashed_objects/};
+ delete @{$self}{qw/_stashed_rows _stashed_results/};
$self->{all_cache_position} = 0;
$self->cursor->reset;
return $self;
my $attrs = { %{$self->_resolved_attrs} };
my $join_classifications;
- my $existing_group_by = delete $attrs->{group_by};
+ my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)};
# do we need a subquery for any reason?
my $needs_subq = (
);
# make a new $rs selecting only the PKs (that's all we really need for the subq)
- delete $attrs->{$_} for qw/collapse select _prefetch_selector_range as/;
+ delete $attrs->{$_} for qw/select as collapse _related_results_construction/;
$attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
$attrs->{group_by} = \ ''; # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
my $subrs = (ref $self)->new($rsrc, $attrs);
my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
- my %new = (
+ my $new = $self->result_class->new({
%$merged_cond,
- @$cols_from_relations
+ ( @$cols_from_relations
? (-cols_from_relations => $cols_from_relations)
- : (),
+ : ()
+ ),
-result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
- );
+ });
- return $self->result_class->new(\%new);
+ if (
+ reftype($new) eq 'HASH'
+ and
+ ! keys %$new
+ and
+ blessed($new)
+ ) {
+ carp_unique (sprintf (
+ "%s->new returned a blessed empty hashref - a strong indicator something is wrong with its inheritance chain",
+ $self->result_class,
+ ));
+ }
+
+ $new;
}
# _merge_with_rscond
my $attrs = { %{ $self->_resolved_attrs } };
- # For future use:
- #
- # in list ctx:
- # my ($sql, \@bind, \%dbi_bind_attrs) = _select_args_to_query (...)
- # $sql also has no wrapping parenthesis in list ctx
- #
- my $sqlbind = $self->result_source->storage
- ->_select_args_to_query ($attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs);
-
- return $sqlbind;
+ $self->result_source->storage->_select_args_to_query (
+ $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
+ );
}
=head2 find_or_new
=cut
sub create {
- my ($self, $attrs) = @_;
+ my ($self, $col_data) = @_;
$self->throw_exception( "create needs a hashref" )
- unless ref $attrs eq 'HASH';
- return $self->new_result($attrs)->insert;
+ unless ref $col_data eq 'HASH';
+ return $self->new_result($col_data)->insert;
}
=head2 find_or_create
sub related_resultset {
my ($self, $rel) = @_;
- return $self->{related_resultsets}{$rel} ||= do {
+ return $self->{related_resultsets}{$rel}
+ if defined $self->{related_resultsets}{$rel};
+
+ return $self->{related_resultsets}{$rel} = do {
my $rsrc = $self->result_source;
my $rel_info = $rsrc->relationship_info($rel);
# ->_resolve_join as otherwise they get lost - captainL
my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
- delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/};
+ delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/};
my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
return {%$attrs, from => $from, seen_join => $seen};
}
-# FIXME - this needs to go live in Schema with the tree walker... or
-# something
-my $inflatemap_checker;
-$inflatemap_checker = sub {
- my ($rsrc, $relpaths) = @_;
-
- my $rels;
-
- for (@$relpaths) {
- $_ =~ /^ ( [^\.]+ ) \. (.+) $/x
- or next;
-
- push @{$rels->{$1}}, $2;
- }
-
- for my $rel (keys %$rels) {
- my $rel_rsrc = try {
- $rsrc->related_source ($rel)
- } catch {
- $rsrc->throw_exception(sprintf(
- "Inflation into non-existent relationship '%s' of '%s' requested, "
- . "check the inflation specification (columns/as) ending in '...%s.%s'",
- $rel,
- $rsrc->source_name,
- $rel,
- ( sort { length($a) <=> length ($b) } @{$rels->{$rel}} )[0],
- ))};
-
- $inflatemap_checker->($rel_rsrc, $rels->{$rel});
- }
-
- return;
-};
-
sub _resolved_attrs {
my $self = shift;
return $self->{_attrs} if $self->{_attrs};
}
}
- # validate the user-supplied 'as' chain
- # folks get too confused by the (logical) exception message, need to
- # go to some lengths to clarify the text
- #
- # FIXME - this needs to go live in Schema with the tree walker... or
- # something
- $inflatemap_checker->($source, \@as);
-
$attrs->{select} = \@sel;
$attrs->{as} = \@as;
carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
}
else {
+ $attrs->{_grouped_by_distinct} = 1;
# distinct affects only the main selection part, not what prefetch may
# add below.
$attrs->{group_by} = $source->storage->_group_over_selection (
my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
- # we need to somehow mark which columns came from prefetch
- if (@prefetch) {
- my $sel_end = $#{$attrs->{select}};
- $attrs->{_prefetch_selector_range} = [ $sel_end + 1, $sel_end + @prefetch ];
- }
-
push @{ $attrs->{select} }, (map { $_->[0] } @prefetch);
push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
}
- if ( ! List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
- $attrs->{_single_resultclass_inflation} = 1;
+ if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) {
+ $attrs->{_related_results_construction} = 1;
+ }
+ else {
$attrs->{collapse} = 0;
}
expression). Adds C<me.> onto the start of any column without a C<.> in
it and sets C<select> from that, then auto-populates C<as> from
C<select> as normal. (You may also use the C<cols> attribute, as in
-earlier versions of DBIC.)
+earlier versions of DBIC, but this is deprecated.)
Essentially C<columns> does the same as L</select> and L</as>.
=back
-Indicates additional columns to be selected from storage. Works the same
-as L</columns> but adds columns to the selection. (You may also use the
-C<include_columns> attribute, as in earlier versions of DBIC). For
-example:-
+Indicates additional columns to be selected from storage. Works the same as
+L</columns> but adds columns to the selection. (You may also use the
+C<include_columns> attribute, as in earlier versions of DBIC, but this is
+deprecated). For example:-
$schema->resultset('CD')->search(undef, {
'+columns' => ['artist.name'],
cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
-That cmp_ok() may or may not pass depending on the datasets involved. This
-behavior may or may not survive the 0.09 transition.
+That cmp_ok() may or may not pass depending on the datasets involved. In other
+words the C<WHERE> condition would apply to the entire dataset, just like
+it would in regular SQL. If you want to add a condition only to the "right side"
+of a C<LEFT JOIN> - consider declaring and using a L<relationship with a custom
+condition|DBIx::Class::Relationship::Base/condition>
=back