X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=c799da79395c6a2c6a4ac714c2e66e8fe3a71c8a;hb=83d2991997f6070366d3d2bcd3f1bcc07562b930;hp=6a2777f6f04163550f580dcd925fd7bcf1bf463b;hpb=5e2a0518192e45ecdd838468c98c19d169bdc7a7;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 6a2777f..c799da7 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -4,9 +4,9 @@ use strict; use warnings; use base qw/DBIx::Class/; use DBIx::Class::Carp; -use DBIx::Class::Exception; use DBIx::Class::ResultSetColumn; -use Scalar::Util qw/blessed weaken/; +use Scalar::Util qw/blessed weaken reftype/; +use DBIx::Class::_Util 'fail_on_internal_wantarray'; use Try::Tiny; use Data::Compare (); # no imports!!! guard against insane architecture @@ -26,6 +26,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 @@ -138,11 +142,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 @@ -237,7 +245,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; @@ -295,8 +305,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. @@ -318,6 +328,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) { @@ -390,18 +401,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 }; @@ -436,6 +446,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'"; } @@ -482,8 +493,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 @@ -633,7 +648,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. @@ -839,7 +854,7 @@ sub find { # Run the query, passing the result_class since it should propagate for find my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); - if (keys %{$rs->_resolved_attrs->{collapse}}) { + if ($rs->_resolved_attrs->{collapse}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; return $row; @@ -988,13 +1003,14 @@ L for more information. =cut sub cursor { - my ($self) = @_; - - my $attrs = $self->_resolved_attrs_copy; + my $self = shift; - return $self->{cursor} - ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, - $attrs->{where},$attrs); + return $self->{cursor} ||= do { + my $attrs = $self->_resolved_attrs; + $self->result_source->storage->select( + $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs + ); + }; } =head2 single @@ -1046,13 +1062,11 @@ sub single { $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); } - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{$self->_resolved_attrs} }; - if (keys %{$attrs->{collapse}}) { - $self->throw_exception( - 'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead' - ); - } + $self->throw_exception( + 'single() can not be used on resultsets collapsing a has_many. Use find( \%cond ) or next() instead' + ) if $attrs->{collapse}; if ($where) { if (defined $attrs->{where}) { @@ -1066,12 +1080,14 @@ sub single { } } - my @data = $self->result_source->storage->select_single( + my $data = [ $self->result_source->storage->select_single( $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs - ); + )]; - return (@data ? ($self->_construct_object(@data))[0] : undef); + return undef unless @$data; + $self->{_stashed_rows} = [ $data ]; + $self->_construct_results->[0]; } @@ -1197,8 +1213,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 @@ -1228,161 +1242,283 @@ first record from the resultset. sub next { my ($self) = @_; + if (my $cache = $self->get_cache) { $self->{all_cache_position} ||= 0; return $cache->[$self->{all_cache_position}++]; } + if ($self->{attrs}{cache}) { delete $self->{pager}; $self->{all_cache_position} = 1; return ($self->all)[0]; } - if ($self->{stashed_objects}) { - my $obj = shift(@{$self->{stashed_objects}}); - delete $self->{stashed_objects} unless @{$self->{stashed_objects}}; - return $obj; - } - my @row = ( - exists $self->{stashed_row} - ? @{delete $self->{stashed_row}} - : $self->cursor->next - ); - return undef unless (@row); - my ($row, @more) = $self->_construct_object(@row); - $self->{stashed_objects} = \@more if @more; - return $row; -} -sub _construct_object { - my ($self, @row) = @_; + return shift(@{$self->{_stashed_results}}) if @{ $self->{_stashed_results}||[] }; - my $info = $self->_collapse_result($self->{_attrs}{as}, \@row) - or return (); - my @new = $self->result_class->inflate_result($self->result_source, @$info); - @new = $self->{_attrs}{record_filter}->(@new) - if exists $self->{_attrs}{record_filter}; - return @new; -} + $self->{_stashed_results} = $self->_construct_results + or return undef; -sub _collapse_result { - my ($self, $as_proto, $row) = @_; + return shift @{$self->{_stashed_results}}; +} - my @copy = @$row; +# 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}} +# * If called with $fetch_all true - pulls everything off the cursor and +# 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}} +# 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_results { + my ($self, $fetch_all) = @_; - # 'foo' => [ undef, 'foo' ] - # 'foo.bar' => [ 'foo', 'bar' ] - # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] + my $rsrc = $self->result_source; + my $attrs = $self->_resolved_attrs; - my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; + 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; + } - my %collapse = %{$self->{_attrs}{collapse}||{}}; + # this will be used as both initial raw-row collector AND as a RV of + # _construct_results. Not regrowing the array twice matters a lot... + # a surprising amount actually + my $rows = delete $self->{_stashed_rows}; - my @pri_index; + my $cursor; # we may not need one at all - # if we're doing collapsing (has_many prefetch) we need to grab records - # until the PK changes, so fill @pri_index. if not, we leave it empty so - # we know we don't have to bother. + my $did_fetch_all = $fetch_all; - # the reason for not using the collapse stuff directly is because if you - # had for e.g. two artists in a row with no cds, the collapse info for - # both would be NULL (undef) so you'd lose the second artist + if ($fetch_all) { + # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref + $rows = [ ($rows ? @$rows : ()), $self->cursor->all ]; + } + elsif( $attrs->{collapse} ) { - # store just the index so we can check the array positions from the row - # without having to contruct the full hash + # a cursor will need to be closed over in case of collapse + $cursor = $self->cursor; - if (keys %collapse) { - my %pri = map { ($_ => 1) } $self->result_source->_pri_cols; - foreach my $i (0 .. $#construct_as) { - next if defined($construct_as[$i][0]); # only self table - if (delete $pri{$construct_as[$i][1]}) { - push(@pri_index, $i); + $attrs->{_ordered_for_collapse} = ( + ( + $attrs->{order_by} + and + $rsrc->schema + ->storage + ->_main_source_order_by_portion_is_stable($rsrc, $attrs->{order_by}, $attrs->{where}) + ) ? 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; } - last unless keys %pri; # short circuit (Johnny Five Is Alive!) } } - # no need to do an if, it'll be empty if @pri_index is empty anyway + 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 %pri_vals = map { ($_ => $copy[$_]) } @pri_index; + # sanity check - people are too clever for their own good + if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) { - my @const_rows; + 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}} + } + } - do { # no need to check anything at the front, we always want the first row + for my $i (0 .. $#{$attrs->{as}} ) { + my $sel = $attrs->{select}[$i]; - my %const; + if (ref $sel eq 'SCALAR') { + $sel = $$sel; + } + elsif( ref $sel eq 'REF' and ref $$sel eq 'ARRAY' ) { + $sel = $$sel->[0]; + } - foreach my $this_as (@construct_as) { - $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); + $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] !~ /\./); } + } - push(@const_rows, \%const); + # hotspot - skip the setter + my $res_class = $self->_result_class; - } until ( # no pri_index => no collapse => drop straight out - !@pri_index - or - do { # get another row, stash it, drop out if different PK + 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"); + }; - @copy = $self->cursor->next; - $self->{stashed_row} = \@copy; + my $infmap = $attrs->{as}; - # last thing in do block, counts as true if anything doesn't match + $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}; - # check xor defined first for NULL vs. NOT NULL then if one is - # defined the other must be so check string equality - grep { - (defined $pri_vals{$_} ^ defined $copy[$_]) - || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) - } @pri_index; + 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::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 + elsif (@$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 ) + ); + } + } + else { + my $parser_type = + $self->{_result_inflator}{is_hri} ? 'hri' + : $self->{_result_inflator}{is_core_row} ? 'classic_pruning' + : 'classic_nonpruning' + ; - my $alias = $self->{attrs}{alias}; - my $info = []; + # $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, + collapse => $attrs->{collapse}, + premultiplied => $attrs->{_main_source_premultiplied}, + 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); + + 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 %collapse_pos; + my @violating_idx; + COL: for my $i (@$check_non_null_cols) { + ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows; + } - my @const_keys; + $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) + if @violating_idx; - foreach my $const (@const_rows) { - scalar @const_keys or do { - @const_keys = sort { length($a) <=> length($b) } keys %$const; - }; - foreach my $key (@const_keys) { - if (length $key) { - my $target = $info; - my @parts = split(/\./, $key); - my $cur = ''; - my $data = $const->{$key}; - foreach my $p (@parts) { - $target = $target->[1]->{$p} ||= []; - $cur .= ".${p}"; - if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) { - # collapsing at this point and on final part - my $pos = $collapse_pos{$cur}; - CK: foreach my $ck (@ckey) { - if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) { - $collapse_pos{$cur} = $data; - delete @collapse_pos{ # clear all positioning for sub-entries - grep { m/^\Q${cur}.\E/ } keys %collapse_pos - }; - push(@$target, []); - last CK; - } - } - } - if (exists $collapse{$cur}) { - $target = $target->[-1]; - } - } - $target->[0] = $data; - } else { - $info->[0] = $const->{$key}; + $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 } + ; + + $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 } } - return $info; + # 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; } =head2 result_source @@ -1422,14 +1558,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; } @@ -1455,12 +1599,11 @@ sub count { return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my $attrs = $self->_resolved_attrs_copy; + my $attrs = { %{ $self->_resolved_attrs } }; # this is a little optimization - it is faster to do the limit # adjustments in software, instead of a subquery - my $rows = delete $attrs->{rows}; - my $offset = delete $attrs->{offset}; + my ($rows, $offset) = delete @{$attrs}{qw/rows offset/}; my $crs; if ($self->_has_resolved_attr (qw/collapse group_by/)) { @@ -1508,10 +1651,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}); } } @@ -1522,20 +1665,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'; - delete @{$tmp_attrs}{qw/columns/}; - - 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'); } # @@ -1545,15 +1685,14 @@ 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 - if ( keys %{$attrs->{collapse}} ) { + if ( $attrs->{collapse} ) { $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{ $rsrc->_identifying_column_set || $self->throw_exception( 'Unable to construct a unique group_by criteria properly collapsing the ' @@ -1591,18 +1730,22 @@ sub _count_subq_rs { my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep); - my $sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }); + my $having_sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }); + my %seen_having; # search for both a proper quoted qualified string, for a naive unquoted scalarref # and if all fails for an utterly naive quoted scalar-with-function - while ($sql =~ / + while ($having_sql =~ / $rquote $sep $lquote (.+?) $rquote | [\s,] \w+ \. (\w+) [\s,] | [\s,] $lquote (.+?) $rquote [\s,] /gx) { - push @parts, ($1 || $2 || $3); # one of them matched if we got here + my $part = $1 || $2 || $3; # one of them matched if we got here + unless ($seen_having{$part}++) { + push @parts, $part; + } } } @@ -1632,9 +1775,6 @@ sub _count_subq_rs { ->get_column ('count'); } -sub _bool { - return 1; -} =head2 count_literal @@ -1673,33 +1813,22 @@ Returns all elements in the resultset. sub all { my $self = shift; if(@_) { - $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); + $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); } - return @{ $self->get_cache } if $self->get_cache; - - my @obj; - - if (keys %{$self->_resolved_attrs->{collapse}}) { - # Using $self->cursor->all is really just an optimisation. - # If we're collapsing has_many prefetches it probably makes - # very little difference, and this is cleaner than hacking - # _construct_object to survive the approach - $self->cursor->reset; - my @row = $self->cursor->next; - while (@row) { - push(@obj, $self->_construct_object(@row)); - @row = (exists $self->{stashed_row} - ? @{delete $self->{stashed_row}} - : $self->cursor->next); - } - } else { - @obj = map { $self->_construct_object(@$_) } $self->cursor->all; + delete @{$self}{qw/_stashed_rows _stashed_results/}; + + if (my $c = $self->get_cache) { + return @$c; } - $self->set_cache(\@obj) if $self->{attrs}{cache}; + $self->cursor->reset; + + my $objs = $self->_construct_results('fetch_all') || []; + + $self->set_cache($objs) if $self->{attrs}{cache}; - return @obj; + return @$objs; } =head2 reset @@ -1720,7 +1849,8 @@ another query. sub reset { my ($self) = @_; - delete $self->{_attrs} if exists $self->{_attrs}; + + delete @{$self}{qw/_stashed_rows _stashed_results/}; $self->{all_cache_position} = 0; $self->cursor->reset; return $self; @@ -1755,152 +1885,143 @@ sub first { sub _rs_update_delete { my ($self, $op, $values) = @_; - my $cond = $self->{cond}; my $rsrc = $self->result_source; my $storage = $rsrc->schema->storage; my $attrs = { %{$self->_resolved_attrs} }; - my $existing_group_by = delete $attrs->{group_by}; - my $needs_subq = defined $existing_group_by; + my $join_classifications; + my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)}; - # simplify the joinmap and maybe decide if a subquery is necessary - my $relation_classifications = {}; + # do we need a subquery for any reason? + my $needs_subq = ( + defined $existing_group_by + or + # if {from} is unparseable wrap a subq + ref($attrs->{from}) ne 'ARRAY' + or + # limits call for a subq + $self->_has_resolved_attr(qw/rows offset/) + ); - if (ref($attrs->{from}) eq 'ARRAY') { - # if we already know we need a subq, no point of classifying relations - if (!$needs_subq and @{$attrs->{from}} > 1) { - $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs); + # simplify the joinmap, so we can further decide if a subq is necessary + if (!$needs_subq and @{$attrs->{from}} > 1) { - $relation_classifications = $storage->_resolve_aliastypes_from_select_args ( - [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ], - $attrs->{select}, - $cond, - $attrs - ); - } - } - else { - $needs_subq ||= 1; # if {from} is unparseable assume the worst + ($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) + $needs_subq ||= ( + (ref $attrs->{from}[0]) ne 'HASH' + or + ref $attrs->{from}[0]{ $attrs->{from}[0]{-alias} } + ); + + my ($cond, $guard); # do we need anything like a subquery? - if ( - ! $needs_subq - and - ! keys %{ $relation_classifications->{restricting} || {} } - and - ! $self->_has_resolved_attr(qw/rows offset/) # limits call for a subq - ) { + if (! $needs_subq) { # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus # a condition containing 'me' or other table prefixes will not work # at all. Tell SQLMaker to dequalify idents via a gross hack. - my $cond = do { + $cond = do { my $sqla = $rsrc->storage->sql_maker; local $sqla->{_dequalify_idents} = 1; \[ $sqla->_recurse_where($self->{cond}) ]; }; - return $rsrc->storage->$op( - $rsrc, - $op eq 'update' ? $values : (), - $cond, - ); - } - - # we got this far - means it is time to wrap a subquery - my $idcols = $rsrc->_identifying_column_set || $self->throw_exception( - sprintf( - "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'", - $op, - $rsrc->source_name, - ) - ); - - # make a new $rs selecting only the PKs (that's all we really need for the subq) - delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/; - $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ]; - $attrs->{group_by} = \ ''; # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins - my $subrs = (ref $self)->new($rsrc, $attrs); - - if (@$idcols == 1) { - return $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - { $idcols->[0] => { -in => $subrs->as_query } }, - ); } - elsif ($storage->_use_multicolumn_in) { - # This is hideously ugly, but SQLA does not understand multicol IN expressions - my $sql_maker = $storage->sql_maker; - my ($sql, @bind) = @${$subrs->as_query}; - $sql = sprintf ('(%s) IN %s', # the as_query already comes with a set of parenthesis - join (', ', map { $sql_maker->_quote ($_) } @$idcols), - $sql, + else { + # we got this far - means it is time to wrap a subquery + my $idcols = $rsrc->_identifying_column_set || $self->throw_exception( + sprintf( + "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'", + $op, + $rsrc->source_name, + ) ); - return $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - \[$sql, @bind], - ); - } - else { + # make a new $rs selecting only the PKs (that's all we really need for the subq) + delete $attrs->{$_} for qw/select as collapse/; + $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ]; - # if all else fails - get all primary keys and operate over a ORed set - # wrap in a transaction for consistency - # this is where the group_by starts to matter - if ( - $existing_group_by - or - keys %{ $relation_classifications->{multiplying} || {} } - ) { - # make sure if there is a supplied group_by it matches the columns compiled above - # perfectly. Anything else can not be sanely executed on most databases so croak - # right then and there - if ($existing_group_by) { - my @current_group_by = map - { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } - @$existing_group_by - ; + # this will be consumed by the pruner waaaaay down the stack + $attrs->{_force_prune_multiplying_joins} = 1; - if ( - join ("\x00", sort @current_group_by) - ne - join ("\x00", sort @{$attrs->{columns}} ) - ) { - $self->throw_exception ( - "You have just attempted a $op operation on a resultset which does group_by" - . ' on columns other than the primary keys, while DBIC internally needs to retrieve' - . ' the primary keys in a subselect. All sane RDBMS engines do not support this' - . ' kind of queries. Please retry the operation with a modified group_by or' - . ' without using one at all.' - ); - } - } + my $subrs = (ref $self)->new($rsrc, $attrs); - $subrs = $subrs->search({}, { group_by => $attrs->{columns} }); + if (@$idcols == 1) { + $cond = { $idcols->[0] => { -in => $subrs->as_query } }; } + elsif ($storage->_use_multicolumn_in) { + # no syntax for calling this properly yet + # !!! EXPERIMENTAL API !!! WILL CHANGE !!! + $cond = $storage->sql_maker->_where_op_multicolumn_in ( + $idcols, # how do I convey a list of idents...? can binds reside on lhs? + $subrs->as_query + ), + } + else { + # if all else fails - get all primary keys and operate over a ORed set + # wrap in a transaction for consistency + # this is where the group_by/multiplication starts to matter + 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 + # perfectly. Anything else can not be sanely executed on most databases so croak + # right then and there + if ($existing_group_by) { + my @current_group_by = map + { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } + @$existing_group_by + ; + + if ( + join ("\x00", sort @current_group_by) + ne + join ("\x00", sort @{$attrs->{columns}} ) + ) { + $self->throw_exception ( + "You have just attempted a $op operation on a resultset which does group_by" + . ' on columns other than the primary keys, while DBIC internally needs to retrieve' + . ' the primary keys in a subselect. All sane RDBMS engines do not support this' + . ' kind of queries. Please retry the operation with a modified group_by or' + . ' without using one at all.' + ); + } + } - my $guard = $storage->txn_scope_guard; + $subrs = $subrs->search({}, { group_by => $attrs->{columns} }); + } - my @op_condition; - for my $row ($subrs->cursor->all) { - push @op_condition, { map - { $idcols->[$_] => $row->[$_] } - (0 .. $#$idcols) - }; + $guard = $storage->txn_scope_guard; + + $cond = []; + for my $row ($subrs->cursor->all) { + push @$cond, { map + { $idcols->[$_] => $row->[$_] } + (0 .. $#$idcols) + }; + } } + } - my $res = $storage->$op ( - $rsrc, - $op eq 'update' ? $values : (), - \@op_condition, - ); + my $res = $storage->$op ( + $rsrc, + $op eq 'update' ? $values : (), + $cond, + ); - $guard->commit; + $guard->commit if $guard; - return $res; - } + return $res; } =head2 update @@ -2070,7 +2191,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' ], @@ -2112,10 +2233,7 @@ sub populate { return unless @$data; if(defined wantarray) { - my @created; - foreach my $item (@$data) { - push(@created, $self->create($item)); - } + my @created = map { $self->create($_) } @$data; return wantarray ? @created : \@created; } else { @@ -2170,14 +2288,12 @@ sub populate { ## inherit the data locked in the conditions of the resultset my ($rs_data) = $self->_merge_with_rscond({}); delete @{$rs_data}{@columns}; - my @inherit_cols = keys %$rs_data; - my @inherit_data = values %$rs_data; ## do bulk insert on current row $rsrc->storage->insert_bulk( $rsrc, - [@columns, @inherit_cols], - [ map { [ @$_{@columns}, @inherit_data ] } @$data ], + [@columns, keys %$rs_data], + [ map { [ @$_{@columns}, values %$rs_data ] } @$data ], ); ## do the has_many relationships @@ -2209,7 +2325,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) = @_; @@ -2269,7 +2385,7 @@ sub pager { # throw away the paging flags and re-run the count (possibly # with a subselect) to get the real total count my $count_attrs = { %$attrs }; - delete $count_attrs->{$_} for qw/rows offset page pager/; + delete @{$count_attrs}{qw/rows offset page pager/}; my $total_rs = (ref $self)->new($self->result_source, $count_attrs); @@ -2332,15 +2448,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 - ); + }); + + 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 @@ -2369,7 +2499,7 @@ sub _merge_with_rscond { ); } else { - # precendence must be given to passed values over values inherited from + # precedence 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)}; @@ -2404,7 +2534,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 @@ -2526,18 +2656,13 @@ This is generally used as the RHS for a subquery. sub as_query { my $self = shift; - my $attrs = $self->_resolved_attrs_copy; + 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 @@ -2554,7 +2679,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 @@ -2669,10 +2794,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 @@ -3009,8 +3134,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); @@ -3036,15 +3163,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 { @@ -3065,7 +3183,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; }; } @@ -3108,9 +3235,7 @@ source alias of the current result set: =cut sub current_source_alias { - my ($self) = @_; - - return ($self->{attrs} || {})->{alias} || 'me'; + return (shift->{attrs} || {})->{alias} || 'me'; } =head2 as_subselect_rs @@ -3207,7 +3332,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}) || {} } }; @@ -3292,12 +3417,6 @@ sub _chain_relationship { return {%$attrs, from => $from, seen_join => $seen}; } -# too many times we have to do $attrs = { %{$self->_resolved_attrs} } -sub _resolved_attrs_copy { - my $self = shift; - return { %{$self->_resolved_attrs (@_)} }; -} - sub _resolved_attrs { my $self = shift; return $self->{_attrs} if $self->{_attrs}; @@ -3306,6 +3425,9 @@ sub _resolved_attrs { my $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/; @@ -3343,14 +3465,10 @@ sub _resolved_attrs { if $attrs->{select}; # assume all unqualified selectors to apply to the current alias (legacy stuff) - for (@sel) { - $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_"; - } + $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel; - # disqualify all $alias.col as-bits (collapser mandated) - for (@as) { - $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_; - } + # disqualify all $alias.col as-bits (inflate-map mandated) + $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as; # de-duplicate the result (remove *identical* select/as pairs) # and also die on duplicate {as} pointing to different {select}s @@ -3420,32 +3538,21 @@ 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}, - ); - } - } - $attrs->{collapse} ||= {}; - if ($attrs->{prefetch}) { + # generate selections based on the prefetch helper + my ($prefetch, @prefetch_select, @prefetch_as); + $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) + if defined $attrs->{prefetch}; + + if ($prefetch) { $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") if $attrs->{_dark_selector}; - my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ); + $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported") + if defined $attrs->{collapse} and ! $attrs->{collapse}; - my $prefetch_ordering = []; + $attrs->{collapse} = 1; # this is a separate structure (we don't look in {from} directly) # as the resolver needs to shift things off the lists to work @@ -3468,20 +3575,88 @@ sub _resolved_attrs { } } - my @prefetch = - $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); + my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); + + # save these for after distinct resolution + @prefetch_select = map { $_->[0] } @prefetch; + @prefetch_as = map { $_->[1] } @prefetch; + } - # 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 ]; + # run through the resulting joinstructure (starting from our current slot) + # 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 + # + # this allows to predict whether a root object with all other relation + # data set to NULL is in fact unique + if ($attrs->{collapse}) { + + if (ref $attrs->{from} eq 'ARRAY') { + + if (@{$attrs->{from}} == 1) { + # no joins - no collapse + $attrs->{collapse} = 0; + } + else { + # find where our table-spec starts + my @fromlist = @{$attrs->{from}}; + while (@fromlist) { + my $t = shift @fromlist; + + my $is_multi; + # me vs join from-spec distinction - a ref means non-root + if (ref $t eq 'ARRAY') { + $t = $t->[0]; + $is_multi ||= ! $t->{-is_single}; + } + last if ($t->{-alias} && $t->{-alias} eq $alias); + $attrs->{_main_source_premultiplied} ||= $is_multi; + } + + # no non-singles remaining, nor any premultiplication - nothing to collapse + if ( + ! $attrs->{_main_source_premultiplied} + and + ! List::Util::first { ! $_->[0]{-is_single} } @fromlist + ) { + $attrs->{collapse} = 0; + } + } + } + + else { + # if we can not analyze the from - err on the side of safety + $attrs->{_main_source_premultiplied} = 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}; } + } - push @{ $attrs->{select} }, (map { $_->[0] } @prefetch); - push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); + # inject prefetch-bound selection (if any) + push @{$attrs->{select}}, @prefetch_select; + push @{$attrs->{as}}, @prefetch_as; - push( @{$attrs->{order_by}}, @$prefetch_ordering ); - $attrs->{_collapse_order_by} = \@$prefetch_ordering; + # 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 @@ -3608,7 +3783,7 @@ sub _merge_joinpref_attr { $seen_keys->{$import_key} = 1; # don't merge the same key twice } - return $orig; + return @$orig ? $orig : (); } { @@ -3704,7 +3879,8 @@ sub STORABLE_freeze { my $to_serialize = { %$self }; # A cursor in progress can't be serialized (and would make little sense anyway) - delete $to_serialize->{cursor}; + # the parser can be regenerated (and can't be serialized) + 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') { @@ -3741,6 +3917,10 @@ sub throw_exception { } } +1; + +__END__ + # XXX: FIXME: Attributes docs need clearing up =head1 ATTRIBUTES @@ -3790,7 +3970,7 @@ syntax as outlined above. =over 4 -=item Value: \@columns +=item Value: \@columns | \%columns | $column =back @@ -3800,7 +3980,7 @@ 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. @@ -3811,6 +3991,20 @@ is the same as select => [qw/foo baz/], as => [qw/foo bar/] +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 (see also +L): + + # equivalent SQL: SELECT 1, 'a string', IF(x,1,2) ... + columns => [ + { + foo => \1, + bar => \q{'a string'}, + baz => \[ '?', 'IF(x,1,2)' ], + } + ] + =head2 +columns =over 4 @@ -3819,10 +4013,10 @@ is the same as =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 selection. (You may also use the +C attribute, as in earlier versions of DBIC, but this is +deprecated). For example:- $schema->resultset('CD')->search(undef, { '+columns' => ['artist.name'], @@ -3892,14 +4086,6 @@ an explicit list. =back -=head2 +as - -=over 4 - -Indicates additional column names for those added via L. See L. - -=back - =head2 as =over 4 @@ -3942,6 +4128,14 @@ use C instead: You can create your own accessors if required - see L for details. +=head2 +as + +=over 4 + +Indicates additional column names for those added via L. See L. + +=back + =head2 join =over 4 @@ -4005,7 +4199,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 @@ -4016,185 +4210,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. - -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' ); +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: + my $rs = $schema->resultset('CD')->search({}, { + '+columns' => [ qw/ tracks.title tracks.position / ], + join => 'tracks', + collapse => 1, + }); - 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: +While executing the following query: - my $rs = $schema->resultset('CD')->search( - {'record_label.name' => 'Music Product Ltd.'}, - { - join => {artist => 'record_label'}, - prefetch => 'artist', - } - ); + SELECT me.*, tracks.title, tracks.position + FROM cd me + LEFT JOIN track tracks + ON tracks.cdid = me.cdid -... will work, searching on the record label's name, but only -prefetching the C. +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. -=head3 Using L with L / L / L / L +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. -L implies a L/L with the fields of the -prefetched relations. So given: +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. - my $rs = $schema->resultset('CD')->search( - undef, - { - select => ['cd.title'], - as => ['cd_title'], - prefetch => 'artist', - } - ); +Setting this attribute on a resultset that does not join any has_many +relations is a no-op. -The L becomes: C<'cd.title', 'artist.*'> and the L -becomes: C<'cd_title', 'artist.*'>. +For a more in-depth discussion, see L. -=head3 CAVEATS - -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 @@ -4323,8 +4465,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 @@ -4372,6 +4523,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 @@ -4408,7 +4684,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 @@ -4419,6 +4695,7 @@ supported: [ $name => $val ] === [ { dbic_colname => $name }, $val ] [ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ] [ undef, $val ] === [ {}, $val ] + $val === [ {}, $val ] =head1 AUTHOR AND CONTRIBUTORS @@ -4428,6 +4705,3 @@ See L and L in You may distribute this code under the same terms as Perl itself. -=cut - -1;