use base qw/DBIx::Class/;
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
-use Scalar::Util qw/blessed weaken/;
+use DBIx::Class::ResultClass::HashRefInflator;
+use Scalar::Util qw/blessed weaken reftype/;
+use DBIx::Class::_Util qw(
+ fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
+);
use Try::Tiny;
-use Data::Compare (); # no imports!!! guard against insane architecture
# not importing first() as it will clash with our own method
use List::Util ();
'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
A basic ResultSet representing the data of an entire table is returned
by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
-L<Source|DBIx::Class::Manual::Glossary/Source> name.
+L<Source|DBIx::Class::Manual::Glossary/ResultSource> name.
my $users_rs = $schema->resultset('User');
you want to check if a resultset has any results, you must use C<if $rs
!= 0>.
-=head1 CUSTOM ResultSet CLASSES THAT USE Moose
-
-If you want to make your custom ResultSet classes with L<Moose>, use a template
-similar to:
-
- package MyApp::Schema::ResultSet::User;
-
- use Moose;
- use namespace::autoclean;
- use MooseX::NonMoose;
- extends 'DBIx::Class::ResultSet';
-
- sub BUILDARGS { $_[2] }
-
- ...your code...
-
- __PACKAGE__->meta->make_immutable;
-
- 1;
-
-The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
-clash with the regular ResultSet constructor. Alternatively, you can use:
-
- __PACKAGE__->meta->make_immutable(inline_constructor => 0);
-
-The L<BUILDARGS|Moose::Manual::Construction/BUILDARGS> is necessary because the
-signature of the ResultSet C<new> is C<< ->new($source, \%args) >>.
-
=head1 EXAMPLES
=head2 Chaining resultsets
=head3 Resolving conditions and attributes
-When a resultset is chained from another resultset, conditions and
-attributes with the same keys need resolving.
+When a resultset is chained from another resultset (e.g.:
+C<< my $new_rs = $old_rs->search(\%extra_cond, \%attrs) >>), conditions
+and attributes with the same keys need resolving.
+
+If any of L</columns>, L</select>, L</as> are present, they reset the
+original selection, and start the selection "clean".
-L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
-into the existing ones from the original resultset.
+The L</join>, L</prefetch>, L</+columns>, L</+select>, L</+as> attributes
+are merged into the existing ones from the original resultset.
The L</where> and L</having> attributes, and any search conditions, are
merged with an SQL C<AND> to the existing condition from the original
See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
+=head2 Custom ResultSet classes
+
+To add methods to your resultsets, you can subclass L<DBIx::Class::ResultSet>, similar to:
+
+ package MyApp::Schema::ResultSet::User;
+
+ use strict;
+ use warnings;
+
+ use base 'DBIx::Class::ResultSet';
+
+ sub active {
+ my $self = shift;
+ $self->search({ $self->current_source_alias . '.active' => 1 });
+ }
+
+ sub unverified {
+ my $self = shift;
+ $self->search({ $self->current_source_alias . '.verified' => 0 });
+ }
+
+ sub created_n_days_ago {
+ my ($self, $days_ago) = @_;
+ $self->search({
+ $self->current_source_alias . '.create_date' => {
+ '<=',
+ $self->result_source->schema->storage->datetime_parser->format_datetime(
+ DateTime->now( time_zone => 'UTC' )->subtract( days => $days_ago )
+ )}
+ });
+ }
+
+ sub users_to_warn { shift->active->unverified->created_n_days_ago(7) }
+
+ 1;
+
+See L<DBIx::Class::Schema/load_namespaces> on how DBIC can discover and
+automatically attach L<Result|DBIx::Class::Manual::ResultClass>-specific
+L<ResulSet|DBIx::Class::ResultSet> classes.
+
+=head3 ResultSet subclassing with Moose and similar constructor-providers
+
+Using L<Moose> or L<Moo> in your ResultSet classes is usually overkill, but
+you may find it useful if your ResultSets contain a lot of business logic
+(e.g. C<has xml_parser>, C<has json>, etc) or if you just prefer to organize
+your code via roles.
+
+In order to write custom ResultSet classes with L<Moo> you need to use the
+following template. The L<BUILDARGS|Moo/BUILDARGS> is necessary due to the
+unusual signature of the L<constructor provided by DBIC
+|DBIx::Class::ResultSet/new> C<< ->new($source, \%args) >>.
+
+ use Moo;
+ extends 'DBIx::Class::ResultSet';
+ sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
+
+ ...your code...
+
+ 1;
+
+If you want to build your custom ResultSet classes with L<Moose>, you need
+a similar, though a little more elaborate template in order to interface the
+inlining of the L<Moose>-provided
+L<object constructor|Moose::Manual::Construction/WHERE'S THE CONSTRUCTOR?>,
+with the DBIC one.
+
+ package MyApp::Schema::ResultSet::User;
+
+ use Moose;
+ use MooseX::NonMoose;
+ extends 'DBIx::Class::ResultSet';
+
+ sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
+
+ ...your code...
+
+ __PACKAGE__->meta->make_immutable;
+
+ 1;
+
+The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
+entirely overwrite the DBIC one (in contrast L<Moo> does this automatically).
+Alternatively, you can skip L<MooseX::NonMoose> and get by with just L<Moose>
+instead by doing:
+
+ __PACKAGE__->meta->make_immutable(inline_constructor => 0);
+
=head1 METHODS
=head2 new
sub new {
my $class = shift;
- return $class->new_result(@_) if ref $class;
+
+ if (ref $class) {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ return $class->new_result(@_);
+ }
my ($source, $attrs) = @_;
$source = $source->resolve
if $source->isa('DBIx::Class::ResultSourceHandle');
+
$attrs = { %{$attrs||{}} };
+ delete @{$attrs}{qw(_last_sqlmaker_alias_map _simple_passthrough_construction)};
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
For a list of attributes that can be passed to C<search>, see
L</ATTRIBUTES>. For more examples of using this function, see
-L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
-documentation for the first argument, see L<SQL::Abstract>
+L<Searching|DBIx::Class::Manual::Cookbook/SEARCHING>. For a complete
+documentation for the first argument, see L<SQL::Abstract/"WHERE CLAUSES">
and its extension L<DBIx::Class::SQLMaker>.
For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
my $rs = $self->search_rs( @_ );
if (wantarray) {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
return $rs->all;
}
elsif (defined wantarray) {
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;
}
my $old_attrs = { %{$self->{attrs}} };
- my $old_having = delete $old_attrs->{having};
- my $old_where = delete $old_attrs->{where};
+ my ($old_having, $old_where) = delete @{$old_attrs}{qw(having where)};
my $new_attrs = { %$old_attrs };
# 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
sub _stack_cond {
my ($self, $left, $right) = @_;
- # collapse single element top-level conditions
- # (single pass only, unlikely to need recursion)
- for ($left, $right) {
- if (ref $_ eq 'ARRAY') {
- if (@$_ == 0) {
- $_ = undef;
- }
- elsif (@$_ == 1) {
- $_ = $_->[0];
- }
- }
- elsif (ref $_ eq 'HASH') {
- my ($first, $more) = keys %$_;
-
- # empty hash
- if (! defined $first) {
- $_ = undef;
- }
- # one element hash
- elsif (! defined $more) {
- if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
- $_ = $_->{'-and'};
- }
- elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
- $_ = $_->{'-or'};
- }
- }
- }
- }
-
- # merge hashes with weeding out of duplicates (simple cases only)
- if (ref $left eq 'HASH' and ref $right eq 'HASH') {
-
- # shallow copy to destroy
- $right = { %$right };
- for (grep { exists $right->{$_} } keys %$left) {
- # the use of eq_deeply here is justified - the rhs of an
- # expression can contain a lot of twisted weird stuff
- delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
- }
-
- $right = undef unless keys %$right;
- }
-
+ (
+ (ref $_ eq 'ARRAY' and !@$_)
+ or
+ (ref $_ eq 'HASH' and ! keys %$_)
+ ) and $_ = undef for ($left, $right);
- if (defined $left xor defined $right) {
+ # either one of the two undef
+ if ( (defined $left) xor (defined $right) ) {
return defined $left ? $left : $right;
}
- elsif (! defined $left) {
- return undef;
+ # both undef
+ elsif ( ! defined $left ) {
+ return undef
}
else {
- return { -and => [ $left, $right ] };
+ return $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
}
}
method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you
want to ensure columns are bound correctly, use L</search>.
-See L<DBIx::Class::Manual::Cookbook/Searching> and
+See L<DBIx::Class::Manual::Cookbook/SEARCHING> and
L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
require C<search_literal>.
. "corresponding to the columns of the specified unique constraint '$constraint_name'"
) unless @c_cols == @_;
- $call_cond = {};
@{$call_cond}{@c_cols} = @_;
}
- my %related;
+ # process relationship data if any
for my $key (keys %$call_cond) {
if (
- my $keyref = ref($call_cond->{$key})
+ length ref($call_cond->{$key})
and
my $relinfo = $rsrc->relationship_info($key)
+ and
+ # implicitly skip has_many's (likely MC)
+ (ref (my $val = delete $call_cond->{$key}) ne 'ARRAY' )
) {
- my $val = delete $call_cond->{$key};
-
- next if $keyref eq 'ARRAY'; # has_many for multi_create
-
- my $rel_q = $rsrc->_resolve_condition(
+ my ($rel_cond, $crosstable) = $rsrc->_resolve_condition(
$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;
+
+ $self->throw_exception("Complex condition via relationship '$key' is unsupported in find()")
+ if $crosstable or ref($rel_cond) ne 'HASH';
+
+ # supplement condition
+ # relationship conditions take precedence (?)
+ @{$call_cond}{keys %$rel_cond} = values %$rel_cond;
}
}
- # relationship conditions take precedence (?)
- @{$call_cond}{keys %related} = values %related;
-
my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
my $final_cond;
if (defined $constraint_name) {
$final_cond = $self->_qualify_cond_columns (
- $self->_build_unique_cond (
- $constraint_name,
- $call_cond,
+ $self->result_source->_minimal_valueset_satisfying_constraint(
+ constraint_name => $constraint_name,
+ values => ($self->_merge_with_rscond($call_cond))[0],
+ carp_on_nulls => 1,
),
$alias,
# relationship
}
else {
+ my (@unique_queries, %seen_column_combinations, $ci, @fc_exceptions);
+
# 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) {
+ #
+ # always start from 'primary' if it exists at all
+ for my $c_name ( sort {
+ $a eq 'primary' ? -1
+ : $b eq 'primary' ? 1
+ : $a cmp $b
+ } $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')
- } || ();
+ try {
+ push @unique_queries, $self->_qualify_cond_columns(
+ $self->result_source->_minimal_valueset_satisfying_constraint(
+ constraint_name => $c_name,
+ values => ($self->_merge_with_rscond($call_cond))[0],
+ columns_info => ($ci ||= $self->result_source->columns_info),
+ ),
+ $alias
+ );
+ }
+ catch {
+ push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/;
+ };
}
- $final_cond = @unique_queries
- ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ]
- : $self->_non_unique_find_fallback ($call_cond, $attrs)
+ $final_cond =
+ @unique_queries ? \@unique_queries
+ : @fc_exceptions ? $self->throw_exception(join "; ", map { $_ =~ /(.*) at .+ line \d+$/s } @fc_exceptions )
+ : $self->_non_unique_find_fallback ($call_cond, $attrs)
;
}
}
sub _build_unique_cond {
- my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
-
- my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
-
- # combination may fail if $self->{cond} is non-trivial
- my ($final_cond) = try {
- $self->_merge_with_rscond ($extra_cond)
- } catch {
- +{ %$extra_cond }
- };
-
- # trim out everything not in $columns
- $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 = sort grep { ! defined $final_cond->{$_} } (keys %$final_cond)
- ) {
- carp_unique ( 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),
- ));
- }
-
- return $final_cond;
+ carp_unique sprintf
+ '_build_unique_cond is a private method, and moreover is about to go '
+ . 'away. Please contact the development team at %s if you believe you '
+ . 'have a genuine use for this method, in order to discuss alternatives.',
+ DBIx::Class::_ENV_::HELP_URL,
+ ;
+
+ my ($self, $constraint_name, $cond, $croak_on_null) = @_;
+
+ $self->result_source->_minimal_valueset_satisfying_constraint(
+ constraint_name => $constraint_name,
+ values => $cond,
+ carp_on_nulls => !$croak_on_null
+ );
}
=head2 search_related
my $self = shift;
return $self->{cursor} ||= do {
- my $attrs = { %{$self->_resolved_attrs } };
+ my $attrs = $self->_resolved_attrs;
$self->result_source->storage->select(
$attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
);
my $attrs = { %{$self->_resolved_attrs} };
$self->throw_exception(
- 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
+ 'single() can not be used on resultsets collapsing a has_many. Use find( \%cond ) or next() instead'
) if $attrs->{collapse};
if ($where) {
$attrs->{from}, $attrs->{select},
$attrs->{where}, $attrs
)];
- return undef unless @$data;
- $self->{stashed_rows} = [ $data ];
- $self->_construct_objects->[0];
-}
-
-
-# _collapse_query
-#
-# Recursively collapse the query, accumulating values for each column.
-
-sub _collapse_query {
- my ($self, $query, $collapsed) = @_;
-
- $collapsed ||= {};
-
- if (ref $query eq 'ARRAY') {
- foreach my $subquery (@$query) {
- next unless ref $subquery; # -or
- $collapsed = $self->_collapse_query($subquery, $collapsed);
- }
- }
- elsif (ref $query eq 'HASH') {
- if (keys %$query and (keys %$query)[0] eq '-and') {
- foreach my $subquery (@{$query->{-and}}) {
- $collapsed = $self->_collapse_query($subquery, $collapsed);
- }
- }
- else {
- foreach my $col (keys %$query) {
- my $value = $query->{$col};
- $collapsed->{$col}{$value}++;
- }
- }
- }
- return $collapsed;
+ return undef unless @$data;
+ $self->{_stashed_rows} = [ $data ];
+ $self->_construct_results->[0];
}
=head2 get_column
For more information, see L<DBIx::Class::Manual::Cookbook>.
-This method is deprecated and will be removed in 0.09. Use L</search()>
+This method is deprecated and will be removed in 0.09. Use L<search()|/search>
instead. An example conversion is:
->search_like({ foo => 'bar' });
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
return $self->search(undef, $attrs);
- #my $slice = (ref $self)->new($self->result_source, $attrs);
- #return (wantarray ? $slice->all : $slice);
}
=head2 next
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 $cursor; # we may not need one at all
+
+ 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
- $rows = [ ($rows ? @$rows : ()), $cursor->all ];
+ $rows = [ ($rows ? @$rows : ()), $self->cursor->all ];
}
elsif( $attrs->{collapse} ) {
- $attrs->{_ordered_for_collapse} = (!$attrs->{order_by}) ? 0 : do {
- my $st = $rsrc->schema->storage;
- my @ord_cols = map
- { $_->[0] }
- ( $st->_extract_order_criteria($attrs->{order_by}) )
- ;
-
- my $colinfos = $st->_resolve_column_info($attrs->{from}, \@ord_cols);
+ # a cursor will need to be closed over in case of collapse
+ $cursor = $self->cursor;
- for (0 .. $#ord_cols) {
- if (
- ! $colinfos->{$ord_cols[$_]}
- or
- $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc
- ) {
- splice @ord_cols, $_;
- last;
- }
- }
-
- # since all we check here are the start of the order_by belonging to the
- # top level $rsrc, a present identifying set will mean that the resultset
- # is ordered by its leftmost table in a tsable manner
- (@ord_cols and $rsrc->_identifying_column_set({ map
- { $colinfos->{$_}{-colname} => $colinfos->{$_} }
- @ord_cols
- })) ? 1 : 0;
- } unless defined $attrs->{_ordered_for_collapse};
+ $attrs->{_ordered_for_collapse} = (
+ (
+ $attrs->{order_by}
+ and
+ $rsrc->schema
+ ->storage
+ ->_extract_colinfo_of_stable_main_source_order_by_portion($attrs)
+ ) ? 1 : 0
+ ) 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
+ $cursor ||= $self->cursor;
if (scalar (my @r = $cursor->next) ) {
$rows = [ \@r ];
}
return undef unless @{$rows||[]};
- my @extra_collapser_args;
- if ($attrs->{collapse} and ! $fetch_all ) {
+ # sanity check - people are too clever for their own good
+ if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) {
- @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
- );
+ my $multiplied_selectors;
+ for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) {
+ if (
+ $aliastypes->{multiplying}{$sel_alias}
+ or
+ $aliastypes->{premultiplied}{$sel_alias}
+ ) {
+ $multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}}
+ }
+ }
+
+ for my $i (0 .. $#{$attrs->{as}} ) {
+ my $sel = $attrs->{select}[$i];
+
+ if (ref $sel eq 'SCALAR') {
+ $sel = $$sel;
+ }
+ elsif( ref $sel eq 'REF' and ref $$sel eq 'ARRAY' ) {
+ $sel = $$sel->[0];
+ }
+
+ $self->throw_exception(
+ 'Result collapse not possible - selection from a has_many source redirected to the main object'
+ ) if ($multiplied_selectors->{$sel} and $attrs->{as}[$i] !~ /\./);
+ }
}
# hotspot - skip the setter
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};
+ $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 == \&DBIx::Class::ResultClass::HashRefInflator::inflate_result
+ ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri};
+
- if ($attrs->{_single_resultclass_inflation}) {
- # construct a much simpler array->hash folder for the one-table cases right here
+ if ($attrs->{_simple_passthrough_construction}) {
+ # construct a much simpler array->hash folder for the one-table HRI cases right here
if ($self->{_result_inflator}{is_hri}) {
for my $r (@$rows) {
$r = { map { $infmap->[$_] => $r->[$_] } 0..$#$infmap };
#
# crude unscientific benchmarking indicated the shortcut eval is not worth it for
# this particular resultset size
- elsif (@$rows < 60) {
+ elsif ( $self->{_result_inflator}{is_core_row} and @$rows < 60 ) {
for my $r (@$rows) {
$r = $inflator_cref->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } (0..$#$infmap) } );
}
}
else {
eval sprintf (
- '$_ = $inflator_cref->($res_class, $rsrc, { %s }) for @$rows',
- join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap )
+ ( $self->{_result_inflator}{is_core_row}
+ ? '$_ = $inflator_cref->($res_class, $rsrc, { %s }) for @$rows'
+ # a custom inflator may be a multiplier/reductor - put it in direct list ctx
+ : '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows'
+ ),
+ ( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) )
);
}
}
- # Special-case multi-object HRI (we always prune)
- elsif ($self->{_result_inflator}{is_hri}) {
- ( $self->{_row_parser}{hri} ||= $rsrc->_mk_row_parser({
- eval => 1,
- inflate_map => $infmap,
- selection => $attrs->{select},
- 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_hri} ? 'hri'
+ : $self->{_result_inflator}{is_core_row} ? 'classic_pruning'
+ : 'classic_nonpruning'
+ ;
- # The rationale is - if this is the ::Row inflator itself, or an around()
- # we do prune, because we expect it.
- # If not the case - let the user deal with the full output themselves
- # Warn them while we are at it so we get a better idea what is out there
- # on the DarkPan
- $self->{_result_inflator}{prune_null_branches} = do {
- $res_class->isa('DBIx::Class::Row')
- } ? 1 : 0 unless defined $self->{_result_inflator}{prune_null_branches};
-
- unless ($self->{_result_inflator}{prune_null_branches}) {
- carp_once (
- "ResultClass $res_class does not inherit from DBIx::Class::Row and "
- . 'therefore its inflate_result() will receive the full prefetched data '
- . 'tree, without any branch definedness checks. This is a compatibility '
- . 'measure which will eventually disappear entirely. Please refer to '
- . 't/resultset/inflate_result_api.t for an exhaustive description of the '
- . 'upcoming changes'
- );
- }
-
- ( $self->{_row_parser}{classic}{$self->{_result_inflator}{prune_null_branches}} ||= $rsrc->_mk_row_parser({
+ # $args and $attrs to _mk_row_parser are separated to delineate what is
+ # core collapser stuff and what is dbic $rs specific
+ @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $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}{prune_null_branches},
- }) )->($rows, @extra_collapser_args);
+ hri_style => $self->{_result_inflator}{is_hri},
+ prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
+ }, $attrs) unless $self->{_row_parser}{$parser_type}{cref};
+
+ # column_info metadata historically hasn't been too reliable.
+ # We need to start fixing this somehow (the collapse resolver
+ # can't work without it). Add an explicit check for the *main*
+ # result, hopefully this will gradually weed out such errors
+ #
+ # FIXME - this is a temporary kludge that reduces performance
+ # It is however necessary for the time being
+ my ($unrolled_non_null_cols_to_check, $err);
- $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows;
+ if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) {
+
+ $err =
+ 'Collapse aborted due to invalid ResultSource metadata - the following '
+ . 'selections are declared non-nullable but NULLs were retrieved: '
+ ;
+
+ my @violating_idx;
+ COL: for my $i (@$check_non_null_cols) {
+ ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows;
+ }
+
+ $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
+ if @violating_idx;
+
+ $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols);
+
+ utf8::upgrade($unrolled_non_null_cols_to_check)
+ if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
+ }
+
+ my $next_cref =
+ ($did_fetch_all or ! $attrs->{collapse}) ? undef
+ : defined $unrolled_non_null_cols_to_check ? eval sprintf <<'EOS', $unrolled_non_null_cols_to_check
+sub {
+ # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
+ my @r = $cursor->next or return;
+ if (my @violating_idx = grep { ! defined $r[$_] } (%s) ) {
+ $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
}
+ \@r
+}
+EOS
+ : sub {
+ # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
+ my @r = $cursor->next or return;
+ \@r
+ }
+ ;
- # CDBI compat stuff
- if ($attrs->{record_filter}) {
- $_ = $attrs->{record_filter}->($_) for @$rows;
+ $self->{_row_parser}{$parser_type}{cref}->(
+ $rows,
+ $next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (),
+ );
+
+ # simple in-place substitution, does not regrow $rows
+ if ($self->{_result_inflator}{is_core_row}) {
+ $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows
+ }
+ # Special-case multi-object HRI - there is no $inflator_cref pass at all
+ elsif ( ! $self->{_result_inflator}{is_hri} ) {
+ # the inflator may be a multiplier/reductor - put it in list ctx
+ @$rows = map { $inflator_cref->($res_class, $rsrc, @$_) } @$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;
}
Note that changing the result_class will also remove any components
that were originally loaded in the source class via
-L<DBIx::Class::ResultSource/load_components>. Any overloaded methods
-in the original source class will not run.
+L<load_components|Class::C3::Componentised/load_components( @comps )>.
+Any overloaded methods in the original source class will not run.
=cut
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};
}
# software based limiting can not be ported if this $rs is to be used
# in a subquery itself (i.e. ->as_query)
if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
- return $self->_count_subq_rs;
+ return $self->_count_subq_rs($self->{_attrs});
}
else {
- return $self->_count_rs;
+ return $self->_count_rs($self->{_attrs});
}
}
my ($self, $attrs) = @_;
my $rsrc = $self->result_source;
- $attrs ||= $self->_resolved_attrs;
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/};
# overwrite the selector (supplied by the storage)
- $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
- $tmp_attrs->{as} = 'count';
-
- my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
-
- return $tmp_rs;
+ $rsrc->resultset_class->new($rsrc, {
+ %$tmp_attrs,
+ select => $rsrc->storage->_count_select ($rsrc, $attrs),
+ as => 'count',
+ })->get_column ('count');
}
#
my ($self, $attrs) = @_;
my $rsrc = $self->result_source;
- $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/};
+ delete @{$sub_attrs}{qw/collapse columns as select 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 = (
# simplify the joinmap, so we can further decide if a subq is necessary
if (!$needs_subq and @{$attrs->{from}} > 1) {
- $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $self->{cond}, $attrs);
-
- # check if there are any joins left after the prune
- if ( @{$attrs->{from}} > 1 ) {
- $join_classifications = $storage->_resolve_aliastypes_from_select_args (
- [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ],
- $attrs->{select},
- $self->{cond},
- $attrs
- );
- # any non-pruneable joins imply subq
- $needs_subq = scalar keys %{ $join_classifications->{restricting} || {} };
- }
+ ($attrs->{from}, $join_classifications) =
+ $storage->_prune_unused_joins ($attrs);
+
+ # any non-pruneable non-local restricting joins imply subq
+ $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
}
# check if the head is composite (by now all joins are thrown out unless $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/;
$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
+
+ # this will be consumed by the pruner waaaaay down the stack
+ $attrs->{_force_prune_multiplying_joins} = 1;
+
my $subrs = (ref $self)->new($rsrc, $attrs);
if (@$idcols == 1) {
if (
$existing_group_by
or
+ # we do not need to check pre-multipliers, since if the premulti is there, its
+ # parent (who is multi) will be there too
keys %{ $join_classifications->{multiplying} || {} }
) {
# make sure if there is a supplied group_by it matches the columns compiled above
$guard = $storage->txn_scope_guard;
- $cond = [];
for my $row ($subrs->cursor->all) {
push @$cond, { map
{ $idcols->[$_] => $row->[$_] }
}
}
- my $res = $storage->$op (
+ my $res = $cond ? $storage->$op (
$rsrc,
$op eq 'update' ? $values : (),
$cond,
- );
+ ) : '0E0';
$guard->commit if $guard;
element should be a data value in the earlier specified column order.
For example:
- $Arstist_rs->populate([
+ $schema->resultset("Artist")->populate([
[ qw( artistid name ) ],
[ 100, 'A Formally Unknown Singer' ],
[ 101, 'A singer that jumped the shark two albums ago' ],
sub populate {
my $self = shift;
- # cruft placed in standalone method
- my $data = $self->_normalize_populate_args(@_);
+ # this is naive and just a quick check
+ # the types will need to be checked more thoroughly when the
+ # multi-source populate gets added
+ my $data = (
+ ref $_[0] eq 'ARRAY'
+ and
+ ( @{$_[0]} or return )
+ and
+ ( ref $_[0][0] eq 'HASH' or ref $_[0][0] eq 'ARRAY' )
+ and
+ $_[0]
+ ) or $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
- return unless @$data;
+ # FIXME - no cref handling
+ # At this point assume either hashes or arrays
if(defined wantarray) {
- my @created = map { $self->create($_) } @$data;
- return wantarray ? @created : \@created;
- }
- else {
- my $first = $data->[0];
+ my (@results, $guard);
- # 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->{$_};
- $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
- ? push @rels, $_
- : push @columns, $_
+ if (ref $data->[0] eq 'ARRAY') {
+ # column names only, nothing to do
+ return if @$data == 1;
+
+ $guard = $self->result_source->schema->storage->txn_scope_guard
+ if @$data > 2;
+
+ @results = map
+ { my $vals = $_; $self->new_result({ map { $data->[0][$_] => $vals->[$_] } 0..$#{$data->[0]} })->insert }
+ @{$data}[1 .. $#$data]
;
}
+ else {
+
+ $guard = $self->result_source->schema->storage->txn_scope_guard
+ if @$data > 1;
+
+ @results = map { $self->new_result($_)->insert } @$data;
+ }
+
+ $guard->commit if $guard;
+ return wantarray ? @results : \@results;
+ }
+
+ # we have to deal with *possibly incomplete* related data
+ # this means we have to walk the data structure twice
+ # whether we want this or not
+ # jnap, I hate you ;)
+ my $rsrc = $self->result_source;
+ my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
+
+ my ($colinfo, $colnames, $slices_with_rels);
+ my $data_start = 0;
- my @pks = $rsrc->primary_columns;
+ DATA_SLICE:
+ for my $i (0 .. $#$data) {
- ## do the belongs_to relationships
- foreach my $index (0..$#$data) {
+ my $current_slice_seen_rel_infos;
- # delegate to create() for any dataset without primary keys with specified relationships
- if (grep { !defined $data->[$index]->{$_} } @pks ) {
- for my $r (@rels) {
- if (grep { ref $data->[$index]{$r} eq $_ } qw/HASH ARRAY/) { # a related set must be a HASH or AoH
- my @ret = $self->populate($data);
- return;
+### Determine/Supplement collists
+### BEWARE - This is a hot piece of code, a lot of weird idioms were used
+ if( ref $data->[$i] eq 'ARRAY' ) {
+
+ # positional(!) explicit column list
+ if ($i == 0) {
+ # column names only, nothing to do
+ return if @$data == 1;
+
+ $colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_]
+ for 0 .. $#{$data->[0]};
+
+ $data_start = 1;
+
+ next DATA_SLICE;
+ }
+ else {
+ for (values %$colinfo) {
+ if ($_->{is_rel} ||= (
+ $rel_info->{$_->{name}}
+ and
+ (
+ ref $data->[$i][$_->{pos}] eq 'ARRAY'
+ or
+ ref $data->[$i][$_->{pos}] eq 'HASH'
+ or
+ ( defined blessed $data->[$i][$_->{pos}] and $data->[$i][$_->{pos}]->isa('DBIx::Class::Row') )
+ )
+ and
+ 1
+ )) {
+
+ # moar sanity check... sigh
+ for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) {
+ if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
+ carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
+ return my $throwaway = $self->populate(@_);
+ }
+ }
+
+ push @$current_slice_seen_rel_infos, $rel_info->{$_->{name}};
}
}
}
- foreach my $rel (@rels) {
- next unless ref $data->[$index]->{$rel} eq "HASH";
- my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
- my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
- my $related = $result->result_source->_resolve_condition(
- $reverse_relinfo->{cond},
- $self,
- $result,
- $rel,
- );
-
- delete $data->[$index]->{$rel};
- $data->[$index] = {%{$data->[$index]}, %$related};
+ if ($current_slice_seen_rel_infos) {
+ push @$slices_with_rels, { map { $colnames->[$_] => $data->[$i][$_] } 0 .. $#$colnames };
- push @columns, keys %$related if $index == 0;
+ # this is needed further down to decide whether or not to fallback to create()
+ $colinfo->{$colnames->[$_]}{seen_null} ||= ! defined $data->[$i][$_]
+ for 0 .. $#$colnames;
}
}
+ elsif( ref $data->[$i] eq 'HASH' ) {
- ## inherit the data locked in the conditions of the resultset
- my ($rs_data) = $self->_merge_with_rscond({});
- delete @{$rs_data}{@columns};
-
- ## do bulk insert on current row
- $rsrc->storage->insert_bulk(
- $rsrc,
- [@columns, keys %$rs_data],
- [ map { [ @$_{@columns}, values %$rs_data ] } @$data ],
- );
+ for ( sort keys %{$data->[$i]} ) {
- ## do the has_many relationships
- foreach my $item (@$data) {
+ $colinfo->{$_} ||= do {
- my $main_row;
+ $self->throw_exception("Column '$_' must be present in supplied explicit column list")
+ if $data_start; # it will be 0 on AoH, 1 on AoA
- foreach my $rel (@rels) {
- next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
+ push @$colnames, $_;
- $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
+ # RV
+ { pos => $#$colnames, name => $_ }
+ };
- my $child = $main_row->$rel;
+ if ($colinfo->{$_}{is_rel} ||= (
+ $rel_info->{$_}
+ and
+ (
+ ref $data->[$i]{$_} eq 'ARRAY'
+ or
+ ref $data->[$i]{$_} eq 'HASH'
+ or
+ ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIx::Class::Row') )
+ )
+ and
+ 1
+ )) {
+
+ # moar sanity check... sigh
+ for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) {
+ if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
+ carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
+ return my $throwaway = $self->populate(@_);
+ }
+ }
- my $related = $child->result_source->_resolve_condition(
- $rels->{$rel}{cond},
- $child,
- $main_row,
- $rel,
- );
+ push @$current_slice_seen_rel_infos, $rel_info->{$_};
+ }
+ }
- my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
- my @populate = map { {%$_, %$related} } @rows_to_add;
+ if ($current_slice_seen_rel_infos) {
+ push @$slices_with_rels, $data->[$i];
- $child->populate( \@populate );
+ # this is needed further down to decide whether or not to fallback to create()
+ $colinfo->{$_}{seen_null} ||= ! defined $data->[$i]{$_}
+ for keys %{$data->[$i]};
}
}
+ else {
+ $self->throw_exception('Unexpected populate() data structure member type: ' . ref $data->[$i] );
+ }
+
+ if ( grep
+ { $_->{attrs}{is_depends_on} }
+ @{ $current_slice_seen_rel_infos || [] }
+ ) {
+ carp_unique("Fast-path populate() of belongs_to relationship data is not possible - falling back to regular create()");
+ return my $throwaway = $self->populate(@_);
+ }
}
-}
+ if( $slices_with_rels ) {
-# populate() argumnets went over several incarnations
-# What we ultimately support is AoH
-sub _normalize_populate_args {
- my ($self, $arg) = @_;
+ # need to exclude the rel "columns"
+ $colnames = [ grep { ! $colinfo->{$_}{is_rel} } @$colnames ];
- if (ref $arg eq 'ARRAY') {
- if (!@$arg) {
- return [];
- }
- elsif (ref $arg->[0] eq 'HASH') {
- return $arg;
- }
- elsif (ref $arg->[0] eq 'ARRAY') {
- my @ret;
- my @colnames = @{$arg->[0]};
- foreach my $values (@{$arg}[1 .. $#$arg]) {
- push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
- }
- return \@ret;
+ # extra sanity check - ensure the main source is in fact identifiable
+ # the localizing of nullability is insane, but oh well... the use-case is legit
+ my $ci = $rsrc->columns_info($colnames);
+
+ $ci->{$_} = { %{$ci->{$_}}, is_nullable => 0 }
+ for grep { ! $colinfo->{$_}{seen_null} } keys %$ci;
+
+ unless( $rsrc->_identifying_column_set($ci) ) {
+ carp_unique("Fast-path populate() of non-uniquely identifiable rows with related data is not possible - falling back to regular create()");
+ return my $throwaway = $self->populate(@_);
}
}
- $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
-}
+### inherit the data locked in the conditions of the resultset
+ my ($rs_data) = $self->_merge_with_rscond({});
+ delete @{$rs_data}{@$colnames}; # passed-in stuff takes precedence
-=head2 pager
+ # if anything left - decompose rs_data
+ my $rs_data_vals;
+ if (keys %$rs_data) {
+ push @$rs_data_vals, $rs_data->{$_}
+ for sort keys %$rs_data;
+ }
-=over 4
+### start work
+ my $guard;
+ $guard = $rsrc->schema->storage->txn_scope_guard
+ if $slices_with_rels;
-=item Arguments: none
+### main source data
+ # FIXME - need to switch entirely to a coderef-based thing,
+ # so that large sets aren't copied several times... I think
+ $rsrc->storage->_insert_bulk(
+ $rsrc,
+ [ @$colnames, sort keys %$rs_data ],
+ [ map {
+ ref $data->[$_] eq 'ARRAY'
+ ? (
+ $slices_with_rels ? [ @{$data->[$_]}[0..$#$colnames], @{$rs_data_vals||[]} ] # the collist changed
+ : $rs_data_vals ? [ @{$data->[$_]}, @$rs_data_vals ]
+ : $data->[$_]
+ )
+ : [ @{$data->[$_]}{@$colnames}, @{$rs_data_vals||[]} ]
+ } $data_start .. $#$data ],
+ );
-=item Return Value: L<$pager|Data::Page>
+### do the children relationships
+ if ( $slices_with_rels ) {
+ my @rels = grep { $colinfo->{$_}{is_rel} } keys %$colinfo
+ or die 'wtf... please report a bug with DBIC_TRACE=1 output (stacktrace)';
-=back
+ for my $sl (@$slices_with_rels) {
-Returns a L<Data::Page> object for the current resultset. Only makes
-sense for queries with a C<page> attribute.
+ my ($main_proto, $main_proto_rs);
+ for my $rel (@rels) {
+ next unless defined $sl->{$rel};
-To get the full count of entries for a paged resultset, call
-C<total_entries> on the L<Data::Page> object.
+ $main_proto ||= {
+ %$rs_data,
+ (map { $_ => $sl->{$_} } @$colnames),
+ };
-=cut
+ unless (defined $colinfo->{$rel}{rs}) {
-sub pager {
+ $colinfo->{$rel}{rs} = $rsrc->related_source($rel)->resultset;
+
+ $colinfo->{$rel}{fk_map} = { reverse %{ $rsrc->_resolve_relationship_condition(
+ rel_name => $rel,
+ self_alias => "\xFE", # irrelevant
+ foreign_alias => "\xFF", # irrelevant
+ )->{identity_map} || {} } };
+
+ }
+
+ $colinfo->{$rel}{rs}->search({ map # only so that we inherit them values properly, no actual search
+ {
+ $_ => { '=' =>
+ ( $main_proto_rs ||= $rsrc->resultset->search($main_proto) )
+ ->get_column( $colinfo->{$rel}{fk_map}{$_} )
+ ->as_query
+ }
+ }
+ keys %{$colinfo->{$rel}{fk_map}}
+ })->populate( ref $sl->{$rel} eq 'ARRAY' ? $sl->{$rel} : [ $sl->{$rel} ] );
+
+ 1;
+ }
+ }
+ }
+
+ $guard->commit if $guard;
+}
+
+=head2 pager
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: L<$pager|Data::Page>
+
+=back
+
+Returns a L<Data::Page> object for the current resultset. Only makes
+sense for queries with a C<page> attribute.
+
+To get the full count of entries for a paged resultset, call
+C<total_entries> on the L<Data::Page> object.
+
+=cut
+
+sub pager {
my ($self) = @_;
return $self->{pager} if $self->{pager};
$self->throw_exception( "new_result takes only one argument - a hashref of values" )
if @_ > 2;
- $self->throw_exception( "new_result expects a hashref" )
+ $self->throw_exception( "Result object instantiation requires a hashref as argument" )
unless (ref $values eq 'HASH');
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
- );
+ });
+
+ 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,
+ ));
+ }
- return $self->result_class->new(\%new);
+ $new;
}
# _merge_with_rscond
sub _merge_with_rscond {
my ($self, $data) = @_;
- my (%new_data, @cols_from_relations);
+ my ($implied_data, @cols_from_relations);
my $alias = $self->{attrs}{alias};
if (! defined $self->{cond}) {
# just massage $data below
}
- elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
- %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet
- @cols_from_relations = keys %new_data;
- }
- elsif (ref $self->{cond} ne 'HASH') {
- $self->throw_exception(
- "Can't abstract implicit construct, resultset condition not a hash"
- );
+ elsif ($self->{cond} eq UNRESOLVABLE_CONDITION) {
+ $implied_data = $self->{attrs}{related_objects}; # nothing might have been inserted yet
+ @cols_from_relations = keys %{ $implied_data || {} };
}
else {
- # precendence must be given to passed values over values inherited from
- # the cond, so the order here is important.
- my $collapsed_cond = $self->_collapse_cond($self->{cond});
- my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
-
- while ( my($col, $value) = each %implied ) {
- my $vref = ref $value;
- 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) ) {
- $new_data{$col} = $value;
- }
- }
+ my $eqs = $self->result_source->schema->storage->_extract_fixed_condition_columns($self->{cond}, 'consider_nulls');
+ $implied_data = { map {
+ ( ($eqs->{$_}||'') eq UNRESOLVABLE_CONDITION ) ? () : ( $_ => $eqs->{$_} )
+ } keys %$eqs };
}
- %new_data = (
- %new_data,
- %{ $self->_remove_alias($data, $alias) },
+ return (
+ { map
+ { %{ $self->_remove_alias($_, $alias) } }
+ # precedence must be given to passed values over values inherited from
+ # the cond, so the order here is important.
+ ( $implied_data||(), $data)
+ },
+ \@cols_from_relations
);
-
- return (\%new_data, \@cols_from_relations);
}
# _has_resolved_attr
# determines if the resultset defines at least one
# of the attributes supplied
#
-# used to determine if a subquery is neccessary
+# used to determine if a subquery is necessary
#
# supports some virtual attributes:
# -join
return 0;
}
-# _collapse_cond
-#
-# Recursively collapse the condition.
-
-sub _collapse_cond {
- my ($self, $cond, $collapsed) = @_;
-
- $collapsed ||= {};
-
- if (ref $cond eq 'ARRAY') {
- foreach my $subcond (@$cond) {
- next unless ref $subcond; # -or
- $collapsed = $self->_collapse_cond($subcond, $collapsed);
- }
- }
- elsif (ref $cond eq 'HASH') {
- if (keys %$cond and (keys %$cond)[0] eq '-and') {
- foreach my $subcond (@{$cond->{-and}}) {
- $collapsed = $self->_collapse_cond($subcond, $collapsed);
- }
- }
- else {
- foreach my $col (keys %$cond) {
- my $value = $cond->{$col};
- $collapsed->{$col} = $value;
- }
- }
- }
-
- return $collapsed;
-}
-
# _remove_alias
#
# Remove the specified alias from the specified query hash. A copy is made so
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);
+ my $aq = $self->result_source->storage->_select_args_to_query (
+ $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
+ );
- return $sqlbind;
+ $aq;
}
=head2 find_or_new
{ artist => 'fred' }, { key => 'artists' });
$cd->cd_to_producer->find_or_new({ producer => $producer },
- { key => 'primary });
+ { key => 'primary' });
Find an existing record from this resultset using L</find>. if none exists,
instantiate a new result object and return it. The object will not be saved
=cut
sub create {
- my ($self, $attrs) = @_;
- $self->throw_exception( "create needs a hashref" )
- unless ref $attrs eq 'HASH';
- return $self->new_result($attrs)->insert;
+ #my ($self, $col_data) = @_;
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ return shift->new_result(shift)->insert;
}
=head2 find_or_create
if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
return $row;
}
- return $self->create($hash);
+ return $self->new_result($hash)->insert;
}
=head2 update_or_create
return $row;
}
- return $self->create($cond);
+ return $self->new_result($cond)->insert;
}
=head2 update_or_new
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);
#XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
delete @{$attrs}{qw(result_class alias)};
- my $related_cache;
-
- if (my $cache = $self->get_cache) {
- $related_cache = [ map
- { @{$_->related_resultset($rel)->get_cache||[]} }
- @$cache
- ];
- }
-
my $rel_source = $rsrc->related_source($rel);
my $new = do {
where => $attrs->{where},
});
};
- $new->set_cache($related_cache) if $related_cache;
+
+ if (my $cache = $self->get_cache) {
+ my @related_cache = map
+ { $_->related_resultset($rel)->get_cache || () }
+ @$cache
+ ;
+
+ $new->set_cache([ map @$_, @related_cache ]) if @related_cache == @$cache;
+ }
+
$new;
};
}
# ->_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};
my $attrs = { %{ $self->{attrs} || {} } };
- my $source = $self->result_source;
+ my $source = $attrs->{result_source} = $self->result_source;
my $alias = $attrs->{alias};
+ $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported")
+ if $attrs->{collapse} and $attrs->{distinct};
+
# default selection list
$attrs->{columns} = [ $source->columns ]
unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
}
}
- # 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;
];
}
- if ( defined $attrs->{order_by} ) {
- $attrs->{order_by} = (
- ref( $attrs->{order_by} ) eq 'ARRAY'
- ? [ @{ $attrs->{order_by} } ]
- : [ $attrs->{order_by} || () ]
- );
- }
-
- if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
- $attrs->{group_by} = [ $attrs->{group_by} ];
- }
+ for my $attr (qw(order_by group_by)) {
- # generate the distinct induced group_by early, as prefetch will be carried via a
- # subquery (since a group_by is present)
- if (delete $attrs->{distinct}) {
- if ($attrs->{group_by}) {
- carp_unique ("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.
- $attrs->{group_by} = $source->storage->_group_over_selection (
- $attrs->{from},
- $attrs->{select},
- $attrs->{order_by},
+ if ( defined $attrs->{$attr} ) {
+ $attrs->{$attr} = (
+ ref( $attrs->{$attr} ) eq 'ARRAY'
+ ? [ @{ $attrs->{$attr} } ]
+ : [ $attrs->{$attr} || () ]
);
+
+ delete $attrs->{$attr} unless @{$attrs->{$attr}};
}
}
# generate selections based on the prefetch helper
- my $prefetch;
+ my ($prefetch, @prefetch_select, @prefetch_as);
$prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
if defined $attrs->{prefetch};
$self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
if $attrs->{_dark_selector};
+ $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported")
+ if defined $attrs->{collapse} and ! $attrs->{collapse};
+
$attrs->{collapse} = 1;
# this is a separate structure (we don't look in {from} directly)
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;
- $attrs->{collapse} = 0;
+ # save these for after distinct resolution
+ @prefetch_select = map { $_->[0] } @prefetch;
+ @prefetch_as = map { $_->[1] } @prefetch;
}
# run through the resulting joinstructure (starting from our current slot)
- # and unset collapse if proven unnesessary
+ # and unset collapse if proven unnecessary
#
# also while we are at it find out if the current root source has
# been premultiplied by previous related_source chaining
if (ref $attrs->{from} eq 'ARRAY') {
- if (@{$attrs->{from}} <= 1) {
+ if (@{$attrs->{from}} == 1) {
# no joins - no collapse
$attrs->{collapse} = 0;
}
}
}
+ # generate the distinct induced group_by before injecting the prefetched select/as parts
+ if (delete $attrs->{distinct}) {
+ if ($attrs->{group_by}) {
+ 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}, my $new_order) = $source->storage->_group_over_selection($attrs);
+
+ # FIXME possibly ignore a rewritten order_by (may turn out to be an issue)
+ # The thinking is: if we are collapsing the subquerying prefetch engine will
+ # rip stuff apart for us anyway, and we do not want to have a potentially
+ # function-converted external order_by
+ # ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks )
+ $attrs->{order_by} = $new_order unless $attrs->{collapse};
+ }
+ }
+
+ # inject prefetch-bound selection (if any)
+ push @{$attrs->{select}}, @prefetch_select;
+ push @{$attrs->{as}}, @prefetch_as;
+
+ $attrs->{_simple_passthrough_construction} = !(
+ $attrs->{collapse}
+ or
+ grep { $_ =~ /\./ } @{$attrs->{as}}
+ );
+
# 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
}
}
+1;
+
+__END__
+
# XXX: FIXME: Attributes docs need clearing up
=head1 ATTRIBUTES
=over 4
-=item Value: \@columns
+=item Value: \@columns | \%columns | $column
=back
Shortcut to request a particular set of columns to be retrieved. Each
column spec may be a string (a table column name), or a hash (in which
case the key is the C<as> value, and the value is used as the C<select>
-expression). Adds C<me.> onto the start of any column without a C<.> in
+expression). Adds the L</current_source_alias> 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>.
- columns => [ 'foo', { bar => 'baz' } ]
+ columns => [ 'some_column', { dbic_slot => 'another_column' } ]
is the same as
- select => [qw/foo baz/],
- as => [qw/foo bar/]
+ select => [qw(some_column another_column)],
+ as => [qw(some_column dbic_slot)]
+
+If you want to individually retrieve related columns (in essence perform
+manual prefetch) you have to make sure to specify the correct inflation slot
+chain such that it matches existing relationships:
+
+ my $rs = $schema->resultset('Artist')->search({}, {
+ # required to tell DBIC to collapse has_many relationships
+ collapse => 1,
+ join => { cds => 'tracks'},
+ '+columns' => {
+ 'cds.cdid' => 'cds.cdid',
+ 'cds.tracks.title' => 'tracks.title',
+ },
+ });
+
+Like elsewhere, literal SQL or literal values can be included by using a
+scalar reference or a literal bind value, and these values will be available
+in the result with C<get_column> (see also
+L<SQL::Abstract/Literal SQL and value type operators>):
+
+ # equivalent SQL: SELECT 1, 'a string', IF(my_column,?,?) ...
+ # bind values: $true_value, $false_value
+ columns => [
+ {
+ foo => \1,
+ bar => \q{'a string'},
+ baz => \[ 'IF(my_column,?,?)', $true_value, $false_value ],
+ }
+ ]
=head2 +columns
+B<NOTE:> You B<MUST> explicitly quote C<'+columns'> when using this attribute.
+Not doing so causes Perl to incorrectly interpret C<+columns> as a bareword
+with a unary plus operator before it, which is the same as simply C<columns>.
+
=over 4
-=item Value: \@columns
+=item Value: \@extra_columns
=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 current selection. (You may also use the
+C<include_columns> attribute, as in earlier versions of DBIC, but this is
+deprecated)
$schema->resultset('CD')->search(undef, {
'+columns' => ['artist.name'],
column (or relationship) accessor, and 'name' is the name of the column
accessor in the related table.
-B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
-Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
-unary plus operator before it.
-
-=head2 include_columns
-
-=over 4
-
-=item Value: \@columns
-
-=back
-
-Deprecated. Acts as a synonym for L</+columns> for backward compatibility.
-
=head2 select
=over 4
B<NOTE:> You will almost always need a corresponding L</as> attribute when you
use L</select>, to instruct DBIx::Class how to store the result of the column.
-Also note that the L</as> attribute has nothing to do with the SQL-side 'AS'
-identifier aliasing. You can however alias a function, so you can use it in
-e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
-attribute> supplied as shown in the example above.
-B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
-Not doing so causes Perl to incorrectly interpret them as a bareword with a
-unary plus operator before it.
+Also note that the L</as> attribute has B<nothing to do> with the SQL-side
+C<AS> identifier aliasing. You B<can> alias a function (so you can use it e.g.
+in an C<ORDER BY> clause), however this is done via the C<-as> B<select
+function attribute> supplied as shown in the example above.
=head2 +select
-=over 4
-
-Indicates additional columns to be selected from storage. Works the same as
-L</select> but adds columns to the default selection, instead of specifying
-an explicit list.
-
-=back
-
-=head2 +as
+B<NOTE:> You B<MUST> explicitly quote C<'+select'> when using this attribute.
+Not doing so causes Perl to incorrectly interpret C<+select> as a bareword
+with a unary plus operator before it, which is the same as simply C<select>.
=over 4
-Indicates additional column names for those added via L</+select>. See L</as>.
+=item Value: \@extra_select_columns
=back
+Indicates additional columns to be selected from storage. Works the same as
+L</select> but adds columns to the current selection, instead of specifying
+a new explicit list.
+
=head2 as
=over 4
=back
-Indicates column names for object inflation. That is L</as> indicates the
+Indicates DBIC-side names for object inflation. That is L</as> indicates the
slot name in which the column value will be stored within the
L<Row|DBIx::Class::Row> object. The value will then be accessible via this
identifier by the C<get_column> method (or via the object accessor B<if one
-with the same name already exists>) as shown below. The L</as> attribute has
-B<nothing to do> with the SQL-side C<AS>. See L</select> for details.
+with the same name already exists>) as shown below.
+
+The L</as> attribute has B<nothing to do> with the SQL-side identifier
+aliasing C<AS>. See L</select> for details.
$rs = $schema->resultset('Employee')->search(undef, {
select => [
You can create your own accessors if required - see
L<DBIx::Class::Manual::Cookbook> for details.
+=head2 +as
+
+B<NOTE:> You B<MUST> explicitly quote C<'+as'> when using this attribute.
+Not doing so causes Perl to incorrectly interpret C<+as> as a bareword
+with a unary plus operator before it, which is the same as simply C<as>.
+
+=over 4
+
+=item Value: \@extra_inflation_names
+
+=back
+
+Indicates additional inflation names for selectors added via L</+select>. See L</as>.
+
=head2 join
=over 4
will return a set of all artists that have both a cd with title 'Down
to Earth' and a cd with title 'Popular'.
-If you want to fetch related objects from other tables as well, see C<prefetch>
+If you want to fetch related objects from other tables as well, see L</prefetch>
below.
NOTE: An internal join-chain pruner will discard certain joins while
For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
-=head2 prefetch
+=head2 collapse
=over 4
-=item Value: ($rel_name | \@rel_names | \%rel_names)
+=item Value: (0 | 1)
=back
-Contains one or more relationships that should be fetched along with
-the main query (when they are accessed afterwards the data will
-already be available, without extra queries to the database). This is
-useful for when you know you will need the related objects, because it
-saves at least one query:
-
- my $rs = $schema->resultset('Tag')->search(
- undef,
- {
- prefetch => {
- cd => 'artist'
- }
- }
- );
-
-The initial search results in SQL like the following:
-
- SELECT tag.*, cd.*, artist.* FROM tag
- JOIN cd ON tag.cd = cd.cdid
- JOIN artist ON cd.artist = artist.artistid
-
-L<DBIx::Class> has no need to go back to the database when we access the
-C<cd> or C<artist> relationships, which saves us two SQL statements in this
-case.
-
-Simple prefetches will be joined automatically, so there is no need
-for a C<join> attribute in the above search.
-
-L</prefetch> can be used with the any of the relationship types and
-multiple prefetches can be specified together. Below is a more complex
-example that prefetches a CD's artist, its liner notes (if present),
-the cover image, the tracks on that cd, and the guests on those
-tracks.
-
- # Assuming:
- My::Schema::CD->belongs_to( artist => 'My::Schema::Artist' );
- My::Schema::CD->might_have( liner_note => 'My::Schema::LinerNotes' );
- My::Schema::CD->has_one( cover_image => 'My::Schema::Artwork' );
- My::Schema::CD->has_many( tracks => 'My::Schema::Track' );
-
- My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
-
- My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
-
-
- my $rs = $schema->resultset('CD')->search(
- undef,
- {
- prefetch => [
- { artist => 'record_label'}, # belongs_to => belongs_to
- 'liner_note', # might_have
- 'cover_image', # has_one
- { tracks => 'guests' }, # has_many => has_many
- ]
- }
- );
-
-This will produce SQL like the following:
-
- SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
- tracks.*, guests.*
- FROM cd me
- JOIN artist artist
- ON artist.artistid = me.artistid
- JOIN record_label record_label
- ON record_label.labelid = artist.labelid
- LEFT JOIN track tracks
- ON tracks.cdid = me.cdid
- LEFT JOIN guest guests
- ON guests.trackid = track.trackid
- LEFT JOIN liner_notes liner_note
- ON liner_note.cdid = me.cdid
- JOIN cd_artwork cover_image
- ON cover_image.cdid = me.cdid
- ORDER BY tracks.cd
-
-Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
-C<tracks>, and C<guests> of the CD will all be available through the
-relationship accessors without the need for additional queries to the
-database.
-
-However, there is one caveat to be observed: it can be dangerous to
-prefetch more than one L<has_many|DBIx::Class::Relationship/has_many>
-relationship on a given level. e.g.:
-
- my $rs = $schema->resultset('CD')->search(
- undef,
- {
- prefetch => [
- 'tracks', # has_many
- { cd_to_producer => 'producer' }, # has_many => belongs_to (i.e. m2m)
- ]
- }
- );
+When set to a true value, indicates that any rows fetched from joined has_many
+relationships are to be aggregated into the corresponding "parent" object. For
+example, the resultset:
-The collapser currently can't identify duplicate tuples for multiple
-L<has_many|DBIx::Class::Relationship/has_many> relationships and as a
-result the second L<has_many|DBIx::Class::Relationship/has_many>
-relation could contain redundant objects.
-
-=head3 Using L</prefetch> with L</join>
-
-L</prefetch> implies a L</join> with the equivalent argument, and is
-properly merged with any existing L</join> specification. So the
-following:
+ my $rs = $schema->resultset('CD')->search({}, {
+ '+columns' => [ qw/ tracks.title tracks.position / ],
+ join => 'tracks',
+ collapse => 1,
+ });
- my $rs = $schema->resultset('CD')->search(
- {'record_label.name' => 'Music Product Ltd.'},
- {
- join => {artist => 'record_label'},
- prefetch => 'artist',
- }
- );
+While executing the following query:
-... will work, searching on the record label's name, but only
-prefetching the C<artist>.
+ SELECT me.*, tracks.title, tracks.position
+ FROM cd me
+ LEFT JOIN track tracks
+ ON tracks.cdid = me.cdid
-=head3 Using L</prefetch> with L</select> / L</+select> / L</as> / L</+as>
+Will return only as many objects as there are rows in the CD source, even
+though the result of the query may span many rows. Each of these CD objects
+will in turn have multiple "Track" objects hidden behind the has_many
+generated accessor C<tracks>. Without C<< collapse => 1 >>, the return values
+of this resultset would be as many CD objects as there are tracks (a "Cartesian
+product"), with each CD object containing exactly one of all fetched Track data.
-L</prefetch> implies a L</+select>/L</+as> with the fields of the
-prefetched relations. So given:
+When a collapse is requested on a non-ordered resultset, an order by some
+unique part of the main source (the left-most table) is inserted automatically.
+This is done so that the resultset is allowed to be "lazy" - calling
+L<< $rs->next|/next >> will fetch only as many rows as it needs to build the next
+object with all of its related data.
- my $rs = $schema->resultset('CD')->search(
- undef,
- {
- select => ['cd.title'],
- as => ['cd_title'],
- prefetch => 'artist',
- }
- );
+If an L</order_by> is already declared, and orders the resultset in a way that
+makes collapsing as described above impossible (e.g. C<< ORDER BY
+has_many_rel.column >> or C<ORDER BY RANDOM()>), DBIC will automatically
+switch to "eager" mode and slurp the entire resultset before constructing the
+first object returned by L</next>.
-The L</select> becomes: C<'cd.title', 'artist.*'> and the L</as>
-becomes: C<'cd_title', 'artist.*'>.
+Setting this attribute on a resultset that does not join any has_many
+relations is a no-op.
-=head3 CAVEATS
+For a more in-depth discussion, see L</PREFETCHING>.
-Prefetch does a lot of deep magic. As such, it may not behave exactly
-as you might expect.
+=head2 prefetch
=over 4
-=item *
+=item Value: ($rel_name | \@rel_names | \%rel_names)
-Prefetch uses the L</cache> to populate the prefetched relationships. This
-may or may not be what you want.
+=back
-=item *
+This attribute is a shorthand for specifying a L</join> spec, adding all
+columns from the joined related sources as L</+columns> and setting
+L</collapse> to a true value. It can be thought of as a rough B<superset>
+of the L</join> attribute.
-If you specify a condition on a prefetched relationship, ONLY those
-rows that match the prefetched condition will be fetched into that relationship.
-This means that adding prefetch to a search() B<may alter> what is returned by
-traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
+For example, the following two queries are equivalent:
- my $artist_rs = $schema->resultset('Artist')->search({
- 'cds.year' => 2008,
- }, {
- join => 'cds',
+ my $rs = $schema->resultset('Artist')->search({}, {
+ prefetch => { cds => ['genre', 'tracks' ] },
});
- my $count = $artist_rs->first->cds->count;
+and
- my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
+ my $rs = $schema->resultset('Artist')->search({}, {
+ join => { cds => ['genre', 'tracks' ] },
+ collapse => 1,
+ '+columns' => [
+ (map
+ { +{ "cds.$_" => "cds.$_" } }
+ $schema->source('Artist')->related_source('cds')->columns
+ ),
+ (map
+ { +{ "cds.genre.$_" => "genre.$_" } }
+ $schema->source('Artist')->related_source('cds')->related_source('genre')->columns
+ ),
+ (map
+ { +{ "cds.tracks.$_" => "tracks.$_" } }
+ $schema->source('Artist')->related_source('cds')->related_source('tracks')->columns
+ ),
+ ],
+ });
- my $prefetch_count = $artist_rs_prefetch->first->cds->count;
+Both producing the following SQL:
+
+ SELECT me.artistid, me.name, me.rank, me.charfield,
+ cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track,
+ genre.genreid, genre.name,
+ tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at
+ FROM artist me
+ LEFT JOIN cd cds
+ ON cds.artist = me.artistid
+ LEFT JOIN genre genre
+ ON genre.genreid = cds.genreid
+ LEFT JOIN track tracks
+ ON tracks.cd = cds.cdid
+ ORDER BY me.artistid
+
+While L</prefetch> implies a L</join>, it is ok to mix the two together, as
+the arguments are properly merged and generally do the right thing. For
+example, you may want to do the following:
+
+ my $artists_and_cds_without_genre = $schema->resultset('Artist')->search(
+ { 'genre.genreid' => undef },
+ {
+ join => { cds => 'genre' },
+ prefetch => 'cds',
+ }
+ );
- cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
+Which generates the following SQL:
-that cmp_ok() may or may not pass depending on the datasets involved. This
-behavior may or may not survive the 0.09 transition.
+ SELECT me.artistid, me.name, me.rank, me.charfield,
+ cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track
+ FROM artist me
+ LEFT JOIN cd cds
+ ON cds.artist = me.artistid
+ LEFT JOIN genre genre
+ ON genre.genreid = cds.genreid
+ WHERE genre.genreid IS NULL
+ ORDER BY me.artistid
-=back
+For a more in-depth discussion, see L</PREFETCHING>.
=head2 alias
=back
-HAVING is a select statement attribute that is applied between GROUP BY and
-ORDER BY. It is applied to the after the grouping calculations have been
-done.
+The HAVING operator specifies a B<secondary> condition applied to the set
+after the grouping calculations have been done. In other words it is a
+constraint just like L</where> (and accepting the same
+L<SQL::Abstract syntax|SQL::Abstract/WHERE CLAUSES>) applied to the data
+as it exists after GROUP BY has taken place. Specifying L</having> without
+L</group_by> is a logical mistake, and a fatal error on most RDBMS engines.
+
+E.g.
having => { 'count_employee' => { '>=', 100 } }
or with an in-place function in which case literal SQL is required:
- having => \[ 'count(employee) >= ?', [ count => 100 ] ]
+ having => \[ 'count(employee) >= ?', 100 ]
=head2 distinct
=back
-Set to 1 to group by all columns. If the resultset already has a group_by
-attribute, this setting is ignored and an appropriate warning is issued.
+Set to 1 to automatically generate a L</group_by> clause based on the selection
+(including intelligent handling of L</order_by> contents). Note that the group
+criteria calculation takes place over the B<final> selection. This includes
+any L</+columns>, L</+select> or L</order_by> additions in subsequent
+L</search> calls, and standalone columns selected via
+L<DBIx::Class::ResultSetColumn> (L</get_column>). A notable exception are the
+extra selections specified via L</prefetch> - such selections are explicitly
+excluded from group criteria calculations.
-=head2 where
+If the final ResultSet also explicitly defines a L</group_by> attribute, this
+setting is ignored and an appropriate warning is issued.
-=over 4
+=head2 where
-Adds to the WHERE clause.
+Adds extra conditions to the resultset, combined with the preexisting C<WHERE>
+conditions, same as the B<first> argument to the L<search operator|/search>
# only return rows WHERE deleted IS NULL for all searches
__PACKAGE__->resultset_attributes({ where => { deleted => undef } });
-Can be overridden by passing C<< { where => undef } >> as an attribute
-to a resultset.
-
-For more complicated where clauses see L<SQL::Abstract/WHERE CLAUSES>.
-
-=back
+Note that the above example is
+L<strongly discouraged|DBIx::Class::ResultSource/resultset_attributes>.
=head2 cache
... FOR SHARED. If \$scalar is passed, this is taken directly and embedded in the
query.
+=head1 PREFETCHING
+
+DBIx::Class supports arbitrary related data prefetching from multiple related
+sources. Any combination of relationship types and column sets are supported.
+If L<collapsing|/collapse> is requested, there is an additional requirement of
+selecting enough data to make every individual object uniquely identifiable.
+
+Here are some more involved examples, based on the following relationship map:
+
+ # Assuming:
+ My::Schema::CD->belongs_to( artist => 'My::Schema::Artist' );
+ My::Schema::CD->might_have( liner_note => 'My::Schema::LinerNotes' );
+ My::Schema::CD->has_many( tracks => 'My::Schema::Track' );
+
+ My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
+
+ My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
+
+
+
+ my $rs = $schema->resultset('Tag')->search(
+ undef,
+ {
+ prefetch => {
+ cd => 'artist'
+ }
+ }
+ );
+
+The initial search results in SQL like the following:
+
+ SELECT tag.*, cd.*, artist.* FROM tag
+ JOIN cd ON tag.cd = cd.cdid
+ JOIN artist ON cd.artist = artist.artistid
+
+L<DBIx::Class> has no need to go back to the database when we access the
+C<cd> or C<artist> relationships, which saves us two SQL statements in this
+case.
+
+Simple prefetches will be joined automatically, so there is no need
+for a C<join> attribute in the above search.
+
+The L</prefetch> attribute can be used with any of the relationship types
+and multiple prefetches can be specified together. Below is a more complex
+example that prefetches a CD's artist, its liner notes (if present),
+the cover image, the tracks on that CD, and the guests on those
+tracks.
+
+ my $rs = $schema->resultset('CD')->search(
+ undef,
+ {
+ prefetch => [
+ { artist => 'record_label'}, # belongs_to => belongs_to
+ 'liner_note', # might_have
+ 'cover_image', # has_one
+ { tracks => 'guests' }, # has_many => has_many
+ ]
+ }
+ );
+
+This will produce SQL like the following:
+
+ SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
+ tracks.*, guests.*
+ FROM cd me
+ JOIN artist artist
+ ON artist.artistid = me.artistid
+ JOIN record_label record_label
+ ON record_label.labelid = artist.labelid
+ LEFT JOIN track tracks
+ ON tracks.cdid = me.cdid
+ LEFT JOIN guest guests
+ ON guests.trackid = track.trackid
+ LEFT JOIN liner_notes liner_note
+ ON liner_note.cdid = me.cdid
+ JOIN cd_artwork cover_image
+ ON cover_image.cdid = me.cdid
+ ORDER BY tracks.cd
+
+Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
+C<tracks>, and C<guests> of the CD will all be available through the
+relationship accessors without the need for additional queries to the
+database.
+
+=head3 CAVEATS
+
+Prefetch does a lot of deep magic. As such, it may not behave exactly
+as you might expect.
+
+=over 4
+
+=item *
+
+Prefetch uses the L</cache> to populate the prefetched relationships. This
+may or may not be what you want.
+
+=item *
+
+If you specify a condition on a prefetched relationship, ONLY those
+rows that match the prefetched condition will be fetched into that relationship.
+This means that adding prefetch to a search() B<may alter> what is returned by
+traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
+
+ my $artist_rs = $schema->resultset('Artist')->search({
+ 'cds.year' => 2008,
+ }, {
+ join => 'cds',
+ });
+
+ my $count = $artist_rs->first->cds->count;
+
+ my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
+
+ my $prefetch_count = $artist_rs_prefetch->first->cds->count;
+
+ cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
+
+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
+
=head1 DBIC BIND VALUES
Because DBIC may need more information to bind values than just the column name
=item dbic_colname
Used to fill in missing sqlt_datatype and sqlt_size attributes (if they are
-explicitly specified they are never overriden). Also used by some weird DBDs,
+explicitly specified they are never overridden). Also used by some weird DBDs,
where the column name should be available at bind_param time (e.g. Oracle).
=back
[ $name => $val ] === [ { dbic_colname => $name }, $val ]
[ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ]
[ undef, $val ] === [ {}, $val ]
+ $val === [ {}, $val ]
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut
-
-1;