X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=f71bf38348c8237ff166361e88b7b1819c0cf682;hb=b5ce6748f58040ca877fd05e8f004b14d46b2ba9;hp=13cfa03a46ee00101fc68757a9747d8a6bb1bc69;hpb=fcf32d04540e2c67625641b0bc004111a7d90252;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 13cfa03..f71bf38 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -5,7 +5,10 @@ use warnings; 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 DBIx::Class::_Util qw( + fail_on_internal_wantarray UNRESOLVABLE_CONDITION +); use Try::Tiny; use Data::Compare (); # no imports!!! guard against insane architecture @@ -25,6 +28,10 @@ use overload '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 @@ -73,34 +80,6 @@ However, if it is used in a boolean context it is B true. So if you want to check if a resultset has any results, you must use C. -=head1 CUSTOM ResultSet CLASSES THAT USE Moose - -If you want to make your custom ResultSet classes with L, 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 is necessary so that the L constructor does not -clash with the regular ResultSet constructor. Alternatively, you can use: - - __PACKAGE__->meta->make_immutable(inline_constructor => 0); - -The L is necessary because the -signature of the ResultSet C is C<< ->new($source, \%args) >>. - =head1 EXAMPLES =head2 Chaining resultsets @@ -137,11 +116,15 @@ another. =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, L, L are present, they reset the +original selection, and start the selection "clean". -L, L, L, L attributes are merged -into the existing ones from the original resultset. +The L, L, L, L, L attributes +are merged into the existing ones from the original resultset. The L and L attributes, and any search conditions, are merged with an SQL C to the existing condition from the original @@ -184,6 +167,93 @@ Which is the same as: See: L, L, L, L, L. +=head2 Custom ResultSet classes + +To add methods to your resultsets, you can subclass L, 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 on how DBIC can discover and +automatically attach L-specific +L classes. + +=head3 ResultSet subclassing with Moose and similar constructor-providers + +Using L or L 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, C, etc) or if you just prefer to organize +your code via roles. + +In order to write custom ResultSet classes with L you need to use the +following template. The L is necessary due to the +unusual signature of the L 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, you need +a similar, though a little more elaborate template in order to interface the +inlining of the L-provided +L, +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 is necessary so that the L constructor does not +entirely overwrite the DBIC one (in contrast L does this automatically). +Alternatively, you can skip L and get by with just L +instead by doing: + + __PACKAGE__->meta->make_immutable(inline_constructor => 0); + =head1 METHODS =head2 new @@ -236,7 +306,9 @@ sub new { my ($source, $attrs) = @_; $source = $source->resolve if $source->isa('DBIx::Class::ResultSourceHandle'); + $attrs = { %{$attrs||{}} }; + delete @{$attrs}{qw(_last_sqlmaker_alias_map _related_results_construction)}; if ($attrs->{page}) { $attrs->{rows} ||= 10; @@ -294,8 +366,8 @@ call it as C. For a list of attributes that can be passed to C, see L. For more examples of using this function, see -L. For a complete -documentation for the first argument, see L +L. For a complete +documentation for the first argument, see L and its extension L. For more help on using joins with search, see L. @@ -317,6 +389,7 @@ sub search { my $rs = $self->search_rs( @_ ); if (wantarray) { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray($rs); return $rs->all; } elsif (defined wantarray) { @@ -389,18 +462,17 @@ sub search_rs { 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 }; @@ -435,6 +507,7 @@ sub search_rs { # 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'"; } @@ -481,8 +554,12 @@ sub _normalize_selection { 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 @@ -569,60 +646,32 @@ sub _normalize_selection { 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 %$_; + ( + (ref $_ eq 'ARRAY' and !@$_) + or + (ref $_ eq 'HASH' and ! keys %$_) + ) and $_ = undef for ($left, $right); - # 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'}; - } - } - } + # either on of the two undef or both undef + if ( ( (defined $left) xor (defined $right) ) or ! defined $left ) { + return defined $left ? $left : $right; } - # merge hashes with weeding out of duplicates (simple cases only) - if (ref $left eq 'HASH' and ref $right eq 'HASH') { + my $cond = $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] }); - # 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->{$_} ); - } + for my $c (grep { ref $cond->{$_} eq 'ARRAY' and ($cond->{$_}[0]||'') eq '-and' } keys %$cond) { - $right = undef unless keys %$right; - } + my @vals = sort @{$cond->{$c}}[ 1..$#{$cond->{$c}} ]; + my @fin = shift @vals; + for my $v (@vals) { + push @fin, $v unless Data::Compare::Compare( $fin[-1], $v ); + } - if (defined $left xor defined $right) { - return defined $left ? $left : $right; - } - elsif (! defined $left) { - return undef; - } - else { - return { -and => [ $left, $right ] }; + $cond->{$c} = (@fin == 1) ? $fin[0] : [-and => @fin ]; } + + $cond; } =head2 search_literal @@ -632,7 +681,7 @@ should only be used in that context. C is a convenience method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you want to ensure columns are bound correctly, use L. -See L and +See L and L for searching techniques that do not require C. @@ -783,11 +832,15 @@ sub find { 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 + @related{keys %$rel_cond} = values %$rel_cond; } } @@ -990,7 +1043,7 @@ sub cursor { 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 ); @@ -1049,7 +1102,7 @@ sub single { 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) { @@ -1068,42 +1121,10 @@ sub single { $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 @@ -1196,8 +1217,6 @@ sub slice { $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 @@ -1239,147 +1258,270 @@ sub 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; - my $cursor = $self->cursor; + + 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}, $_} @pcols ]; + $attrs->{_ordered_for_collapse} = 1; + $attrs->{_order_is_artificial} = 1; + } # 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, $cursor->all ]; + $rows = [ ($rows ? @$rows : ()), $self->cursor->all ]; + } + elsif( $attrs->{collapse} ) { + + # a cursor will need to be closed over in case of collapse + $cursor = $self->cursor; + + $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}) { + $did_fetch_all = 1; + + # instead of looping over ->next, use ->all in stealth mode + # *without* calling a ->reset afterwards + # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending + if (! $cursor->{_done}) { + $rows = [ ($rows ? @$rows : ()), $cursor->all ]; + $cursor->{_done} = 1; + } + } } - elsif (!$attrs->{collapse}) { + + if (! $did_fetch_all and ! @{$rows||[]} ) { # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref - push @$rows, do { my @r = $cursor->next; @r ? \@r : () } - unless @$rows; + $cursor ||= $self->cursor; + if (scalar (my @r = $cursor->next) ) { + $rows = [ \@r ]; + } } - else { - $attrs->{_ordered_for_collapse} ||= (!$attrs->{order_by}) ? undef : 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); + return undef unless @{$rows||[]}; - for (0 .. $#ord_cols) { - if ( - ! $colinfos->{$ord_cols[$_]} - or - $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc - ) { - splice @ord_cols, $_; - last; - } + # sanity check - people are too clever for their own good + if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) { + + 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}} } + } - # 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; - }; + for my $i (0 .. $#{$attrs->{as}} ) { + my $sel = $attrs->{select}[$i]; - if ($attrs->{_ordered_for_collapse}) { - push @$rows, do { my @r = $cursor->next; @r ? \@r : () }; - } - # instead of looping over ->next, use ->all in stealth mode - # *without* calling a ->reset afterwards - # FIXME - encapsulation breach, got to be a better way - elsif (! $cursor->{_done}) { - push @$rows, $cursor->all; - $cursor->{_done} = 1; - $fetch_all = 1; + 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] !~ /\./); } } - return undef unless @$rows; + # hotspot - skip the setter + my $res_class = $self->_result_class; - my $res_class = $self->result_class; - my $inflator = $res_class->can ('inflate_result') - or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method"); + my $inflator_cref = $self->{_result_inflator}{cref} ||= do { + $res_class->can ('inflate_result') + or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method"); + }; my $infmap = $attrs->{as}; - if (!$attrs->{collapse} and $attrs->{_single_object_inflation}) { - # construct a much simpler array->hash folder for the one-table cases right here + $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) { + $r = { map { $infmap->[$_] => $r->[$_] } 0..$#$infmap }; + } + } # FIXME SUBOPTIMAL this is a very very very hot spot # while rather optimal we can *still* do much better, by - # building a smarter [Row|HRI]::inflate_result(), and + # building a smarter Row::inflate_result(), and # switch to feeding it data via a much leaner interface # # crude unscientific benchmarking indicated the shortcut eval is not worth it for # this particular resultset size - if (@$rows < 60) { - my @as_idx = 0..$#$infmap; + elsif (@$rows < 60) { for my $r (@$rows) { - $r = $inflator->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } @as_idx } ); + $r = $inflator_cref->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } (0..$#$infmap) } ); } } else { eval sprintf ( - '$_ = $inflator->($res_class, $rsrc, { %s }) for @$rows', + '$_ = $inflator_cref->($res_class, $rsrc, { %s }) for @$rows', join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) ); } } else { - $self->{_row_parser} ||= eval sprintf 'sub { %s }', $rsrc->_mk_row_parser({ + my $parser_type = + $self->{_result_inflator}{is_hri} ? 'hri' + : $self->{_result_inflator}{is_core_row} ? 'classic_pruning' + : 'classic_nonpruning' + ; + + # $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}, - }) or die $@; + 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); - # modify $rows in-place, shrinking/extending as necessary - $self->{_row_parser}->($rows, $fetch_all ? () : ( - # 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 - )); + if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) { - $_ = $inflator->($res_class, $rsrc, @$_) for @$rows; + $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); + } + + 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} = [] ) : (), + ); + + # Special-case multi-object HRI - there is no $inflator_cref pass + unless ($self->{_result_inflator}{is_hri}) { + $_ = $inflator_cref->($res_class, $rsrc, @$_) 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; } @@ -1420,14 +1562,22 @@ in the original source class will not run. sub result_class { 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}; } $self->_result_class; } @@ -1505,10 +1655,10 @@ sub count_rs { # 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}); } } @@ -1519,19 +1669,17 @@ sub _count_rs { 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'); } # @@ -1541,11 +1689,10 @@ sub _count_subq_rs { 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 @@ -1632,9 +1779,6 @@ sub _count_subq_rs { ->get_column ('count'); } -sub _bool { - return 1; -} =head2 count_literal @@ -1676,7 +1820,7 @@ sub all { $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; @@ -1684,7 +1828,7 @@ sub all { $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}; @@ -1710,7 +1854,7 @@ another query. 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; @@ -1751,7 +1895,7 @@ sub _rs_update_delete { 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 = ( @@ -1766,20 +1910,12 @@ sub _rs_update_delete { # 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) @@ -1812,9 +1948,12 @@ sub _rs_update_delete { ); # 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) { @@ -1835,6 +1974,8 @@ sub _rs_update_delete { 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 @@ -1866,7 +2007,6 @@ sub _rs_update_delete { $guard = $storage->txn_scope_guard; - $cond = []; for my $row ($subrs->cursor->all) { push @$cond, { map { $idcols->[$_] => $row->[$_] } @@ -1876,11 +2016,11 @@ sub _rs_update_delete { } } - my $res = $storage->$op ( + my $res = $cond ? $storage->$op ( $rsrc, $op eq 'update' ? $values : (), $cond, - ); + ) : '0E0'; $guard->commit if $guard; @@ -2054,7 +2194,7 @@ first element should be a list of column names and each subsequent 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' ], @@ -2133,7 +2273,7 @@ sub populate { foreach my $rel (@rels) { next unless ref $data->[$index]->{$rel} eq "HASH"; my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel}); - my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)}; + my (undef, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)}; my $related = $result->result_source->_resolve_condition( $reverse_relinfo->{cond}, $self, @@ -2188,7 +2328,7 @@ sub populate { } -# populate() argumnets went over several incarnations +# populate() arguments went over several incarnations # What we ultimately support is AoH sub _normalize_populate_args { my ($self, $arg) = @_; @@ -2311,15 +2451,29 @@ sub new_result { 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 @@ -2331,51 +2485,33 @@ sub new_result { 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 @@ -2383,7 +2519,7 @@ sub _merge_with_rscond { # 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 @@ -2431,38 +2567,6 @@ sub _has_resolved_attr { 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 @@ -2507,16 +2611,11 @@ sub as_query { 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 @@ -2533,7 +2632,7 @@ sub as_query { { 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. if none exists, instantiate a new result object and return it. The object will not be saved @@ -2648,10 +2747,10 @@ L. =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 @@ -2988,8 +3087,10 @@ Returns a related resultset for the supplied relationship name. sub related_resultset { my ($self, $rel) = @_; - $self->{related_resultsets} ||= {}; - 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); @@ -3015,15 +3116,6 @@ sub related_resultset { #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi delete @{$attrs}{qw(result_class alias)}; - my $new_cache; - - if (my $cache = $self->get_cache) { - if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) { - $new_cache = [ map { @{$_->related_resultset($rel)->get_cache||[]} } - @$cache ]; - } - } - my $rel_source = $rsrc->related_source($rel); my $new = do { @@ -3044,7 +3136,16 @@ sub related_resultset { where => $attrs->{where}, }); }; - $new->set_cache($new_cache) if $new_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; }; } @@ -3184,7 +3285,7 @@ sub _chain_relationship { # ->_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}) || {} } }; @@ -3274,9 +3375,12 @@ sub _resolved_attrs { 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/; @@ -3387,25 +3491,9 @@ sub _resolved_attrs { $attrs->{group_by} = [ $attrs->{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}, - ); - } - } # 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}; @@ -3414,6 +3502,9 @@ sub _resolved_attrs { $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) @@ -3439,23 +3530,13 @@ sub _resolved_attrs { 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_object_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 @@ -3466,7 +3547,7 @@ sub _resolved_attrs { if (ref $attrs->{from} eq 'ARRAY') { - if (@{$attrs->{from}} <= 1) { + if (@{$attrs->{from}} == 1) { # no joins - no collapse $attrs->{collapse} = 0; } @@ -3503,11 +3584,32 @@ sub _resolved_attrs { } } - if (! $attrs->{order_by} and $attrs->{collapse}) { - # default order for collapsing unless the user asked for something - $attrs->{order_by} = [ map { "$alias.$_" } $source->primary_columns ]; - $attrs->{_ordered_for_collapse} = 1; - $attrs->{_order_is_artificial} = 1; + # 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; + + # whether we can get away with the dumbest (possibly DBI-internal) collapser + if ( List::Util::first { $_ =~ /\./ } @{$attrs->{as}} ) { + $attrs->{_related_results_construction} = 1; } # if both page and offset are specified, produce a combined offset @@ -3731,7 +3833,7 @@ sub STORABLE_freeze { # A cursor in progress can't be serialized (and would make little sense anyway) # the parser can be regenerated (and can't be serialized) - delete @{$to_serialize}{qw/cursor _row_parser/}; + delete @{$to_serialize}{qw/cursor _row_parser _result_inflator/}; # nor is it sensical to store a not-yet-fired-count pager if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') { @@ -3768,6 +3870,10 @@ sub throw_exception { } } +1; + +__END__ + # XXX: FIXME: Attributes docs need clearing up =head1 ATTRIBUTES @@ -3817,7 +3923,7 @@ syntax as outlined above. =over 4 -=item Value: \@columns +=item Value: \@columns | \%columns | $column =back @@ -3827,29 +3933,47 @@ case the key is the C value, and the value is used as the C from that, then auto-populates C from C and L. - 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', + }, + }); =head2 +columns +B You B 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. + =over 4 -=item Value: \@columns +=item Value: \@extra_columns =back -Indicates additional columns to be selected from storage. Works the same -as L but adds columns to the selection. (You may also use the -C attribute, as in earlier versions of DBIC). For -example:- +Indicates additional columns to be selected from storage. Works the same as +L but adds columns to the current selection. (You may also use the +C attribute, as in earlier versions of DBIC, but this is +deprecated) $schema->resultset('CD')->search(undef, { '+columns' => ['artist.name'], @@ -3861,20 +3985,6 @@ passed to object inflation. Note that the 'artist' is the name of the column (or relationship) accessor, and 'name' is the name of the column accessor in the related table. -B 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 for backward compatibility. - =head2 select =over 4 @@ -3905,28 +4015,22 @@ identifier aliasing. You can however alias a function, so you can use it in e.g. an C clause. This is done via the C<-as> B but adds columns to the default selection, instead of specifying -an explicit list. - -=back - -=head2 +as +B You B 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 but adds columns to the current selection, instead of specifying +a new explicit list. + =head2 as =over 4 @@ -3935,7 +4039,7 @@ Indicates additional column names for those added via L. See L. =back -Indicates column names for object inflation. That is L indicates the +Indicates DBIC-side names for object inflation. That is L indicates the slot name in which the column value will be stored within the L object. The value will then be accessible via this identifier by the C method (or via the object accessor B instead: You can create your own accessors if required - see L for details. +=head2 +as + +B You B 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. + +=over 4 + +=item Value: \@extra_inflation_names + +=back + +Indicates additional inflation names for selectors added via L. See L. + =head2 join =over 4 @@ -4032,7 +4150,7 @@ similarly for a third time). For e.g. 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 +If you want to fetch related objects from other tables as well, see L below. NOTE: An internal join-chain pruner will discard certain joins while @@ -4043,185 +4161,133 @@ below. For more help on using joins with search, see L. -=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 has no need to go back to the database when we access the -C or C relationships, which saves us two SQL statements in this -case. - -Simple prefetches will be joined automatically, so there is no need -for a C attribute in the above search. +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: -L 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, C, C, C, -C, and C 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 -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) - ] - } - ); - -The collapser currently can't identify duplicate tuples for multiple -L relationships and as a -result the second L -relation could contain redundant objects. - -=head3 Using L with L - -L implies a L with the equivalent argument, and is -properly merged with any existing L 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. + SELECT me.*, tracks.title, tracks.position + FROM cd me + LEFT JOIN track tracks + ON tracks.cdid = me.cdid -=head3 Using L with L / L / L / L +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. 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 implies a L/L 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 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), DBIC will automatically +switch to "eager" mode and slurp the entire resultset before constructing the +first object returned by L. -The L becomes: C<'cd.title', 'artist.*'> and the L -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. -Prefetch does a lot of deep magic. As such, it may not behave exactly -as you might expect. +=head2 prefetch =over 4 -=item * - -Prefetch uses the L to populate the prefetched relationships. This -may or may not be what you want. +=item Value: ($rel_name | \@rel_names | \%rel_names) -=item * +=back -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 what is returned by -traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do +This attribute is a shorthand for specifying a L spec, adding all +columns from the joined related sources as L and setting +L to a true value. 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 implies a L, 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. =head2 alias @@ -4350,8 +4416,17 @@ or with an in-place function in which case literal SQL is required: =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 clause based on the selection +(including intelligent handling of L contents). Note that the group +criteria calculation takes place over the B selection. This includes +any L, L or L additions in subsequent +L calls, and standalone columns selected via +L (L). A notable exception are the +extra selections specified via L - such selections are explicitly +excluded from group criteria calculations. + +If the final ResultSet also explicitly defines a L attribute, this +setting is ignored and an appropriate warning is issued. =head2 where @@ -4399,6 +4474,131 @@ Set to 'update' for a SELECT ... FOR UPDATE or 'shared' for a SELECT ... 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 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 has no need to go back to the database when we access the +C or C relationships, which saves us two SQL statements in this +case. + +Simple prefetches will be joined automatically, so there is no need +for a C attribute in the above search. + +The L 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, C, C, C, +C, and C 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 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 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 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 - consider declaring and using a L + +=back + =head1 DBIC BIND VALUES Because DBIC may need more information to bind values than just the column name @@ -4435,7 +4635,7 @@ or to a sensible value based on the "data_type". =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 @@ -4446,6 +4646,7 @@ supported: [ $name => $val ] === [ { dbic_colname => $name }, $val ] [ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ] [ undef, $val ] === [ {}, $val ] + $val === [ {}, $val ] =head1 AUTHOR AND CONTRIBUTORS @@ -4455,6 +4656,3 @@ See L and L in You may distribute this code under the same terms as Perl itself. -=cut - -1;