X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=a9c4ab77ff742d762b50b58629e778012af563be;hb=2d0b795a54a018d5c9cf2593cf83045962cd9b93;hp=fc6bdd0164dfa40d1d98a2925d16cf9f5f5ef06f;hpb=4d1e63f4234e8a70a5a1f618ad7d8f3facd09142;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index fc6bdd0..a9c4ab7 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -8,6 +8,7 @@ use DBIx::Class::Exception; use DBIx::Class::ResultSetColumn; use Scalar::Util qw/blessed weaken/; use Try::Tiny; +use Data::Compare (); # no imports!!! guard against insane architecture # not importing first() as it will clash with our own method use List::Util (); @@ -73,6 +74,34 @@ 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 @@ -86,7 +115,7 @@ another. sub get_data { my $self = shift; my $request = $self->get_request; # Get a request object somehow. - my $schema = $self->get_schema; # Get the DBIC schema object somehow. + my $schema = $self->result_source->schema; my $cd_rs = $schema->resultset('CD')->search({ title => $request->param('title'), @@ -208,6 +237,12 @@ sub new { attrs => $attrs, }, $class; + # if there is a dark selector, this means we are already in a + # chain and the cleanup/sanification was taken care of by + # _search_rs already + $self->_normalize_selection($attrs) + unless $attrs->{_dark_selector}; + $self->result_class( $attrs->{result_class} || $source->result_class ); @@ -221,7 +256,7 @@ sub new { =item Arguments: $cond, \%attrs? -=item Return Value: $resultset (scalar context), @row_objs (list context) +=item Return Value: $resultset (scalar context) || @row_objs (list context) =back @@ -231,6 +266,9 @@ sub new { my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]); # year = 2005 OR year = 2004 +In list context, C<< ->all() >> is called implicitly on the resultset, thus +returning a list of row objects instead. To avoid that, use L. + If you need to pass in additional attributes but no additional condition, call it as C. @@ -242,7 +280,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. +documentation for the first argument, see L +and its extension L. For more help on using joins with search, see L. @@ -254,7 +293,7 @@ condition-bound methods L, L and L. The user must ensure manually that any value passed to this method will stringify to something the RDBMS knows how to deal with. A notable example is the handling of L objects, for more info see: -L. +L. =cut @@ -339,25 +378,24 @@ sub search_rs { # take care of call attrs (only if anything is changing) if (keys %$call_attrs) { - $self->throw_exception ('_trailing_select is not a public attribute - do not use it in search()') - if ( exists $call_attrs->{_trailing_select} or exists $call_attrs->{'+_trailing_select'} ); + my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/; - my @selector_attrs = qw/select as columns cols +select +as +columns include_columns _trailing_select +_trailing_select/; + # reset the current selector list if new selectors are supplied + if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { + delete @{$old_attrs}{(@selector_attrs, '_dark_selector')}; + } - # Normalize the selector list (operates on the passed-in attr structure) + # Normalize the new selector list (operates on the passed-in attr structure) # Need to do it on every chain instead of only once on _resolved_attrs, in - # order to separate 'as'-ed from blind 'select's + # order to allow detection of empty vs partial 'as' + $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector} + if $old_attrs->{_dark_selector}; $self->_normalize_selection ($call_attrs); # start with blind overwriting merge, exclude selector attrs $new_attrs = { %{$old_attrs}, %{$call_attrs} }; delete @{$new_attrs}{@selector_attrs}; - # reset the current selector list if new selectors are supplied - if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { - delete @{$old_attrs}{@selector_attrs}; - } - for (@selector_attrs) { $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_}) if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} ); @@ -428,6 +466,7 @@ sub search_rs { return $rs; } +my $dark_sel_dumper; sub _normalize_selection { my ($self, $attrs) = @_; @@ -435,6 +474,8 @@ sub _normalize_selection { $attrs->{'+columns'} = $self->_merge_attr($attrs->{'+columns'}, delete $attrs->{include_columns}) if exists $attrs->{include_columns}; + # columns are always placed first, however + # Keep the X vs +X separation until _resolved_attrs time - this allows to # delay the decision on whether to use a default select list ($rsrc->columns) # allowing stuff like the remove_columns helper to work @@ -445,9 +486,7 @@ sub _normalize_selection { # supplied at all) - try to infer the alias, either from the -as parameter # of the selector spec, or use the parameter whole if it looks like a column # name (ugly legacy heuristic). If all fails - leave the selector bare (which - # is ok as well), but transport it over a separate attribute to make sure it is - # the last thing in the select list, thus unable to throw off the corresponding - # 'as' chain + # is ok as well), but make sure no more additions to the 'as' chain take place for my $pref ('', '+') { my ($sel, $as) = map { @@ -470,68 +509,110 @@ sub _normalize_selection { ); } elsif( ! @$as ) { - # no as part supplied at all - try to deduce + # no as part supplied at all - try to deduce (unless explicit end of named selection is declared) # if any @$as has been supplied we assume the user knows what (s)he is doing # and blindly keep stacking up pieces - my (@new_sel, @new_trailing); - for (@$sel) { - if ( ref $_ eq 'HASH' and exists $_->{-as} ) { - push @$as, $_->{-as}; - push @new_sel, $_; - } - # assume any plain no-space, no-parenthesis string to be a column spec - # FIXME - this is retarded but is necessary to support shit like 'count(foo)' - elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) { - push @$as, $_; - push @new_sel, $_; - } - # if all else fails - shove the selection to the trailing stack and move on - else { - push @new_trailing, $_; + unless ($attrs->{_dark_selector}) { + SELECTOR: + for (@$sel) { + if ( ref $_ eq 'HASH' and exists $_->{-as} ) { + push @$as, $_->{-as}; + } + # assume any plain no-space, no-parenthesis string to be a column spec + # FIXME - this is retarded but is necessary to support shit like 'count(foo)' + elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) { + push @$as, $_; + } + # if all else fails - raise a flag that no more aliasing will be allowed + else { + $attrs->{_dark_selector} = { + plus_stage => $pref, + string => ($dark_sel_dumper ||= do { + require Data::Dumper::Concise; + Data::Dumper::Concise::DumperObject()->Indent(0); + })->Values([$_])->Dump + , + }; + last SELECTOR; + } } } - - @$sel = @new_sel; - $attrs->{"${pref}_trailing_select"} = $self->_merge_attr($attrs->{"${pref}_trailing_select"}, \@new_trailing) - if @new_trailing; } elsif (@$as < @$sel) { $self->throw_exception( "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select" ); } - - # now see what the result for this pair looks like: - if (@$as == @$sel) { - - # if balanced - treat as a columns entry - $attrs->{"${pref}columns"} = $self->_merge_attr( - $attrs->{"${pref}columns"}, - [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ] + elsif ($pref and $attrs->{_dark_selector}) { + $self->throw_exception( + "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}" ); } - else { - # unbalanced - shove in select/as, not subject to deduplication in _resolved_attrs - $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel); - $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as); - } - } + + # merge result + $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel); + $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as); + } } sub _stack_cond { my ($self, $left, $right) = @_; + + # collapse single element top-level conditions + # (single pass only, unlikely to need recursion) + for ($left, $right) { + if (ref $_ eq 'ARRAY') { + if (@$_ == 0) { + $_ = undef; + } + elsif (@$_ == 1) { + $_ = $_->[0]; + } + } + elsif (ref $_ eq 'HASH') { + my ($first, $more) = keys %$_; + + # empty hash + if (! defined $first) { + $_ = undef; + } + # one element hash + elsif (! defined $more) { + if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') { + $_ = $_->{'-and'}; + } + elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') { + $_ = $_->{'-or'}; + } + } + } + } + + # merge hashes with weeding out of duplicates (simple cases only) + if (ref $left eq 'HASH' and ref $right eq 'HASH') { + + # shallow copy to destroy + $right = { %$right }; + for (grep { exists $right->{$_} } keys %$left) { + # the use of eq_deeply here is justified - the rhs of an + # expression can contain a lot of twisted weird stuff + delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} ); + } + + $right = undef unless keys %$right; + } + + if (defined $left xor defined $right) { return defined $left ? $left : $right; } - elsif (defined $left) { - return { -and => [ map - { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } - ($left, $right) - ]}; + elsif (! defined $left) { + return undef; + } + else { + return { -and => [ $left, $right ] }; } - - return undef; } =head2 search_literal @@ -540,7 +621,7 @@ sub _stack_cond { =item Arguments: $sql_fragment, @bind_values -=item Return Value: $resultset (scalar context), @row_objs (list context) +=item Return Value: $resultset (scalar context) || @row_objs (list context) =back @@ -649,22 +730,33 @@ sub find { my $rsrc = $self->result_source; + my $constraint_name; + if (exists $attrs->{key}) { + $constraint_name = defined $attrs->{key} + ? $attrs->{key} + : $self->throw_exception("An undefined 'key' resultset attribute makes no sense") + ; + } + # Parse out the condition from input my $call_cond; + if (ref $_[0] eq 'HASH') { $call_cond = { %{$_[0]} }; } else { - my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary'; - my @c_cols = $rsrc->unique_constraint_columns($constraint); + # if only values are supplied we need to default to 'primary' + $constraint_name = 'primary' unless defined $constraint_name; + + my @c_cols = $rsrc->unique_constraint_columns($constraint_name); $self->throw_exception( - "No constraint columns, maybe a malformed '$constraint' constraint?" + "No constraint columns, maybe a malformed '$constraint_name' constraint?" ) unless @c_cols; $self->throw_exception ( 'find() expects either a column/value hashref, or a list of values ' - . "corresponding to the columns of the specified unique constraint '$constraint'" + . "corresponding to the columns of the specified unique constraint '$constraint_name'" ) unless @c_cols == @_; $call_cond = {}; @@ -695,11 +787,11 @@ sub find { my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias}; my $final_cond; - if (exists $attrs->{key}) { + if (defined $constraint_name) { $final_cond = $self->_qualify_cond_columns ( $self->_build_unique_cond ( - $attrs->{key}, + $constraint_name, $call_cond, ), @@ -737,7 +829,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; @@ -835,9 +927,9 @@ sub _build_unique_cond { =over 4 -=item Arguments: $rel, $cond, \%attrs? +=item Arguments: $rel, $cond?, \%attrs? -=item Return Value: $new_resultset +=item Return Value: $new_resultset (scalar context) || @row_objs (list context) =back @@ -848,6 +940,11 @@ sub _build_unique_cond { Searches the specified relationship, optionally specifying a condition and attributes for matching records. See L for more information. +In list context, C<< ->all() >> is called implicitly on the resultset, thus +returning a list of row objects instead. To avoid that, use L. + +See also L. + =cut sub search_related { @@ -941,11 +1038,9 @@ sub single { my $attrs = $self->_resolved_attrs_copy; - 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 prefetching has_many. Use find( \%cond ) or next() instead' + ) if $attrs->{collapse}; if ($where) { if (defined $attrs->{where}) { @@ -959,12 +1054,13 @@ 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_objects->[0]; } @@ -1028,7 +1124,7 @@ sub get_column { =item Arguments: $cond, \%attrs? -=item Return Value: $resultset (scalar context), @row_objs (list context) +=item Return Value: $resultset (scalar context) || @row_objs (list context) =back @@ -1071,7 +1167,7 @@ sub search_like { =item Arguments: $first, $last -=item Return Value: $resultset (scalar context), @row_objs (list context) +=item Return Value: $resultset (scalar context) || @row_objs (list context) =back @@ -1121,161 +1217,156 @@ 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) = @_; - - 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; -} - -sub _collapse_result { - my ($self, $as_proto, $row) = @_; - - my @copy = @$row; - - # 'foo' => [ undef, 'foo' ] - # 'foo.bar' => [ 'foo', 'bar' ] - # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] - - my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; - my %collapse = %{$self->{_attrs}{collapse}||{}}; + return shift(@{$self->{stashed_objects}}) if @{ $self->{stashed_objects}||[] }; - my @pri_index; + $self->{stashed_objects} = $self->_construct_objects + or return undef; - # 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. - - # 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 + return shift @{$self->{stashed_objects}}; +} - # store just the index so we can check the array positions from the row - # without having to contruct the full hash +# Constructs as many objects 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 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_objects { + my ($self, $fetch_all) = @_; - 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); - } - last unless keys %pri; # short circuit (Johnny Five Is Alive!) - } + my $rsrc = $self->result_source; + my $attrs = $self->_resolved_attrs; + my $cursor = $self->cursor; + + # this will be used as both initial raw-row collector AND as a RV of + # _construct_objects. Not regrowing the array twice matters a lot... + # a suprising amount actually + my $rows = (delete $self->{stashed_rows}) || []; + if ($fetch_all) { + # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref + $rows = [ @$rows, $cursor->all ]; } + elsif (!$attrs->{collapse}) { + # 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; + } + 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}) ) + ; - # no need to do an if, it'll be empty if @pri_index is empty anyway - - my %pri_vals = map { ($_ => $copy[$_]) } @pri_index; - - my @const_rows; + my $colinfos = $st->_resolve_column_info($attrs->{from}, \@ord_cols); - do { # no need to check anything at the front, we always want the first row + for (0 .. $#ord_cols) { + if ( + ! $colinfos->{$ord_cols[$_]} + or + $colinfos->{$ord_cols[$_]}{-result_source} != $rsrc + ) { + splice @ord_cols, $_; + last; + } + } - my %const; + # 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; + }; - foreach my $this_as (@construct_as) { - $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); + if ($attrs->{_ordered_for_collapse}) { + push @$rows, do { my @r = $cursor->next; @r ? \@r : () }; } + # instead of looping over ->next, use ->all in stealth mode + # FIXME - encapsulation breach, got to be a better way + elsif (! $cursor->{done}) { + push @$rows, $cursor->all; + $cursor->{done} = 1; + $fetch_all = 1; + } + } - push(@const_rows, \%const); - - } until ( # no pri_index => no collapse => drop straight out - !@pri_index - or - do { # get another row, stash it, drop out if different PK + return undef unless @$rows; - @copy = $self->cursor->next; - $self->{stashed_row} = \@copy; + 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"); - # last thing in do block, counts as true if anything doesn't match + my $infmap = $attrs->{as}; - # check xor defined first for NULL vs. NOT NULL then if one is - # defined the other must be so check string equality + if (!$attrs->{collapse} and $attrs->{_single_object_inflation}) { + # construct a much simpler array->hash folder for the one-table cases right here - grep { - (defined $pri_vals{$_} ^ defined $copy[$_]) - || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) - } @pri_index; + # 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 + # 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; + for my $r (@$rows) { + $r = $inflator->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } @as_idx } ); } - ); - - my $alias = $self->{attrs}{alias}; - my $info = []; - - my %collapse_pos; + } + else { + eval sprintf ( + '$_ = $inflator->($res_class, $rsrc, { %s }) for @$rows', + join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) + ); + } + } + else { + ($self->{_row_parser} ||= eval sprintf 'sub { %s }', $rsrc->_mk_row_parser({ + inflate_map => $infmap, + selection => $attrs->{select}, + collapse => $attrs->{collapse}, + }) or die $@)->($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 + )); # modify $rows in-place, shrinking/extending as necessary + + $_ = $inflator->($res_class, $rsrc, @$_) for @$rows; - my @const_keys; + } - 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}; - } - } + # CDBI compat stuff + if ($attrs->{record_filter}) { + $_ = $attrs->{record_filter}->($_) for @$rows; } - return $info; + return $rows; } =head2 result_source @@ -1424,7 +1515,7 @@ sub _count_rs { # overwrite the selector (supplied by the storage) $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs); $tmp_attrs->{as} = 'count'; - delete @{$tmp_attrs}{qw/columns _trailing_select/}; + delete @{$tmp_attrs}{qw/columns/}; my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); @@ -1442,12 +1533,17 @@ sub _count_subq_rs { 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 _trailing_select order_by for/}; + delete @{$sub_attrs}{qw/collapse columns as select _prefetch_selector_range order_by for/}; - # if we multi-prefetch we group_by primary keys only as this is what we would + # 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}} ) { - $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ] + 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 ' + . 'has_many prefetch before count()' + ); + } ] } # Calculate subquery selector @@ -1551,41 +1647,30 @@ sub count_literal { shift->search_literal(@_)->count; } =back -Returns all elements in the resultset. Called implicitly if the resultset -is returned in list context. +Returns all elements in the resultset. =cut 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->{stashed_rows}; + delete $self->{stashed_objects}; + + if (my $c = $self->get_cache) { + return @$c; } - $self->set_cache(\@obj) if $self->{attrs}{cache}; + $self->cursor->reset; + + my $objs = $self->_construct_objects('fetch_all') || []; - return @obj; + $self->set_cache($objs) if $self->{attrs}{cache}; + + return @$objs; } =head2 reset @@ -1606,7 +1691,10 @@ another query. sub reset { my ($self) = @_; - delete $self->{_attrs} if exists $self->{_attrs}; + delete $self->{_attrs}; + delete $self->{stashed_rows}; + delete $self->{stashed_objects}; + $self->{all_cache_position} = 0; $self->cursor->reset; return $self; @@ -1641,39 +1729,122 @@ 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} }; + + # "needs" is a strong word here - if the subquery is part of an IN clause - no point of + # even adding the group_by. It will really be used only when composing a poor-man's + # multicolumn-IN equivalent OR set + my $needs_group_by_subq = defined $attrs->{group_by}; + + # simplify the joinmap and maybe decide if a grouping (and thus subquery) is necessary + my $relation_classifications; + if (ref($attrs->{from}) eq 'ARRAY') { + $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs); + + $relation_classifications = $storage->_resolve_aliastypes_from_select_args ( + [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ], + $attrs->{select}, + $cond, + $attrs + ) unless $needs_group_by_subq; # we already know we need a group, no point of resolving them + } + else { + $needs_group_by_subq ||= 1; # if {from} is unparseable assume the worst + } - # if a condition exists we need to strip all table qualifiers - # if this is not possible we'll force a subquery below - my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond}); + $needs_group_by_subq ||= exists $relation_classifications->{multiplying}; - my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/); - my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/); + # if no subquery - life is easy-ish + unless ( + $needs_group_by_subq + or + keys %$relation_classifications # if any joins at all - need to wrap a subq + or + $self->_has_resolved_attr(qw/rows offset/) # limits call for a 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. What this code tries to do (badly) is to generate a condition + # with the qualifiers removed, by exploiting the quote mechanism of sqla + # + # this is atrocious and should be replaced by normal sqla introspection + # one sunny day + my ($sql, @bind) = do { + my $sqla = $rsrc->storage->sql_maker; + local $sqla->{_dequalify_idents} = 1; + $sqla->_recurse_where($self->{cond}); + } if $self->{cond}; - if ($needs_group_by_subq or $needs_subq) { + return $rsrc->storage->$op( + $rsrc, + $op eq 'update' ? $values : (), + $self->{cond} ? \[$sql, @bind] : (), + ); + } - # make a new $rs selecting only the PKs (that's all we really need) - my $attrs = $self->_resolved_attrs_copy; + # 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, + ) + ); + my $existing_group_by = delete $attrs->{group_by}; + # 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/; + $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); - delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/; - $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ]; + 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, + ); + return $storage->$op ( + $rsrc, + $op eq 'update' ? $values : (), + \[$sql, @bind], + ); + } + 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 starts to matter + my $subq_group_by; if ($needs_group_by_subq) { - # make sure no group_by was supplied, or if there is one - make sure it matches - # the columns compiled above perfectly. Anything else can not be sanely executed - # on most databases so croak right then and there + $subq_group_by = $attrs->{columns}; - if (my $g = $attrs->{group_by}) { + # 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}.$_" } - @$g + @$existing_group_by ; if ( join ("\x00", sort @current_group_by) ne - join ("\x00", sort @{$attrs->{columns}} ) + join ("\x00", sort @$subq_group_by ) ) { $self->throw_exception ( "You have just attempted a $op operation on a resultset which does group_by" @@ -1684,20 +1855,27 @@ sub _rs_update_delete { ); } } - else { - $attrs->{group_by} = $attrs->{columns}; - } } - my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); - } - else { - return $rsrc->storage->$op( + my $guard = $storage->txn_scope_guard; + + my @op_condition; + for my $row ($subrs->search({}, { group_by => $subq_group_by })->cursor->all) { + push @op_condition, { map + { $idcols->[$_] => $row->[$_] } + (0 .. $#$idcols) + }; + } + + my $res = $storage->$op ( $rsrc, $op eq 'update' ? $values : (), - $cond, + \@op_condition, ); + + $guard->commit; + + return $res; } } @@ -1717,7 +1895,7 @@ triggers, nor will it update any row object instances derived from this resultset (this includes the contents of the L if any). See L if you need to execute any on-update triggers or cascades defined either by you or a -L. +L. The return value is a pass through of what the underlying storage backend returned, and may vary. See L for the most @@ -1730,7 +1908,7 @@ This is unlike the corresponding L. The user must ensure manually that any value passed to this method will stringify to something the RDBMS knows how to deal with. A notable example is the handling of L objects, for more info see: -L. +L. =cut @@ -1764,7 +1942,7 @@ sub update_all { unless ref $values eq 'HASH'; my $guard = $self->result_source->schema->txn_scope_guard; - $_->update($values) for $self->all; + $_->update({%$values}) for $self->all; # shallow copy - update will mangle it $guard->commit; return 1; } @@ -1785,7 +1963,7 @@ L status of any row object instances derived from this resultset (this includes the contents of the L if any). See L if you need to execute any on-delete triggers or cascades defined either by you or a -L. +L. The return value is a pass through of what the underlying storage backend returned, and may vary. See L for the most common case. @@ -1906,13 +2084,15 @@ sub populate { # cruft placed in standalone method my $data = $self->_normalize_populate_args(@_); + return unless @$data; + if(defined wantarray) { my @created; foreach my $item (@$data) { push(@created, $self->create($item)); } return wantarray ? @created : \@created; - } + } else { my $first = $data->[0]; @@ -2010,7 +2190,10 @@ sub _normalize_populate_args { my ($self, $arg) = @_; if (ref $arg eq 'ARRAY') { - if (ref $arg->[0] eq 'HASH') { + if (!@$arg) { + return []; + } + elsif (ref $arg->[0] eq 'HASH') { return $arg; } elsif (ref $arg->[0] eq 'ARRAY') { @@ -2044,116 +2227,11 @@ C on the L object. =cut -# make a wizard good for both a scalar and a hashref -my $mk_lazy_count_wizard = sub { - require Variable::Magic; - - my $stash = { total_rs => shift }; - my $slot = shift; # only used by the hashref magic - - my $magic = Variable::Magic::wizard ( - data => sub { $stash }, - - (!$slot) - ? ( - # the scalar magic - get => sub { - # set value lazily, and dispell for good - ${$_[0]} = $_[1]{total_rs}->count; - Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}); - return 1; - }, - set => sub { - # an explicit set implies dispell as well - # the unless() is to work around "fun and giggles" below - Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}) - unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; - return 1; - }, - ) - : ( - # the uvar magic - fetch => sub { - if ($_[2] eq $slot and !$_[1]{inactive}) { - my $cnt = $_[1]{total_rs}->count; - $_[0]->{$slot} = $cnt; - - # attempting to dispell in a fetch handle (works in store), seems - # to invariable segfault on 5.10, 5.12, 5.13 :( - # so use an inactivator instead - #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); - $_[1]{inactive}++; - } - return 1; - }, - store => sub { - if (! $_[1]{inactive} and $_[2] eq $slot) { - #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); - $_[1]{inactive}++ - unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; - } - return 1; - }, - ), - ); - - $stash->{magic_selfref} = $magic; - weaken ($stash->{magic_selfref}); # this fails on 5.8.1 - - return $magic; -}; - -# the tie class for 5.8.1 -{ - package # hide from pause - DBIx::Class::__DBIC_LAZY_RS_COUNT__; - use base qw/Tie::Hash/; - - sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} } - sub NEXTKEY { each %{$_[0]{data}} } - sub EXISTS { exists $_[0]{data}{$_[1]} } - sub DELETE { delete $_[0]{data}{$_[1]} } - sub CLEAR { %{$_[0]{data}} = () } - sub SCALAR { scalar %{$_[0]{data}} } - - sub TIEHASH { - $_[1]{data} = {%{$_[1]{selfref}}}; - %{$_[1]{selfref}} = (); - Scalar::Util::weaken ($_[1]{selfref}); - return bless ($_[1], $_[0]); - }; - - sub FETCH { - if ($_[1] eq $_[0]{slot}) { - my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count; - untie %{$_[0]{selfref}}; - %{$_[0]{selfref}} = %{$_[0]{data}}; - return $cnt; - } - else { - $_[0]{data}{$_[1]}; - } - } - - sub STORE { - $_[0]{data}{$_[1]} = $_[2]; - if ($_[1] eq $_[0]{slot}) { - untie %{$_[0]{selfref}}; - %{$_[0]{selfref}} = %{$_[0]{data}}; - } - $_[2]; - } -} - sub pager { my ($self) = @_; return $self->{pager} if $self->{pager}; - if ($self->get_cache) { - $self->throw_exception ('Pagers on cached resultsets are not supported'); - } - my $attrs = $self->{attrs}; if (!defined $attrs->{page}) { $self->throw_exception("Can't create pager for non-paged rs"); @@ -2167,70 +2245,15 @@ sub pager { # with a subselect) to get the real total count my $count_attrs = { %$attrs }; delete $count_attrs->{$_} for qw/rows offset page pager/; - my $total_rs = (ref $self)->new($self->result_source, $count_attrs); + my $total_rs = (ref $self)->new($self->result_source, $count_attrs); -### the following may seem awkward and dirty, but it's a thought-experiment -### necessary for future development of DBIx::DS. Do *NOT* change this code -### before talking to ribasushi/mst - - require Data::Page; - my $pager = Data::Page->new( - 0, #start with an empty set + require DBIx::Class::ResultSet::Pager; + return $self->{pager} = DBIx::Class::ResultSet::Pager->new( + sub { $total_rs->count }, #lazy-get the total $attrs->{rows}, $self->{attrs}{page}, ); - - my $data_slot = 'total_entries'; - - # Since we are interested in a cached value (once it's set - it's set), every - # technique will detach from the magic-host once the time comes to fire the - # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself) - - if ($] < 5.008003) { - # 5.8.1 throws 'Modification of a read-only value attempted' when one tries - # to weakref the magic container :( - # tested on 5.8.1 - tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__', - { slot => $data_slot, total_rs => $total_rs, selfref => $pager } - ); - } - elsif ($] < 5.010) { - # We can use magic on the hash value slot. It's interesting that the magic is - # attached to the hash-slot, and does *not* stop working once I do the dummy - # assignments after the cast() - # tested on 5.8.3 and 5.8.9 - my $magic = $mk_lazy_count_wizard->($total_rs); - Variable::Magic::cast ( $pager->{$data_slot}, $magic ); - - # this is for fun and giggles - $pager->{$data_slot} = -1; - $pager->{$data_slot} = 0; - - # this does not work for scalars, but works with - # uvar magic below - #my %vals = %$pager; - #%$pager = (); - #%{$pager} = %vals; - } - else { - # And the uvar magic - # works on 5.10.1, 5.12.1 and 5.13.4 in its current form, - # however see the wizard maker for more notes - my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot); - Variable::Magic::cast ( %$pager, $magic ); - - # still works - $pager->{$data_slot} = -1; - $pager->{$data_slot} = 0; - - # this now works - my %vals = %$pager; - %$pager = (); - %{$pager} = %vals; - } - - return $self->{pager} = $pager; } =head2 page @@ -2676,6 +2699,23 @@ all in the call to C, even when set to C. See also L and L. For information on how to declare unique constraints, see L. +If you need to know if an existing row was found or a new one created use +L and L instead. Don't forget +to call L to save the newly created row to the +database! + + my $cd = $schema->resultset('CD')->find_or_new({ + cdid => 5, + artist => 'Massive Attack', + title => 'Mezzanine', + year => 2005, + }); + + if( $cd->in_storage ) { + # do some stuff + $cd->insert; + } + =cut sub find_or_create { @@ -2737,6 +2777,25 @@ all in the call to C, even when set to C. See also L and L. For information on how to declare unique constraints, see L. +If you need to know if an existing row was updated or a new one created use +L and L instead. Don't forget +to call L to save the newly created row to the +database! + + my $cd = $schema->resultset('CD')->update_or_new( + { + artist => 'Massive Attack', + title => 'Mezzanine', + year => 1998, + }, + { key => 'cd_artist_title' } + ); + + if( $cd->in_storage ) { + # do some stuff + $cd->insert; + } + =cut sub update_or_create { @@ -2798,7 +2857,7 @@ supplied by the database (e.g. an auto_increment primary key column). In normal usage, the value of such columns should NOT be included at all in the call to C, even when set to C. -See also L, L and L. +See also L, L and L. =cut @@ -2966,7 +3025,7 @@ sub related_resultset { if (my $cache = $self->get_cache) { if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) { - $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} } + $new_cache = [ map { @{$_->related_resultset($rel)->get_cache||[]} } @$cache ]; } } @@ -3026,9 +3085,9 @@ source alias of the current result set: my $me = $self->current_source_alias; - return $self->search( + return $self->search({ "$me.modified" => $user->id, - ); + }); } =cut @@ -3232,16 +3291,13 @@ sub _resolved_attrs { my $source = $self->result_source; my $alias = $attrs->{alias}; - # one last pass of normalization - $self->_normalize_selection($attrs); - # default selection list $attrs->{columns} = [ $source->columns ] - unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as _trailing_select/; + unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/; # merge selectors together - for (qw/columns select as _trailing_select/) { - $attrs->{$_} = $self->_merge_attr($attrs->{$_}, $attrs->{"+$_"}) + for (qw/columns select as/) { + $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"}) if $attrs->{$_} or $attrs->{"+$_"}; } @@ -3272,14 +3328,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 @@ -3357,21 +3409,26 @@ sub _resolved_attrs { } else { # distinct affects only the main selection part, not what prefetch may - # add below. However trailing is not yet a part of the selection as - # prefetch must insert before it + # add below. $attrs->{group_by} = $source->storage->_group_over_selection ( $attrs->{from}, - [ @{$attrs->{select}||[]}, @{$attrs->{_trailing_select}||[]} ], + $attrs->{select}, $attrs->{order_by}, ); } } - $attrs->{collapse} ||= {}; - if ($attrs->{prefetch}) { - my $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ); + # generate selections based on the prefetch helper + my $prefetch; + $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) + if defined $attrs->{prefetch}; + + if ($prefetch) { - my $prefetch_ordering = []; + $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") + if $attrs->{_dark_selector}; + + $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 @@ -3394,8 +3451,7 @@ 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 ); # we need to somehow mark which columns came from prefetch if (@prefetch) { @@ -3405,14 +3461,40 @@ sub _resolved_attrs { push @{ $attrs->{select} }, (map { $_->[0] } @prefetch); push @{ $attrs->{as} }, (map { $_->[1] } @prefetch); - - push( @{$attrs->{order_by}}, @$prefetch_ordering ); - $attrs->{_collapse_order_by} = \@$prefetch_ordering; } + $attrs->{_single_object_inflation} = ! List::Util::first { $_ =~ /\./ } @{$attrs->{as}}; - push @{ $attrs->{select} }, @{$attrs->{_trailing_select}} - if $attrs->{_trailing_select}; + # run through the resulting joinstructure (starting from our current slot) + # and unset collapse if proven unnesessary + if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') { + + if (@{$attrs->{from}} > 1) { + + # find where our table-spec starts and consider only things after us + my @fromlist = @{$attrs->{from}}; + while (@fromlist) { + my $t = shift @fromlist; + $t = $t->[0] if ref $t eq 'ARRAY'; #me vs join from-spec mismatch + last if ($t->{-alias} && $t->{-alias} eq $alias); + } + + for (@fromlist) { + $attrs->{collapse} = ! $_->[0]{-is_single} + and last; + } + } + else { + # no joins - no collapse + $attrs->{collapse} = 0; + } + } + + 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; + } # if both page and offset are specified, produce a combined offset # even though it doesn't make much sense, this is what pre 081xx has @@ -3521,6 +3603,7 @@ sub _merge_joinpref_attr { $position++; } my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element); + $import_key = '' if not defined $import_key; if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) { push( @{$orig}, $import_element ); @@ -3635,6 +3718,14 @@ sub STORABLE_freeze { # A cursor in progress can't be serialized (and would make little sense anyway) delete $to_serialize->{cursor}; + # the parser can be regenerated + delete $to_serialize->{_row_parser}; + + # 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') { + delete $to_serialize->{pager}; + } + Storable::nfreeze($to_serialize); } @@ -3966,28 +4057,122 @@ case. Simple prefetches will be joined automatically, so there is no need for a C attribute in the above search. -C can be used with the following relationship types: C, -C (or if you're using C, any relationship declared -with an accessor type of 'single' or 'filter'). A more complex example that -prefetches an artists cds, the tracks on those cds, and the tags associated -with that artist is given below (assuming many-to-many from artists to tags): +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('Artist')->search( + my $rs = $schema->resultset('CD')->search( undef, { prefetch => [ - { cds => 'tracks' }, - { artist_tags => 'tags' } + { 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) + ] + } + ); + +In fact, C will emit the following warning: + + Prefetching multiple has_many rels tracks and cd_to_producer at top + level will explode the number of row objects retrievable via ->next + or ->all. Use at your own risk. + +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( + {'record_label.name' => 'Music Product Ltd.'}, + { + join => {artist => 'record_label'}, + prefetch => 'artist', + } + ); + +... will work, searching on the record label's name, but only +prefetching the C. + +=head3 Using L with L / L / L / L -B If you specify a C attribute, the C and C becomes: C<'cd.title', 'artist.*'> and the L +becomes: C<'cd_title', 'artist.*'>. + +=head3 CAVEATS + +Prefetch does a lot of deep magic. As such, it may not behave exactly +as you might expect. =over 4 @@ -4062,6 +4247,24 @@ rows per page if the page attribute or method is used. Specifies the (zero-based) row number for the first row to be returned, or the of the first row of the first page if paging is used. +=head2 software_limit + +=over 4 + +=item Value: (0 | 1) + +=back + +When combined with L and/or L the generated SQL will not +include any limit dialect stanzas. Instead the entire result will be selected +as if no limits were specified, and DBIC will perform the limit locally, by +artificially advancing and finishing the resulting L. + +This is the recommended way of performing resultset limiting when no sane RDBMS +implementation is available (e.g. +L using the +L hack) + =head2 group_by =over 4 @@ -4115,6 +4318,8 @@ Adds to the WHERE clause. Can be overridden by passing C<< { where => undef } >> as an attribute to a resultset. +For more complicated where clauses see L. + =back =head2 cache