X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=05e4c00748cac15bc54abfbe7ec3bcae50fd897b;hb=b49cd082958aea8c2899ab46c56975c38c232fc2;hp=ec5413687607617367682fe7cbda62b74b693a19;hpb=d73c65616463b6d435eac899dc2ef21c1b53b29a;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index ec54136..05e4c00 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -3,52 +3,146 @@ package DBIx::Class::ResultSet; use strict; use warnings; use overload - '0+' => \&count, - 'bool' => sub { 1; }, + '0+' => "count", + 'bool' => "_bool", fallback => 1; use Carp::Clan qw/^DBIx::Class/; use Data::Page; use Storable; use DBIx::Class::ResultSetColumn; +use DBIx::Class::ResultSourceHandle; +use List::Util (); +use Scalar::Util (); use base qw/DBIx::Class/; -__PACKAGE__->load_components(qw/AccessorGroup/); -__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/); +__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/); =head1 NAME -DBIx::Class::ResultSet - Responsible for fetching and creating resultset. +DBIx::Class::ResultSet - Represents a query used for fetching a set of results. =head1 SYNOPSIS - my $rs = $schema->resultset('User')->search(registered => 1); - my @rows = $schema->resultset('CD')->search(year => 2005); + my $users_rs = $schema->resultset('User'); + my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 }); + my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all(); =head1 DESCRIPTION -The resultset is also known as an iterator. It is responsible for handling -queries that may return an arbitrary number of rows, e.g. via L -or a C relationship. +A ResultSet is an object which stores a set of conditions representing +a query. It is the backbone of DBIx::Class (i.e. the really +important/useful bit). -In the examples below, the following table classes are used: +No SQL is executed on the database when a ResultSet is created, it +just stores all the conditions needed to create the query. - package MyApp::Schema::Artist; - use base qw/DBIx::Class/; - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('artist'); - __PACKAGE__->add_columns(qw/artistid name/); - __PACKAGE__->set_primary_key('artistid'); - __PACKAGE__->has_many(cds => 'MyApp::Schema::CD'); - 1; +A basic ResultSet representing the data of an entire table is returned +by calling C on a L and passing in a +L name. - package MyApp::Schema::CD; - use base qw/DBIx::Class/; - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('cd'); - __PACKAGE__->add_columns(qw/cdid artist title year/); - __PACKAGE__->set_primary_key('cdid'); - __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist'); - 1; + my $users_rs = $schema->resultset('User'); + +A new ResultSet is returned from calling L on an existing +ResultSet. The new one will contain all the conditions of the +original, plus any new conditions added in the C call. + +A ResultSet also incorporates an implicit iterator. L and L +can be used to walk through all the Ls the ResultSet +represents. + +The query that the ResultSet represents is B executed against +the database when these methods are called: +L L L L L L + +=head1 EXAMPLES + +=head2 Chaining resultsets + +Let's say you've got a query that needs to be run to return some data +to the user. But, you have an authorization system in place that +prevents certain users from seeing certain information. So, you want +to construct the basic query in one method, but add constraints to it in +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 $cd_rs = $schema->resultset('CD')->search({ + title => $request->param('title'), + year => $request->param('year'), + }); + + $self->apply_security_policy( $cd_rs ); + + return $cd_rs->all(); + } + + sub apply_security_policy { + my $self = shift; + my ($rs) = @_; + + return $rs->search({ + subversive => 0, + }); + } + +=head3 Resolving conditions and attributes + +When a resultset is chained from another resultset, conditions and +attributes with the same keys need resolving. + +L, L, L, L attributes are merged +into the existing ones from the original resultset. + +The L, L attribute, and any search conditions are +merged with an SQL C to the existing condition from the original +resultset. + +All other attributes are overridden by any new ones supplied in the +search attributes. + +=head2 Multiple queries + +Since a resultset just defines a query, you can do all sorts of +things with it with the same object. + + # Don't hit the DB yet. + my $cd_rs = $schema->resultset('CD')->search({ + title => 'something', + year => 2009, + }); + + # Each of these hits the DB individually. + my $count = $cd_rs->count; + my $most_recent = $cd_rs->get_column('date_released')->max(); + my @records = $cd_rs->all; + +And it's not just limited to SELECT statements. + + $cd_rs->delete(); + +This is even cooler: + + $cd_rs->create({ artist => 'Fred' }); + +Which is the same as: + + $schema->resultset('CD')->create({ + title => 'something', + year => 2009, + artist => 'Fred' + }); + +See: L, L, L, L, L. + +=head1 OVERLOADING + +If a resultset is used in a numeric context it returns the L. +However, if it is used in a booleand context it is always true. So if +you want to check if a resultset has any results use C. +C will always be true. =head1 METHODS @@ -85,19 +179,20 @@ sub new { return $class->new_result(@_) if ref $class; my ($source, $attrs) = @_; - #weaken $source; + $source = $source->handle + unless $source->isa('DBIx::Class::ResultSourceHandle'); + $attrs = { %{$attrs||{}} }; if ($attrs->{page}) { $attrs->{rows} ||= 10; - $attrs->{offset} ||= 0; - $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1)); } $attrs->{alias} ||= 'me'; + # Creation of {} and bless separated to mitigate RH perl bug + # see https://bugzilla.redhat.com/show_bug.cgi?id=196836 my $self = { - result_source => $source, - result_class => $attrs->{result_class} || $source->result_class, + _source_handle => $source, cond => $attrs->{where}, count => undef, pager => undef, @@ -106,6 +201,10 @@ sub new { bless $self, $class; + $self->result_class( + $attrs->{result_class} || $source->resolve->result_class + ); + return $self; } @@ -133,7 +232,12 @@ call it as C. columns => [qw/name artistid/], }); -For a list of attributes that can be passed to C, see L. For more examples of using this function, see L. +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. + +For more help on using joins with search, see L. =cut @@ -161,10 +265,9 @@ always return a resultset, even in list context. sub search_rs { my $self = shift; - my $rows; - - unless (@_) { # no search, effectively just a clone - $rows = $self->get_cache; + # Special-case handling for (undef, undef). + if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) { + pop(@_); pop(@_); } my $attrs = {}; @@ -173,10 +276,24 @@ sub search_rs { my $having = delete $our_attrs->{having}; my $where = delete $our_attrs->{where}; + my $rows; + + my %safe = (alias => 1, cache => 1); + + unless ( + (@_ && defined($_[0])) # @_ == () or (undef) + || + (keys %$attrs # empty attrs or only 'safe' attrs + && List::Util::first { !$safe{$_} } keys %$attrs) + ) { + # no search, effectively just a clone + $rows = $self->get_cache; + } + my $new_attrs = { %{$our_attrs}, %{$attrs} }; # merge new attrs into inherited - foreach my $key (qw/join prefetch/) { + foreach my $key (qw/join prefetch +select +as bind/) { next unless exists $attrs->{$key}; $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key}); } @@ -184,7 +301,15 @@ sub search_rs { my $cond = (@_ ? ( (@_ == 1 || ref $_[0] eq "HASH") - ? shift + ? ( + (ref $_[0] eq 'HASH') + ? ( + (keys %{ $_[0] } > 0) + ? shift + : undef + ) + : shift + ) : ( (@_ % 2) ? $self->throw_exception("Odd number of arguments to search") @@ -205,6 +330,7 @@ sub search_rs { } : $where); } + if (defined $cond) { $new_attrs->{where} = ( defined $new_attrs->{where} @@ -252,13 +378,30 @@ sub search_rs { Pass a literal chunk of SQL to be added to the conditional part of the resultset query. +CAVEAT: C is provided for Class::DBI compatibility and should +only be used in that context. C is a convenience method. +It is equivalent to calling $schema->search(\[]), but if you want to ensure +columns are bound correctly, use C. + +Example of how to use C instead of C + + my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2)); + my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]); + + +See L and +L for searching techniques that do not +require C. + =cut sub search_literal { - my ($self, $cond, @vals) = @_; - my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {}); - $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ]; - return $self->search(\$cond, $attrs); + my ($self, $sql, @bind) = @_; + my $attr; + if ( @bind && ref($bind[-1]) eq 'HASH' ) { + $attr = pop @bind; + } + return $self->search(\[ $sql, map [ __DUMMY__ => $_ ], @bind ], ($attr || () )); } =head2 find @@ -267,7 +410,7 @@ sub search_literal { =item Arguments: @values | \%cols, \%attrs? -=item Return Value: $row_object +=item Return Value: $row_object | undef =back @@ -296,11 +439,18 @@ Additionally, you can specify the columns explicitly by name: If the C is specified as C, it searches only on the primary key. If no C is specified, it searches on all unique constraints defined on the -source, including the primary key. +source for which column data is provided, including the primary key. If your table does not have a primary key, you B provide a value for the C attribute matching one of the unique constraints on the source. +In addition to C, L recognizes and applies standard +L in the same way as L does. + +Note: If your query does not return only one row, a warning is generated: + + Query returned more than one row + See also L and L. For information on how to declare unique constraints, see L. @@ -334,25 +484,64 @@ sub find { $input_query = {@_}; } - my @unique_queries = $self->_unique_queries($input_query, $attrs); + my (%related, $info); + + KEY: foreach my $key (keys %$input_query) { + if (ref($input_query->{$key}) + && ($info = $self->result_source->relationship_info($key))) { + my $val = delete $input_query->{$key}; + next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create + my $rel_q = $self->result_source->_resolve_condition( + $info->{cond}, $val, $key + ); + die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY'; + @related{keys %$rel_q} = values %$rel_q; + } + } + if (my @keys = keys %related) { + @{$input_query}{@keys} = values %related; + } + # Build the final query: Default to the disjunction of the unique queries, # but allow the input query in case the ResultSet defines the query or the # user is abusing find my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias}; - my $query = @unique_queries - ? [ map { $self->_add_alias($_, $alias) } @unique_queries ] - : $self->_add_alias($input_query, $alias); + my $query; + if (exists $attrs->{key}) { + my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key}); + my $unique_query = $self->_build_unique_query($input_query, \@unique_cols); + $query = $self->_add_alias($unique_query, $alias); + } + else { + my @unique_queries = $self->_unique_queries($input_query, $attrs); + $query = @unique_queries + ? [ map { $self->_add_alias($_, $alias) } @unique_queries ] + : $self->_add_alias($input_query, $alias); + } # Run the query if (keys %$attrs) { my $rs = $self->search($query, $attrs); - return keys %{$rs->_resolved_attrs->{collapse}} ? $rs->next : $rs->single; + if (keys %{$rs->_resolved_attrs->{collapse}}) { + my $row = $rs->next; + carp "Query returned more than one row" if $rs->next; + return $row; + } + else { + return $rs->single; + } } else { - return keys %{$self->_resolved_attrs->{collapse}} - ? $self->search($query)->next - : $self->single($query); + if (keys %{$self->_resolved_attrs->{collapse}}) { + my $rs = $self->search($query); + my $row = $rs->next; + carp "Query returned more than one row" if $rs->next; + return $row; + } + else { + return $self->single($query); + } } } @@ -383,21 +572,23 @@ sub _unique_queries { ? ($attrs->{key}) : $self->result_source->unique_constraint_names; + my $where = $self->_collapse_cond($self->{attrs}{where} || {}); + my $num_where = scalar keys %$where; + my @unique_queries; foreach my $name (@constraint_names) { my @unique_cols = $self->result_source->unique_constraint_columns($name); my $unique_query = $self->_build_unique_query($query, \@unique_cols); + my $num_cols = scalar @unique_cols; my $num_query = scalar keys %$unique_query; - next unless $num_query; - # XXX: Assuming quite a bit about $self->{attrs}{where} - my $num_cols = scalar @unique_cols; - my $num_where = exists $self->{attrs}{where} - ? scalar keys %{ $self->{attrs}{where} } - : 0; - push @unique_queries, $unique_query - if $num_query + $num_where == $num_cols; + my $total = $num_query + $num_where; + if ($num_query && ($num_query == $num_cols || $total == $num_cols)) { + # The query is either unique on its own or is unique in combination with + # the existing where clause + push @unique_queries, $unique_query; + } } return @unique_queries; @@ -440,6 +631,17 @@ sub search_related { return shift->related_resultset(shift)->search(@_); } +=head2 search_related_rs + +This method works exactly the same as search_related, except that +it guarantees a restultset, even in list context. + +=cut + +sub search_related_rs { + return shift->related_resultset(shift)->search_rs(@_); +} + =head2 cursor =over 4 @@ -458,7 +660,7 @@ L for more information. sub cursor { my ($self) = @_; - my $attrs = { %{$self->_resolved_attrs} }; + my $attrs = $self->_resolved_attrs_copy; return $self->{cursor} ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, $attrs->{where},$attrs); @@ -477,17 +679,39 @@ sub cursor { my $cd = $schema->resultset('CD')->single({ year => 2001 }); Inflates the first result without creating a cursor if the resultset has -any records in it; if not returns nothing. Used by L as an optimisation. +any records in it; if not returns nothing. Used by L as a lean version of +L. + +While this method can take an optional search condition (just like L) +being a fast-code-path it does not recognize search attributes. If you need to +add extra joins or similar, call L and then chain-call L on the +L returned. -Can optionally take an additional condition *only* - this is a fast-code-path -method; if you need to add extra joins or similar call ->search and then -->single without a condition on the $rs returned from that. +=over + +=item B + +As of 0.08100, this method enforces the assumption that the preceeding +query returns only one row. If more than one row is returned, you will receive +a warning: + + Query returned more than one row + +In this case, you should be using L or L instead, or if you really +know what you are doing, use the L attribute to explicitly limit the size +of the resultset. + +=back =cut sub single { my ($self, $where) = @_; - my $attrs = { %{$self->_resolved_attrs} }; + if(@_ > 2) { + $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); + } + + my $attrs = $self->_resolved_attrs_copy; if ($where) { if (defined $attrs->{where}) { $attrs->{where} = { @@ -511,7 +735,7 @@ sub single { $attrs->{where}, $attrs ); - return (@data ? $self->_construct_object(@data) : ()); + return (@data ? ($self->_construct_object(@data))[0] : undef); } # _is_unique_query @@ -558,19 +782,16 @@ sub _collapse_query { if (ref $query eq 'ARRAY') { foreach my $subquery (@$query) { next unless ref $subquery; # -or -# warn "ARRAY: " . Dumper $subquery; $collapsed = $self->_collapse_query($subquery, $collapsed); } } elsif (ref $query eq 'HASH') { if (keys %$query and (keys %$query)[0] eq '-and') { foreach my $subquery (@{$query->{-and}}) { -# warn "HASH: " . Dumper $subquery; $collapsed = $self->_collapse_query($subquery, $collapsed); } } else { -# warn "LEAF: " . Dumper $query; foreach my $col (keys %$query) { my $value = $query->{$col}; $collapsed->{$col}{$value}++; @@ -617,15 +838,29 @@ sub get_column { $cd_rs = $rs->search_like({ title => '%blue%'}); Performs a search, but uses C instead of C<=> as the condition. Note -that this is simply a convenience method. You most likely want to use -L with specific operators. +that this is simply a convenience method retained for ex Class::DBI users. +You most likely want to use L with specific operators. For more information, see L. +This method is deprecated and will be removed in 0.09. Use L +instead. An example conversion is: + + ->search_like({ foo => 'bar' }); + + # Becomes + + ->search({ foo => { like => 'bar' } }); + =cut sub search_like { my $class = shift; + carp join ("\n", + 'search_like() is deprecated and will be removed in 0.09.', + 'Instead use ->search({ x => { -like => "y%" } })', + '(note the outer pair of {}s - they are important!)' + ); my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_}; $query->{$_} = { 'like' => $query->{$_} } for keys %$query; @@ -696,97 +931,149 @@ sub next { $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 unless (@row); - return $self->_construct_object(@row); + 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); - my $new = $self->result_class->inflate_result($self->result_source, @$info); - $new = $self->{_attrs}{record_filter}->($new) + 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; + return @new; } sub _collapse_result { - my ($self, $as, $row, $prefix) = @_; + my ($self, $as_proto, $row) = @_; - my %const; my @copy = @$row; - - foreach my $this_as (@$as) { - my $val = shift @copy; - if (defined $prefix) { - if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) { - my $remain = $1; - $remain =~ /^(?:(.*)\.)?([^.]+)$/; - $const{$1||''}{$2} = $val; - } - } else { - $this_as =~ /^(?:(.*)\.)?([^.]+)$/; - $const{$1||''}{$2} = $val; - } - } - my $alias = $self->{attrs}{alias}; - my $info = [ {}, {} ]; - foreach my $key (keys %const) { - if (length $key && $key ne $alias) { - my $target = $info; - my @parts = split(/\./, $key); - foreach my $p (@parts) { - $target = $target->[1]->{$p} ||= []; + # 'foo' => [ undef, 'foo' ] + # 'foo.bar' => [ 'foo', 'bar' ] + # 'foo.bar.baz' => [ 'foo.bar', 'baz' ] + + my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto; + + my %collapse = %{$self->{_attrs}{collapse}||{}}; + + my @pri_index; + + # 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 + + # store just the index so we can check the array positions from the row + # without having to contruct the full hash + + if (keys %collapse) { + my %pri = map { ($_ => 1) } $self->result_source->primary_columns; + 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); } - $target->[0] = $const{$key}; - } else { - $info->[0] = $const{$key}; + last unless keys %pri; # short circuit (Johnny Five Is Alive!) } } - - my @collapse; - if (defined $prefix) { - @collapse = map { - m/^\Q${prefix}.\E(.+)$/ ? ($1) : () - } keys %{$self->{_attrs}{collapse}} - } else { - @collapse = keys %{$self->{_attrs}{collapse}}; - }; - if (@collapse) { - my ($c) = sort { length $a <=> length $b } @collapse; - my $target = $info; - foreach my $p (split(/\./, $c)) { - $target = $target->[1]->{$p} ||= []; + # 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; + + do { # no need to check anything at the front, we always want the first row + + my %const; + + foreach my $this_as (@construct_as) { + $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy); } - my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c); - my @co_key = @{$self->{_attrs}{collapse}{$c_prefix}}; - my $tree = $self->_collapse_result($as, $row, $c_prefix); - my %co_check = map { ($_, $tree->[0]->{$_}); } @co_key; - my (@final, @raw); - - while ( - !( + + 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 + + @copy = $self->cursor->next; + $self->{stashed_row} = \@copy; + + # last thing in do block, counts as true if anything doesn't match + + # check xor defined first for NULL vs. NOT NULL then if one is + # defined the other must be so check string equality + grep { - !defined($tree->[0]->{$_}) || $co_check{$_} ne $tree->[0]->{$_} - } @co_key - ) - ) { - push(@final, $tree); - last unless (@raw = $self->cursor->next); - $row = $self->{stashed_row} = \@raw; - $tree = $self->_collapse_result($as, $row, $c_prefix); + (defined $pri_vals{$_} ^ defined $copy[$_]) + || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_])) + } @pri_index; + } + ); + + my $alias = $self->{attrs}{alias}; + my $info = []; + + my %collapse_pos; + + 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}; + } } - @$target = (@final ? @final : [ {}, {} ]); - # single empty result to indicate an empty prefetched has_many } - #print "final info: " . Dumper($info); return $info; } @@ -813,12 +1100,25 @@ is derived. =back -An accessor for the class to use when creating row objects. Defaults to -C<< result_source->result_class >> - which in most cases is the name of the +An accessor for the class to use when creating row objects. Defaults to +C<< result_source->result_class >> - which in most cases is the name of the L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. +Note that changing the result_class will also remove any components +that were originally loaded in the source class via +L. Any overloaded methods +in the original source class will not run. + =cut +sub result_class { + my ($self, $result_class) = @_; + if ($result_class) { + $self->ensure_class_loaded($result_class); + $self->_result_class($result_class); + } + $self->_result_class; +} =head2 count @@ -831,14 +1131,8 @@ L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. =back Performs an SQL C with the same query as the resultset was built -with to find the number of elements. If passed arguments, does a search -on the resultset and counts the results of that. - -Note: When using C with C, L emulates C -using C. Some databases (notably SQLite) do -not support C with multiple columns. If you are using such a -database, you should only use columns from the main table in your C -clause. +with to find the number of elements. Passing arguments is equivalent to +C<< $rs->search ($cond, \%attrs)->count >> =cut @@ -846,49 +1140,95 @@ sub count { my $self = shift; return $self->search(@_)->count if @_ and defined $_[0]; return scalar @{ $self->get_cache } if $self->get_cache; - my $count = $self->_count; - return 0 unless $count; - $count -= $self->{attrs}{offset} if $self->{attrs}{offset}; - $count = $self->{attrs}{rows} if - $self->{attrs}{rows} and $self->{attrs}{rows} < $count; - return $count; + my @grouped_subq_attrs = qw/prefetch collapse distinct group_by having/; + my @subq_attrs = (); + + my $attrs = $self->_resolved_attrs; + # if we are not paged - we are simply asking for a limit + if (not $attrs->{page} and not $attrs->{software_limit}) { + push @subq_attrs, qw/rows offset/; + } + + my $need_subq = $self->_has_attr (@subq_attrs); + my $need_group_subq = $self->_has_attr (@grouped_subq_attrs); + + return ($need_subq || $need_group_subq) + ? $self->_count_subq ($need_group_subq) + : $self->_count_simple } -sub _count { # Separated out so pager can get the full count - my $self = shift; - my $select = { count => '*' }; - - my $attrs = { %{$self->_resolved_attrs} }; - if (my $group_by = delete $attrs->{group_by}) { - delete $attrs->{having}; - my @distinct = (ref $group_by ? @$group_by : ($group_by)); - # todo: try CONCAT for multi-column pk - my @pk = $self->result_source->primary_columns; - if (@pk == 1) { - my $alias = $attrs->{alias}; - foreach my $column (@distinct) { - if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) { - @distinct = ($column); - last; - } - } +sub _count_subq { + my ($self, $add_group_by) = @_; + + my $attrs = $self->_resolved_attrs_copy; + + # copy for the subquery, we need to do some adjustments to it too + my $sub_attrs = { %$attrs }; + + # these can not go in the subquery, and there is no point of ordering it + delete $sub_attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns order_by/; + + # if needed force a group_by and the same set of columns (most databases require this) + if ($add_group_by) { + + # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all + # simply deleting group_by suffices, as the code below will re-fill it + # Note: we check $attrs, as $sub_attrs has collapse deleted + if (ref $attrs->{collapse} and keys %{$attrs->{collapse}} ) { + delete $sub_attrs->{group_by}; } - $select = { count => { distinct => \@distinct } }; + $sub_attrs->{columns} = $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; } - $attrs->{select} = $select; - $attrs->{as} = [qw/count/]; + $attrs->{from} = [{ + count_subq => (ref $self)->new ($self->result_source, $sub_attrs )->as_query + }]; - # offset, order by and page are not needed to count. record_filter is cdbi - delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/; + # the subquery replaces this + delete $attrs->{$_} for qw/where bind prefetch collapse distinct group_by having having_bind/; + + return $self->__count ($attrs); +} + +sub _count_simple { + my $self = shift; + + my $count = $self->__count; + return 0 unless $count; + + # need to take offset from resolved attrs + + my $attrs = $self->_resolved_attrs; + + $count -= $attrs->{offset} if $attrs->{offset}; + $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count; + $count = 0 if ($count < 0); + return $count; +} + +sub __count { + my ($self, $attrs) = @_; + + $attrs ||= $self->_resolved_attrs_copy; + + # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count + delete $attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/); + + $attrs->{select} = { count => '*' }; + $attrs->{as} = [qw/count/]; my $tmp_rs = (ref $self)->new($self->result_source, $attrs); my ($count) = $tmp_rs->cursor->next; + return $count; } +sub _bool { + return 1; +} + =head2 count_literal =over 4 @@ -922,7 +1262,11 @@ is returned in list context. =cut sub all { - my ($self) = @_; + my $self = shift; + if(@_) { + $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); + } + return @{ $self->get_cache } if $self->get_cache; my @obj; @@ -990,6 +1334,72 @@ sub first { return $_[0]->reset->next; } + +# _rs_update_delete +# +# Determines whether and what type of subquery is required for the $rs operation. +# If grouping is necessary either supplies its own, or verifies the current one +# After all is done delegates to the proper storage method. + +sub _rs_update_delete { + my ($self, $op, $values) = @_; + + my $rsrc = $self->result_source; + + my $needs_group_by_subq = $self->_has_attr (qw/prefetch distinct join seen_join group_by/); + my $needs_subq = $self->_has_attr (qw/row offset page/); + + if ($needs_group_by_subq or $needs_subq) { + + # make a new $rs selecting only the PKs (that's all we really need) + my $attrs = $self->_resolved_attrs_copy; + + delete $attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns/; + $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; + + 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 + + if (my $g = $attrs->{group_by}) { + my @current_group_by = map + { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } + (ref $g eq 'ARRAY' ? @$g : $g ); + + 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.' + ); + } + } + 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( + $rsrc, + $op eq 'update' ? $values : (), + $self->_cond_for_update_delete, + ); + } +} + + # _cond_for_update_delete # # update/delete require the condition to be modified to handle @@ -1019,11 +1429,9 @@ sub _cond_for_update_delete { elsif (ref $full_cond eq 'HASH') { if ((keys %{$full_cond})[0] eq '-and') { $cond->{-and} = []; - my @cond = @{$full_cond->{-and}}; - for (my $i = 0; $i < @cond; $i++) { + for (my $i = 0; $i < @cond; $i++) { my $entry = $cond[$i]; - my $hash; if (ref $entry eq 'HASH') { $hash = $self->_cond_for_update_delete($entry); @@ -1032,7 +1440,6 @@ sub _cond_for_update_delete { $entry =~ /([^.]+)$/; $hash->{$1} = $cond[++$i]; } - push @{$cond->{-and}}, $hash; } } @@ -1044,9 +1451,7 @@ sub _cond_for_update_delete { } } else { - $self->throw_exception( - "Can't update/delete on resultset with condition unless hash or array" - ); + $self->throw_exception("Can't update/delete on resultset with condition unless hash or array"); } return $cond; @@ -1071,14 +1476,10 @@ if no records were updated; exact type of success value is storage-dependent. sub update { my ($self, $values) = @_; - $self->throw_exception("Values for update must be a hash") + $self->throw_exception('Values for update must be a hash') unless ref $values eq 'HASH'; - my $cond = $self->_cond_for_update_delete; - - return $self->result_source->storage->update( - $self->result_source->from, $values, $cond - ); + return $self->_rs_update_delete ('update', $values); } =head2 update_all @@ -1098,7 +1499,7 @@ will run DBIC cascade triggers, while L will not. sub update_all { my ($self, $values) = @_; - $self->throw_exception("Values for update must be a hash") + $self->throw_exception('Values for update_all must be a hash') unless ref $values eq 'HASH'; foreach my $obj ($self->all) { $obj->set_columns($values)->update; @@ -1120,15 +1521,20 @@ Deletes the contents of the resultset from its result source. Note that this will not run DBIC cascade triggers. See L if you need triggers to run. See also L. +delete may not generate correct SQL for a query with joins or a resultset +chained from a related resultset. In this case it will generate a warning:- + +In these cases you may find that delete_all is more appropriate, or you +need to respecify your query in a way that can be expressed without a join. + =cut sub delete { - my ($self) = @_; - - my $cond = $self->_cond_for_update_delete; + my $self = shift; + $self->throw_exception('delete does not accept any arguments') + if @_; - $self->result_source->storage->delete($self->result_source->from, $cond); - return 1; + return $self->_rs_update_delete ('delete'); } =head2 delete_all @@ -1147,89 +1553,370 @@ will run DBIC cascade triggers, while L will not. =cut sub delete_all { - my ($self) = @_; + my $self = shift; + $self->throw_exception('delete_all does not accept any arguments') + if @_; + $_->delete for $self->all; return 1; } -=head2 pager +=head2 populate =over 4 -=item Arguments: none - -=item Return Value: $pager +=item Arguments: \@data; =back -Return Value a L object for the current resultset. Only makes -sense for queries with a C attribute. +Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs. +For the arrayref of hashrefs style each hashref should be a structure suitable +forsubmitting to a $resultset->create(...) method. + +In void context, C in L is used +to insert the data, as this is a faster method. + +Otherwise, each set of data is inserted into the database using +L, and a arrayref of the resulting row +objects is returned. + +Example: Assuming an Artist Class that has many CDs Classes relating: + + my $Artist_rs = $schema->resultset("Artist"); + + ## Void Context Example + $Artist_rs->populate([ + { artistid => 4, name => 'Manufactured Crap', cds => [ + { title => 'My First CD', year => 2006 }, + { title => 'Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + { artistid => 5, name => 'Angsty-Whiny Girl', cds => [ + { title => 'My parents sold me to a record company' ,year => 2005 }, + { title => 'Why Am I So Ugly?', year => 2006 }, + { title => 'I Got Surgery and am now Popular', year => 2007 } + ], + }, + ]); + + ## Array Context Example + my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([ + { name => "Artist One"}, + { name => "Artist Two"}, + { name => "Artist Three", cds=> [ + { title => "First CD", year => 2007}, + { title => "Second CD", year => 2008}, + ]} + ]); + + print $ArtistOne->name; ## response is 'Artist One' + print $ArtistThree->cds->count ## reponse is '2' + +For the arrayref of arrayrefs style, the first element should be a list of the +fieldsnames to which the remaining elements are rows being inserted. For +example: -=cut + $Arstist_rs->populate([ + [qw/artistid name/], + [100, 'A Formally Unknown Singer'], + [101, 'A singer that jumped the shark two albums ago'], + [102, 'An actually cool singer.'], + ]); + +Please note an important effect on your data when choosing between void and +wantarray context. Since void context goes straight to C in +L this will skip any component that is overriding +C. So if you are using something like L to +create primary keys for you, you will find that your PKs are empty. In this +case you will have to use the wantarray context in order to create those +values. -sub pager { - my ($self) = @_; - my $attrs = $self->{attrs}; - $self->throw_exception("Can't create pager for non-paged rs") - unless $self->{attrs}{page}; - $attrs->{rows} ||= 10; - return $self->{pager} ||= Data::Page->new( - $self->_count, $attrs->{rows}, $self->{attrs}{page}); -} +=cut -=head2 page +sub populate { + my $self = shift @_; + my $data = ref $_[0][0] eq 'HASH' + ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) : + $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs'); -=over 4 + if(defined wantarray) { + my @created; + foreach my $item (@$data) { + push(@created, $self->create($item)); + } + return @created; + } else { + my ($first, @rest) = @$data; -=item Arguments: $page_number + my @names = grep {!ref $first->{$_}} keys %$first; + my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; + my @pks = $self->result_source->primary_columns; -=item Return Value: $rs + ## do the belongs_to relationships + foreach my $index (0..$#$data) { + if( grep { !defined $data->[$index]->{$_} } @pks ) { + my @ret = $self->populate($data); + return; + } -=back + foreach my $rel (@rels) { + next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH"; + my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel}); + my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)}; + my $related = $result->result_source->_resolve_condition( + $result->result_source->relationship_info($reverse)->{cond}, + $self, + $result, + ); -Returns a resultset for the $page_number page of the resultset on which page -is called, where each page contains a number of rows equal to the 'rows' -attribute set on the resultset (10 by default). + delete $data->[$index]->{$rel}; + $data->[$index] = {%{$data->[$index]}, %$related}; -=cut + push @names, keys %$related if $index == 0; + } + } -sub page { - my ($self, $page) = @_; - return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page }); -} + ## do bulk insert on current row + my @values = map { [ @$_{@names} ] } @$data; -=head2 new_result + $self->result_source->storage->insert_bulk( + $self->result_source, + \@names, + \@values, + ); -=over 4 + ## do the has_many relationships + foreach my $item (@$data) { -=item Arguments: \%vals + foreach my $rel (@rels) { + next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY"; -=item Return Value: $object + my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) + || $self->throw_exception('Cannot find the relating object.'); -=back + my $child = $parent->$rel; -Creates an object in the resultset's result class and returns it. + my $related = $child->result_source->_resolve_condition( + $parent->result_source->relationship_info($rel)->{cond}, + $child, + $parent, + ); -=cut + my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel}); + my @populate = map { {%$_, %$related} } @rows_to_add; + + $child->populate( \@populate ); + } + } + } +} + +=head2 _normalize_populate_args ($args) + +Private method used by L to normalize its incoming arguments. Factored +out in case you want to subclass and accept new argument structures to the +L method. + +=cut + +sub _normalize_populate_args { + my ($self, $data) = @_; + my @names = @{shift(@$data)}; + my @results_to_create; + foreach my $datum (@$data) { + my %result_to_create; + foreach my $index (0..$#names) { + $result_to_create{$names[$index]} = $$datum[$index]; + } + push @results_to_create, \%result_to_create; + } + return \@results_to_create; +} + +=head2 pager + +=over 4 + +=item Arguments: none + +=item Return Value: $pager + +=back + +Return Value a L object for the current resultset. Only makes +sense for queries with a C attribute. + +To get the full count of entries for a paged resultset, call +C on the L object. + +=cut + +sub pager { + my ($self) = @_; + + return $self->{pager} if $self->{pager}; + + my $attrs = $self->{attrs}; + $self->throw_exception("Can't create pager for non-paged rs") + unless $self->{attrs}{page}; + $attrs->{rows} ||= 10; + + # 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/; + my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count; + + return $self->{pager} = Data::Page->new( + $total_count, + $attrs->{rows}, + $self->{attrs}{page} + ); +} + +=head2 page + +=over 4 + +=item Arguments: $page_number + +=item Return Value: $rs + +=back + +Returns a resultset for the $page_number page of the resultset on which page +is called, where each page contains a number of rows equal to the 'rows' +attribute set on the resultset (10 by default). + +=cut + +sub page { + my ($self, $page) = @_; + return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page }); +} + +=head2 new_result + +=over 4 + +=item Arguments: \%vals + +=item Return Value: $rowobject + +=back + +Creates a new row object in the resultset's result class and returns +it. The row is not inserted into the database at this point, call +L to do that. Calling L +will tell you whether the row object has been inserted or not. + +Passes the hashref of input on to L. + +=cut sub new_result { my ($self, $values) = @_; $self->throw_exception( "new_result needs a hash" ) unless (ref $values eq 'HASH'); - $self->throw_exception( - "Can't abstract implicit construct, condition not a hash" - ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH')); + my %new; my $alias = $self->{attrs}{alias}; - my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {}; - my %new = ( + + if ( + defined $self->{cond} + && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION + ) { + %new = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet + $new{-from_resultset} = [ keys %new ] if keys %new; + } else { + $self->throw_exception( + "Can't abstract implicit construct, condition not a hash" + ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH')); + + my $collapsed_cond = ( + $self->{cond} + ? $self->_collapse_cond($self->{cond}) + : {} + ); + + # precendence must be given to passed values over values inherited from + # the cond, so the order here is important. + my %implied = %{$self->_remove_alias($collapsed_cond, $alias)}; + while( my($col,$value) = each %implied ){ + if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){ + $new{$col} = $value->{'='}; + next; + } + $new{$col} = $value if $self->_is_deterministic_value($value); + } + } + + %new = ( + %new, %{ $self->_remove_alias($values, $alias) }, - %{ $self->_remove_alias($collapsed_cond, $alias) }, + -source_handle => $self->_source_handle, + -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED ); - my $obj = $self->result_class->new(\%new); - $obj->result_source($self->result_source) if $obj->can('result_source'); - return $obj; + return $self->result_class->new(\%new); +} + +# _is_deterministic_value +# +# Make an effor to strip non-deterministic values from the condition, +# to make sure new_result chokes less + +sub _is_deterministic_value { + my $self = shift; + my $value = shift; + my $ref_type = ref $value; + return 1 if $ref_type eq '' || $ref_type eq 'SCALAR'; + return 1 if Scalar::Util::blessed($value); + return 0; +} + +# _has_attr +# +# determines if the resultset defines at least one +# of the attributes supplied +# +# used to determine if a subquery is neccessary + +sub _has_attr { + my ($self, @attr_names) = @_; + + my $attrs = $self->_resolved_attrs; + + my $join_check_req; + + for my $n (@attr_names) { + ++$join_check_req if $n =~ /join/; + + my $attr = $attrs->{$n}; + + next if not defined $attr; + + if (ref $attr eq 'HASH') { + return 1 if keys %$attr; + } + elsif (ref $attr eq 'ARRAY') { + return 1 if @$attr; + } + else { + return 1 if $attr; + } + } + + # a join can be expressed as a multi-level from + return 1 if ( + $join_check_req + and + ref $attrs->{from} eq 'ARRAY' + and + @{$attrs->{from}} > 1 + ); + + return 0; } # _collapse_cond @@ -1244,19 +1931,16 @@ sub _collapse_cond { if (ref $cond eq 'ARRAY') { foreach my $subcond (@$cond) { next unless ref $subcond; # -or -# warn "ARRAY: " . Dumper $subcond; $collapsed = $self->_collapse_cond($subcond, $collapsed); } } elsif (ref $cond eq 'HASH') { if (keys %$cond and (keys %$cond)[0] eq '-and') { foreach my $subcond (@{$cond->{-and}}) { -# warn "HASH: " . Dumper $subcond; $collapsed = $self->_collapse_cond($subcond, $collapsed); } } else { -# warn "LEAF: " . Dumper $cond; foreach my $col (keys %$cond) { my $value = $cond->{$col}; $collapsed->{$col} = $value; @@ -1275,31 +1959,74 @@ sub _collapse_cond { sub _remove_alias { my ($self, $query, $alias) = @_; - my %unaliased = %{ $query || {} }; - foreach my $key (keys %unaliased) { - $unaliased{$1} = delete $unaliased{$key} + my %orig = %{ $query || {} }; + my %unaliased; + + foreach my $key (keys %orig) { + if ($key !~ /\./) { + $unaliased{$key} = $orig{$key}; + next; + } + $unaliased{$1} = $orig{$key} if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/; } return \%unaliased; } +=head2 as_query (EXPERIMENTAL) + +=over 4 + +=item Arguments: none + +=item Return Value: \[ $sql, @bind ] + +=back + +Returns the SQL query and bind vars associated with the invocant. + +This is generally used as the RHS for a subquery. + +B: This feature is still experimental. + +=cut + +sub as_query { return shift->cursor->as_query(@_) } + =head2 find_or_new =over 4 =item Arguments: \%vals, \%attrs? -=item Return Value: $object +=item Return Value: $rowobject =back -Find an existing record from this resultset. If none exists, instantiate a new -result object and return it. The object will not be saved into your storage + my $artist = $schema->resultset('Artist')->find_or_new( + { artist => 'fred' }, { key => 'artists' }); + + $cd->cd_to_producer->find_or_new({ producer => $producer }, + { key => 'primary }); + +Find an existing record from this resultset, based on its primary +key, or a unique constraint. If none exists, instantiate a new result +object and return it. The object will not be saved into your storage until you call L on it. +You most likely want this method when looking for existing rows using +a unique constraint that is not the primary key, or looking for +related rows. + If you want objects to be saved immediately, use L instead. +B: C is probably not what you want when creating a +new row in a table that uses primary keys supplied by the +database. Passing in a primary key column with a value of I +will cause L to attempt to search for a row with a value of +I. + =cut sub find_or_new { @@ -1316,14 +2043,63 @@ sub find_or_new { =item Arguments: \%vals -=item Return Value: $object +=item Return Value: a L $object =back -Inserts a record into the resultset and returns the object representing it. +Attempt to create a single new row or a row with multiple related rows +in the table represented by the resultset (and related tables). This +will not check for duplicate rows before inserting, use +L to do that. + +To create one row for this resultset, pass a hashref of key/value +pairs representing the columns of the table and the values you wish to +store. If the appropriate relationships are set up, foreign key fields +can also be passed an object representing the foreign row, and the +value will be set to its primary key. + +To create related objects, pass a hashref for the value if the related +item is a foreign key relationship (L), +and use the name of the relationship as the key. (NOT the name of the field, +necessarily). For C and C relationships, pass an arrayref +of hashrefs containing the data for each of the rows to create in the foreign +tables, again using the relationship name as the key. + +Instead of hashrefs of plain related data (key/value pairs), you may +also pass new or inserted objects. New objects (not inserted yet, see +L), will be inserted into their appropriate tables. Effectively a shortcut for C<< ->new_result(\%vals)->insert >>. +Example of creating a new row. + + $person_rs->create({ + name=>"Some Person", + email=>"somebody@someplace.com" + }); + +Example of creating a new row and also creating rows in a related C +or C resultset. Note Arrayref. + + $artist_rs->create( + { artistid => 4, name => 'Manufactured Crap', cds => [ + { title => 'My First CD', year => 2006 }, + { title => 'Yet More Tweeny-Pop crap', year => 2007 }, + ], + }, + ); + +Example of creating a new row and also creating a row in a related +Cresultset. Note Hashref. + + $cd_rs->create({ + title=>"Music for Silly Walks", + year=>2000, + artist => { + name=>"Silly Musician", + } + }); + =cut sub create { @@ -1339,13 +2115,14 @@ sub create { =item Arguments: \%vals, \%attrs? -=item Return Value: $object +=item Return Value: $rowobject =back - $class->find_or_create({ key => $val, ... }); + $cd->cd_to_producer->find_or_create({ producer => $producer }, + { key => 'primary }); -Tries to find a record based on its primary key or unique constraint; if none +Tries to find a record based on its primary key or unique constraints; if none is found, creates one and returns that instead. my $cd = $schema->resultset('CD')->find_or_create({ @@ -1366,6 +2143,18 @@ constraint. For example: { key => 'cd_artist_title' } ); +B: Because find_or_create() reads from the database and then +possibly inserts based on the result, this method is subject to a race +condition. Another process could create a record in the table after +the find has completed and before the create has started. To avoid +this problem, use find_or_create() inside a transaction. + +B: C is probably not what you want when creating +a new row in a table that uses primary keys supplied by the +database. Passing in a primary key column with a value of I +will cause L to attempt to search for a row with a value of +I. + See also L and L. For information on how to declare unique constraints, see L. @@ -1385,11 +2174,11 @@ sub find_or_create { =item Arguments: \%col_values, { key => $unique_constraint }? -=item Return Value: $object +=item Return Value: $rowobject =back - $class->update_or_create({ col => $val, ... }); + $resultset->update_or_create({ col => $val, ... }); First, searches for an existing row matching one of the unique constraints (including the primary key) on the source of this resultset. If a row is @@ -1409,6 +2198,14 @@ For example: { key => 'cd_artist_title' } ); + $cd->cd_to_producer->update_or_create({ + producer => $producer, + name => 'harry', + }, { + key => 'primary, + }); + + If no C is specified, it searches on all unique constraints defined on the source, including the primary key. @@ -1417,6 +2214,12 @@ If the C is specified as C, it searches only on the primary key. See also L and L. For information on how to declare unique constraints, see L. +B: C is probably not what you want when +looking for a row in a table that uses primary keys supplied by the +database, unless you actually have a key value. Passing in a primary +key column with a value of I will cause L to attempt to +search for a row with a value of I. + =cut sub update_or_create { @@ -1433,6 +2236,63 @@ sub update_or_create { return $self->create($cond); } +=head2 update_or_new + +=over 4 + +=item Arguments: \%col_values, { key => $unique_constraint }? + +=item Return Value: $rowobject + +=back + + $resultset->update_or_new({ col => $val, ... }); + +First, searches for an existing row matching one of the unique constraints +(including the primary key) on the source of this resultset. If a row is +found, updates it with the other given column values. Otherwise, instantiate +a new result object and return it. The object will not be saved into your storage +until you call L on it. + +Takes an optional C attribute to search on a specific unique constraint. +For example: + + # In your application + my $cd = $schema->resultset('CD')->update_or_new( + { + artist => 'Massive Attack', + title => 'Mezzanine', + year => 1998, + }, + { key => 'cd_artist_title' } + ); + + if ($cd->in_storage) { + # the cd was updated + } + else { + # the cd is not yet in the database, let's insert it + $cd->insert; + } + +See also L, L and L. + +=cut + +sub update_or_new { + my $self = shift; + my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} ); + my $cond = ref $_[0] eq 'HASH' ? shift : {@_}; + + my $row = $self->find( $cond, $attrs ); + if ( defined $row ) { + $row->update($cond); + return $row; + } + + return $self->new_result($cond); +} + =head2 get_cache =over 4 @@ -1445,6 +2305,9 @@ sub update_or_create { Gets the contents of the cache for the resultset, if the cache is set. +The cache is populated either by using the L attribute to +L or by calling L. + =cut sub get_cache { @@ -1466,6 +2329,9 @@ of objects of the same class as those produced by the resultset. Note that if the cache is set the resultset will return the cached objects rather than re-querying the database even if the cache attr is not set. +The contents of the cache can also be populated by using the +L attribute to L. + =cut sub set_cache { @@ -1517,186 +2383,411 @@ sub related_resultset { my $rel_obj = $self->result_source->relationship_info($rel); $self->throw_exception( - "search_related: result source '" . $self->result_source->name . + "search_related: result source '" . $self->result_source->source_name . "' has no such relationship $rel") unless $rel_obj; - + my ($from,$seen) = $self->_resolve_from($rel); my $join_count = $seen->{$rel}; my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); - $self->result_source->schema->resultset($rel_obj->{class})->search_rs( - undef, { - %{$self->{attrs}||{}}, - join => undef, - prefetch => undef, - select => undef, - as => undef, - alias => $alias, - where => $self->{cond}, - seen_join => $seen, - from => $from, - }); + #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi + my %attrs = %{$self->{attrs}||{}}; + 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 = $self->result_source->related_source($rel); + + my $new = do { + + # The reason we do this now instead of passing the alias to the + # search_rs below is that if you wrap/overload resultset on the + # source you need to know what alias it's -going- to have for things + # to work sanely (e.g. RestrictWithObject wants to be able to add + # extra query restrictions, and these may need to be $alias.) + + my $attrs = $rel_source->resultset_attributes; + local $attrs->{alias} = $alias; + + $rel_source->resultset + ->search_rs( + undef, { + %attrs, + join => undef, + prefetch => undef, + select => undef, + as => undef, + where => $self->{cond}, + seen_join => $seen, + from => $from, + }); + }; + $new->set_cache($new_cache) if $new_cache; + $new; }; } +=head2 current_source_alias + +=over 4 + +=item Arguments: none + +=item Return Value: $source_alias + +=back + +Returns the current table alias for the result source this resultset is built +on, that will be used in the SQL query. Usually it is C. + +Currently the source alias that refers to the result set returned by a +L/L family method depends on how you got to the resultset: it's +C by default, but eg. L aliases it to the related result +source name (and keeps C referring to the original result set). The long +term goal is to make L always alias the current resultset as C +(and make this method unnecessary). + +Thus it's currently necessary to use this method in predefined queries (see +L) when referring to the +source alias of the current result set: + + # in a result set class + sub modified_by { + my ($self, $user) = @_; + + my $me = $self->current_source_alias; + + return $self->search( + "$me.modified" => $user->id, + ); + } + +=cut + +sub current_source_alias { + my ($self) = @_; + + return ($self->{attrs} || {})->{alias} || 'me'; +} + +# This code is called by search_related, and makes sure there +# is clear separation between the joins before, during, and +# after the relationship. This information is needed later +# in order to properly resolve prefetch aliases (any alias +# with a relation_chain_depth less than the depth of the +# current prefetch is not considered) sub _resolve_from { my ($self, $extra_join) = @_; my $source = $self->result_source; my $attrs = $self->{attrs}; - + my $from = $attrs->{from} || [ { $attrs->{alias} => $source->from } ]; - + my $seen = { %{$attrs->{seen_join}||{}} }; - my $join = ($attrs->{join} - ? [ $attrs->{join}, $extra_join ] - : $extra_join); - $from = [ - @$from, - ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()), - ]; + # we need to take the prefetch the attrs into account before we + # ->_resolve_join as otherwise they get lost - captainL + my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); + + push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged); + + ++$seen->{-relation_chain_depth}; + + push @$from, $source->_resolve_join($extra_join, $attrs->{alias}, $seen); + + ++$seen->{-relation_chain_depth}; return ($from,$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}; - my $attrs = { %{$self->{attrs}||{}} }; - my $source = $self->{result_source}; - my $alias = $attrs->{alias}; + my $attrs = { %{ $self->{attrs} || {} } }; + my $source = $self->result_source; + my $alias = $attrs->{alias}; $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols}; - if ($attrs->{columns}) { - delete $attrs->{as}; - } elsif (!$attrs->{select}) { - $attrs->{columns} = [ $source->columns ]; - } - - $attrs->{select} = - ($attrs->{select} - ? (ref $attrs->{select} eq 'ARRAY' - ? [ @{$attrs->{select}} ] - : [ $attrs->{select} ]) - : [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ] - ); - $attrs->{as} = - ($attrs->{as} - ? (ref $attrs->{as} eq 'ARRAY' - ? [ @{$attrs->{as}} ] - : [ $attrs->{as} ]) - : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ] + my @colbits; + + # build columns (as long as select isn't set) into a set of as/select hashes + unless ( $attrs->{select} ) { + @colbits = map { + ( ref($_) eq 'HASH' ) + ? $_ + : { + ( + /^\Q${alias}.\E(.+)$/ + ? "$1" + : "$_" + ) + => + ( + /\./ + ? "$_" + : "${alias}.$_" + ) + } + } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns ); + } + # add the additional columns on + foreach ( 'include_columns', '+columns' ) { + push @colbits, map { + ( ref($_) eq 'HASH' ) + ? $_ + : { ( split( /\./, $_ ) )[-1] => ( /\./ ? $_ : "${alias}.$_" ) } + } ( ref($attrs->{$_}) eq 'ARRAY' ) ? @{ delete $attrs->{$_} } : delete $attrs->{$_} if ( $attrs->{$_} ); + } + + # start with initial select items + if ( $attrs->{select} ) { + $attrs->{select} = + ( ref $attrs->{select} eq 'ARRAY' ) + ? [ @{ $attrs->{select} } ] + : [ $attrs->{select} ]; + $attrs->{as} = ( + $attrs->{as} + ? ( + ref $attrs->{as} eq 'ARRAY' + ? [ @{ $attrs->{as} } ] + : [ $attrs->{as} ] + ) + : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{ $attrs->{select} } ] ); - - my $adds; - if ($adds = delete $attrs->{include_columns}) { - $adds = [$adds] unless ref $adds eq 'ARRAY'; - push(@{$attrs->{select}}, @$adds); - push(@{$attrs->{as}}, map { m/([^.]+)$/; $1 } @$adds); } - if ($adds = delete $attrs->{'+select'}) { + else { + + # otherwise we intialise select & as to empty + $attrs->{select} = []; + $attrs->{as} = []; + } + + # now add colbits to select/as + push( @{ $attrs->{select} }, map { values( %{$_} ) } @colbits ); + push( @{ $attrs->{as} }, map { keys( %{$_} ) } @colbits ); + + my $adds; + if ( $adds = delete $attrs->{'+select'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push(@{$attrs->{select}}, - map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds); + push( + @{ $attrs->{select} }, + map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds + ); } - if (my $adds = delete $attrs->{'+as'}) { + if ( $adds = delete $attrs->{'+as'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push(@{$attrs->{as}}, @$adds); + push( @{ $attrs->{as} }, @$adds ); } - $attrs->{from} ||= [ { 'me' => $source->from } ]; + $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ]; - if (exists $attrs->{join} || exists $attrs->{prefetch}) { + if ( exists $attrs->{join} || exists $attrs->{prefetch} ) { my $join = delete $attrs->{join} || {}; - if (defined $attrs->{prefetch}) { - $join = $self->_merge_attr( - $join, $attrs->{prefetch} - ); + if ( defined $attrs->{prefetch} ) { + $join = $self->_merge_attr( $join, $attrs->{prefetch} ); + } - $attrs->{from} = # have to copy here to avoid corrupting the original + $attrs->{from} = # have to copy here to avoid corrupting the original [ - @{$attrs->{from}}, - $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} }) + @{ $attrs->{from} }, + $source->_resolve_join( + $join, $alias, { %{ $attrs->{seen_join} || {} } } + ) ]; + } - $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct}; - if ($attrs->{order_by}) { - $attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY' - ? [ @{$attrs->{order_by}} ] - : [ $attrs->{order_by} ]); - } else { - $attrs->{order_by} = []; + if ( $attrs->{order_by} ) { + $attrs->{order_by} = ( + ref( $attrs->{order_by} ) eq 'ARRAY' + ? [ @{ $attrs->{order_by} } ] + : [ $attrs->{order_by} ] + ); + } + else { + $attrs->{order_by} = []; } my $collapse = $attrs->{collapse} || {}; - if (my $prefetch = delete $attrs->{prefetch}) { - $prefetch = $self->_merge_attr({}, $prefetch); + if ( my $prefetch = delete $attrs->{prefetch} ) { + $prefetch = $self->_merge_attr( {}, $prefetch ); my @pre_order; - my $seen = $attrs->{seen_join} || {}; - foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) { + foreach my $p ( ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch) ) { + # bring joins back to level of current class - my @prefetch = $source->resolve_prefetch( - $p, $alias, $seen, \@pre_order, $collapse - ); - push(@{$attrs->{select}}, map { $_->[0] } @prefetch); - push(@{$attrs->{as}}, map { $_->[1] } @prefetch); + my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join}); + my @prefetch = + $source->_resolve_prefetch( $p, $alias, $join_map, \@pre_order, $collapse ); + push( @{ $attrs->{select} }, map { $_->[0] } @prefetch ); + push( @{ $attrs->{as} }, map { $_->[1] } @prefetch ); } - push(@{$attrs->{order_by}}, @pre_order); + push( @{ $attrs->{order_by} }, @pre_order ); } + + if (delete $attrs->{distinct}) { + $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; + } + $attrs->{collapse} = $collapse; + if ( $attrs->{page} and not defined $attrs->{offset} ) { + $attrs->{offset} = ( $attrs->{rows} * ( $attrs->{page} - 1 ) ); + } + return $self->{_attrs} = $attrs; } -sub _merge_attr { +sub _joinpath_aliases { + my ($self, $fromspec, $seen) = @_; + + my $paths = {}; + return $paths unless ref $fromspec eq 'ARRAY'; + + for my $j (@$fromspec) { + + next if ref $j ne 'ARRAY'; + next if $j->[0]{-relation_chain_depth} < ( $seen->{-relation_chain_depth} || 0); + + my $p = $paths; + $p = $p->{$_} ||= {} for @{$j->[0]{-join_path}}; + push @{$p->{-join_aliases} }, $j->[0]{-join_alias}; + } + + return $paths; +} + +sub _rollout_attr { + my ($self, $attr) = @_; + + if (ref $attr eq 'HASH') { + return $self->_rollout_hash($attr); + } elsif (ref $attr eq 'ARRAY') { + return $self->_rollout_array($attr); + } else { + return [$attr]; + } +} + +sub _rollout_array { + my ($self, $attr) = @_; + + my @rolled_array; + foreach my $element (@{$attr}) { + if (ref $element eq 'HASH') { + push( @rolled_array, @{ $self->_rollout_hash( $element ) } ); + } elsif (ref $element eq 'ARRAY') { + # XXX - should probably recurse here + push( @rolled_array, @{$self->_rollout_array($element)} ); + } else { + push( @rolled_array, $element ); + } + } + return \@rolled_array; +} + +sub _rollout_hash { + my ($self, $attr) = @_; + + my @rolled_array; + foreach my $key (keys %{$attr}) { + push( @rolled_array, { $key => $attr->{$key} } ); + } + return \@rolled_array; +} + +sub _calculate_score { my ($self, $a, $b) = @_; - return $b unless defined($a); - return $a unless defined($b); - - if (ref $b eq 'HASH' && ref $a eq 'HASH') { - foreach my $key (keys %{$b}) { - if (exists $a->{$key}) { - $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}); + + if (ref $b eq 'HASH') { + my ($b_key) = keys %{$b}; + if (ref $a eq 'HASH') { + my ($a_key) = keys %{$a}; + if ($a_key eq $b_key) { + return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} )); } else { - $a->{$key} = $b->{$key}; + return 0; } + } else { + return ($a eq $b_key) ? 1 : 0; } - return $a; } else { - $a = [$a] unless ref $a eq 'ARRAY'; - $b = [$b] unless ref $b eq 'ARRAY'; - - my $hash = {}; - my @array; - foreach my $x ($a, $b) { - foreach my $element (@{$x}) { - if (ref $element eq 'HASH') { - $hash = $self->_merge_attr($hash, $element); - } elsif (ref $element eq 'ARRAY') { - push(@array, @{$element}); - } else { - push(@array, $element) unless $b == $x - && grep { $_ eq $element } @array; - } + if (ref $a eq 'HASH') { + my ($a_key) = keys %{$a}; + return ($b eq $a_key) ? 1 : 0; + } else { + return ($b eq $a) ? 1 : 0; + } + } +} + +sub _merge_attr { + my ($self, $orig, $import) = @_; + + return $import unless defined($orig); + return $orig unless defined($import); + + $orig = $self->_rollout_attr($orig); + $import = $self->_rollout_attr($import); + + my $seen_keys; + foreach my $import_element ( @{$import} ) { + # find best candidate from $orig to merge $b_element into + my $best_candidate = { position => undef, score => 0 }; my $position = 0; + foreach my $orig_element ( @{$orig} ) { + my $score = $self->_calculate_score( $orig_element, $import_element ); + if ($score > $best_candidate->{score}) { + $best_candidate->{position} = $position; + $best_candidate->{score} = $score; } + $position++; } - - @array = grep { !exists $hash->{$_} } @array; + my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element); - return keys %{$hash} - ? ( scalar(@array) - ? [$hash, @array] - : $hash - ) - : \@array; + if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) { + push( @{$orig}, $import_element ); + } else { + my $orig_best = $orig->[$best_candidate->{position}]; + # merge orig_best and b_element together and replace original with merged + if (ref $orig_best ne 'HASH') { + $orig->[$best_candidate->{position}] = $import_element; + } elsif (ref $import_element eq 'HASH') { + my ($key) = keys %{$orig_best}; + $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) }; + } + } + $seen_keys->{$import_key} = 1; # don't merge the same key twice } + + return $orig; +} + +sub result_source { + my $self = shift; + + if (@_) { + $self->_source_handle($_[0]->handle); + } else { + $self->_source_handle->resolve; + } } =head2 throw_exception @@ -1707,32 +2798,49 @@ See L for details. sub throw_exception { my $self=shift; - $self->result_source->schema->throw_exception(@_); + if (ref $self && $self->_source_handle->schema) { + $self->_source_handle->schema->throw_exception(@_) + } else { + croak(@_); + } + } # XXX: FIXME: Attributes docs need clearing up =head1 ATTRIBUTES -The resultset takes various attributes that modify its behavior. Here's an -overview of them: +Attributes are used to refine a ResultSet in various ways when +searching for data. They can be passed to any method which takes an +C<\%attrs> argument. See L, L, L, +L. + +These are in no particular order: =head2 order_by =over 4 -=item Value: ($order_by | \@order_by) +=item Value: ( $order_by | \@order_by | \%order_by ) =back -Which column(s) to order the results by. This is currently passed -through directly to SQL, so you can give e.g. C for a -descending order on the column `year'. +Which column(s) to order the results by. If a single column name, or +an arrayref of names is supplied, the argument is passed through +directly to SQL. The hashref syntax allows for connection-agnostic +specification of ordering direction: + + For descending order: + + order_by => { -desc => [qw/col1 col2 col3/] } + + For explicit ascending order: + + order_by => { -asc => 'col' } -Please note that if you have C enabled (see -L) you will need to do C<\'year DESC' > to -specify an order. (The scalar ref causes it to be passed as raw sql to the DB, -so you will need to manually quote things as appropriate.) +The old scalarref syntax (i.e. order_by => \'year DESC') is still +supported, although you are strongly encouraged to use the hashref +syntax as outlined above. =head2 columns @@ -1742,12 +2850,15 @@ so you will need to manually quote things as appropriate.) =back -Shortcut to request a particular set of columns to be retrieved. Adds -C onto the start of any column without a C<.> in it and sets C as normal. (You may also -use the C attribute, as in earlier versions of DBIC.) +Shortcut to request a particular set of columns to be retrieved. Each +column spec may be a string (a table column name), or a hash (in which +case the key is the C value, and the value is used as the C from that, then auto-populates C from +C but adds columns to the selection. +L but adds columns to the selection. =back @@ -1802,7 +2928,7 @@ L, usually when C. + +The C attribute is used in conjunction with C contains one or more function or stored procedure names: $rs = $schema->resultset('Employee')->search(undef, { @@ -1889,19 +3020,19 @@ For example: } ); -You need to use the relationship (not the table) name in conditions, -because they are aliased as such. The current table is aliased as "me", so +You need to use the relationship (not the table) name in conditions, +because they are aliased as such. The current table is aliased as "me", so you need to use me.column_name in order to avoid ambiguity. For example: - # Get CDs from 1984 with a 'Foo' track + # Get CDs from 1984 with a 'Foo' track my $rs = $schema->resultset('CD')->search( - { + { 'me.year' => 1984, 'tracks.name' => 'Foo' }, { join => 'tracks' } ); - + If the same join is supplied twice, it will be aliased to _2 (and similarly for a third time). For e.g. @@ -1918,6 +3049,8 @@ to Earth' and a cd with title 'Popular'. If you want to fetch related objects from other tables as well, see C below. +For more help on using joins with search, see L. + =head2 prefetch =over 4 @@ -1926,10 +3059,11 @@ below. =back -Contains one or more relationships that should be fetched along with the main -query (when they are accessed afterwards they will have already been -"prefetched"). This is useful for when you know you will need the related -objects, because it saves at least one query: +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, @@ -1951,13 +3085,27 @@ 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. If you're prefetching to -depth (e.g. { cd => { artist => 'label' } or similar), you'll need to -specify the join as well. +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'). +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 associted +with that artist is given below (assuming many-to-many from artists to tags): + + my $rs = $schema->resultset('Artist')->search( + undef, + { + prefetch => [ + { cds => 'tracks' }, + { artist_tags => 'tags' } + ] + } + ); + + +B If you specify a C attribute, the C and C