X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=49d615fecfccd6cadcaa174a7b03db224cc70e9c;hb=e21c87692fb3f5fccbd44facecc191554bc821d5;hp=0289c0ffc5a33cbb15283a6323474bdb8957d4c2;hpb=fed966517e558cfc9ee505d44add2d04e77a7d3d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 0289c0f..49d615f 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -196,45 +196,66 @@ call it as C. sub search { my $self = shift; + my $rs = $self->search_rs( @_ ); + return (wantarray ? $rs->all : $rs); +} - my $rs; - if( @_ ) { - - my $attrs = { %{$self->{attrs}} }; - my $having = delete $attrs->{having}; - $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH'; - - my $where = (@_ - ? ((@_ == 1 || ref $_[0] eq "HASH") - ? shift - : ((@_ % 2) - ? $self->throw_exception( - "Odd number of arguments to search") - : {@_})) - : undef()); - if (defined $where) { - $attrs->{where} = (defined $attrs->{where} - ? { '-and' => - [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } - $where, $attrs->{where} ] } - : $where); - } +=head2 search_rs - if (defined $having) { - $attrs->{having} = (defined $attrs->{having} - ? { '-and' => - [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } - $having, $attrs->{having} ] } - : $having); - } +=over 4 + +=item Arguments: $cond, \%attrs? + +=item Return Value: $resultset + +=back + +This method does the same exact thing as search() except it will +always return a resultset, even in list context. + +=cut + +sub search_rs { + my $self = shift; - $rs = (ref $self)->new($self->result_source, $attrs); + my $attrs = { %{$self->{attrs}} }; + my $having = delete $attrs->{having}; + $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH'; + + my $where = (@_ + ? ((@_ == 1 || ref $_[0] eq "HASH") + ? shift + : ((@_ % 2) + ? $self->throw_exception( + "Odd number of arguments to search") + : {@_})) + : undef()); + if (defined $where) { + $attrs->{where} = (defined $attrs->{where} + ? { '-and' => + [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + $where, $attrs->{where} ] } + : $where); } - else { - $rs = $self; - $rs->reset; + + if (defined $having) { + $attrs->{having} = (defined $attrs->{having} + ? { '-and' => + [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + $having, $attrs->{having} ] } + : $having); } - return (wantarray ? $rs->all : $rs); + + my $rs = (ref $self)->new($self->result_source, $attrs); + + unless (@_) { # no search, effectively just a clone + my $rows = $self->get_cache; + if ($rows) { + $rs->set_cache($rows); + } + } + + return $rs; } =head2 search_literal @@ -272,12 +293,17 @@ sub search_literal { =back -Finds a row based on its primary key or unique constraint. For example: +Finds a row based on its primary key or unique constraint. For example, to find +a row by its primary key: my $cd = $schema->resultset('CD')->find(5); -Also takes an optional C attribute, to search by a specific key or unique -constraint. For example: +You can also find a row by a specific unique constraint using the C +attribute. For example: + + my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' }); + +Additionally, you can specify the columns explicitly by name: my $cd = $schema->resultset('CD')->find( { @@ -287,49 +313,94 @@ constraint. For example: { key => 'artist_title' } ); -See also L and L. +If no C is specified and you explicitly name columns, it searches on all +unique constraints defined on the source, including the primary key. + +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. =cut sub find { - my ($self, @vals) = @_; - my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {}); + my $self = shift; + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); - my @cols = $self->result_source->primary_columns; - if (exists $attrs->{key}) { - my %uniq = $self->result_source->unique_constraints; + # Parse out a hash from input + my @cols = exists $attrs->{key} + ? $self->result_source->unique_constraint_columns($attrs->{key}) + : $self->result_source->primary_columns; + + my $hash; + if (ref $_[0] eq 'HASH') { + $hash = { %{$_[0]} }; + } + elsif (@_ == @cols) { + $hash = {}; + @{$hash}{@cols} = @_; + } + elsif (@_) { + # For backwards compatibility + $hash = {@_}; + } + else { $self->throw_exception( - "Unknown key $attrs->{key} on '" . $self->result_source->name . "'" - ) unless exists $uniq{$attrs->{key}}; - @cols = @{ $uniq{$attrs->{key}} }; + "Arguments to find must be a hashref or match the number of columns in the " + . (exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key") + ); } - #use Data::Dumper; warn Dumper($attrs, @vals, @cols); + + # Check the hash we just parsed against our source's unique constraints + my @constraint_names = exists $attrs->{key} + ? ($attrs->{key}) + : $self->result_source->unique_constraint_names; $self->throw_exception( "Can't find unless a primary key or unique constraint is defined" - ) unless @cols; - - my $query; - if (ref $vals[0] eq 'HASH') { - $query = { %{$vals[0]} }; - } elsif (@cols == @vals) { - $query = {}; - @{$query}{@cols} = @vals; - } else { - $query = {@vals}; - } - foreach my $key (grep { ! m/\./ } keys %$query) { - $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key}; + ) unless @constraint_names; + + 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($hash, \@unique_cols); + + # Add the ResultSet's alias + foreach my $key (grep { ! m/\./ } keys %$unique_query) { + $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key}; + } + + push @unique_queries, $unique_query if %$unique_query; } - #warn Dumper($query); - + + # Handle cases where the ResultSet already defines the query + my $query = @unique_queries ? \@unique_queries : undef; + + # Run the query if (keys %$attrs) { - my $rs = $self->search($query,$attrs); - return keys %{$rs->{collapse}} ? $rs->next : $rs->single; - } else { - return keys %{$self->{collapse}} ? - $self->search($query)->next : - $self->single($query); + my $rs = $self->search($query, $attrs); + return keys %{$rs->{collapse}} ? $rs->next : $rs->single; } + else { + return keys %{$self->{collapse}} + ? $self->search($query)->next + : $self->single($query); + } +} + +# _build_unique_query +# +# Constrain the specified query hash based on the specified column names. + +sub _build_unique_query { + my ($self, $query, $unique_cols) = @_; + + my %unique_query = + map { $_ => $query->{$_} } + grep { exists $query->{$_} } + @$unique_cols; + + return \%unique_query; } =head2 search_related @@ -391,7 +462,11 @@ 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 find() as an optimisation. +any records in it; if not returns nothing. Used by L as an optimisation. + +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. =cut @@ -523,9 +598,9 @@ first record from the resultset. sub next { my ($self) = @_; - if (@{$self->{all_cache} || []}) { + if (my $cache = $self->get_cache) { $self->{all_cache_position} ||= 0; - return $self->{all_cache}->[$self->{all_cache_position}++]; + return $cache->[$self->{all_cache_position}++]; } if ($self->{attrs}{cache}) { $self->{all_cache_position} = 1; @@ -615,9 +690,9 @@ sub _collapse_result { last unless (@raw = $self->cursor->next); $row = $self->{stashed_row} = \@raw; $tree = $self->_collapse_result($as, $row, $c_prefix); - #warn Data::Dumper::Dumper($tree, $row); } - @$target = @final; + @$target = (@final ? @final : [ {}, {} ]); + # single empty result to indicate an empty prefetched has_many } return $info; @@ -664,7 +739,7 @@ clause. sub count { my $self = shift; return $self->search(@_)->count if @_ and defined $_[0]; - return scalar @{ $self->get_cache } if @{ $self->get_cache }; + return scalar @{ $self->get_cache } if $self->get_cache; my $count = $self->_count; return 0 unless $count; @@ -741,7 +816,7 @@ is returned in list context. sub all { my ($self) = @_; - return @{ $self->get_cache } if @{ $self->get_cache }; + return @{ $self->get_cache } if $self->get_cache; my @obj; @@ -810,14 +885,14 @@ sub first { # # update/delete require the condition to be modified to handle # the differing SQL syntax available. This transforms the $self->{cond} -# appropriately, returning the new condition +# appropriately, returning the new condition. sub _cond_for_update_delete { my ($self) = @_; my $cond = {}; if (!ref($self->{cond})) { - # No-op. No condition, we're update/deleting everything + # No-op. No condition, we're updating/deleting everything } elsif (ref $self->{cond} eq 'ARRAY') { $cond = [ @@ -828,21 +903,31 @@ sub _cond_for_update_delete { $hash{$1} = $_->{$key}; } \%hash; - } @{$self->{cond}} + } @{$self->{cond}} ]; } elsif (ref $self->{cond} eq 'HASH') { if ((keys %{$self->{cond}})[0] eq '-and') { - $cond->{-and} = [ - map { - my %hash; - foreach my $key (keys %{$_}) { + $cond->{-and} = []; + + my @cond = @{$self->{cond}{-and}}; + for (my $i = 0; $i < @cond - 1; $i++) { + my $entry = $cond[$i]; + + my %hash; + if (ref $entry eq 'HASH') { + foreach my $key (keys %{$entry}) { $key =~ /([^.]+)$/; - $hash{$1} = $_->{$key}; + $hash{$1} = $entry->{$key}; } - \%hash; - } @{$self->{cond}{-and}} - ]; + } + else { + $entry =~ /([^.]+)$/; + $hash{$entry} = $cond[++$i]; + } + + push @{$cond->{-and}}, \%hash; + } } else { foreach my $key (keys %{$self->{cond}}) { @@ -853,8 +938,10 @@ sub _cond_for_update_delete { } else { $self->throw_exception( - "Can't update/delete on resultset with condition unless hash or array"); + "Can't update/delete on resultset with condition unless hash or array" + ); } + return $cond; } @@ -1038,6 +1125,32 @@ sub new_result { return $obj; } +=head2 find_or_new + +=over 4 + +=item Arguments: \%vals, \%attrs? + +=item Return Value: $object + +=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 +until you call L on it. + +If you want objects to be saved immediately, use L instead. + +=cut + +sub find_or_new { + my $self = shift; + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; + my $exists = $self->find($hash, $attrs); + return defined $exists ? $exists : $self->new_result($hash); +} + =head2 create =over 4 @@ -1094,7 +1207,8 @@ constraint. For example: { key => 'artist_title' } ); -See also L and L. +See also L and L. For information on how to declare +unique constraints, see L. =cut @@ -1141,7 +1255,8 @@ source, including the primary key. If the C is specified as C, it searches only on the primary key. -See also L and L. +See also L and L. For information on how to declare +unique constraints, see L. =cut @@ -1150,30 +1265,10 @@ sub update_or_create { my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; - my %unique_constraints = $self->result_source->unique_constraints; - my @constraint_names = (exists $attrs->{key} - ? ($attrs->{key}) - : keys %unique_constraints); - - my @unique_hashes; - foreach my $name (@constraint_names) { - my @unique_cols = @{ $unique_constraints{$name} }; - my %unique_hash = - map { $_ => $hash->{$_} } - grep { exists $hash->{$_} } - @unique_cols; - - push @unique_hashes, \%unique_hash - if (scalar keys %unique_hash == scalar @unique_cols); - } - - if (@unique_hashes) { - my $row = $self->single(\@unique_hashes); - if (defined $row) { - $row->set_columns($hash); - $row->update; - return $row; - } + my $row = $self->find($hash, $attrs); + if (defined $row) { + $row->update($hash); + return $row; } return $self->create($hash); @@ -1194,7 +1289,7 @@ Gets the contents of the cache for the resultset, if the cache is set. =cut sub get_cache { - shift->{all_cache} || []; + shift->{all_cache}; } =head2 set_cache @@ -1217,13 +1312,7 @@ than re-querying the database even if the cache attr is not set. sub set_cache { my ( $self, $data ) = @_; $self->throw_exception("set_cache requires an arrayref") - if ref $data ne 'ARRAY'; - my $result_class = $self->result_class; - foreach( @$data ) { - $self->throw_exception( - "cannot cache object of type '$_', expected '$result_class'" - ) if ref $_ ne $result_class; - } + if defined($data) && (ref $data ne 'ARRAY'); $self->{all_cache} = $data; } @@ -1242,7 +1331,7 @@ Clears the cache for the resultset. =cut sub clear_cache { - shift->set_cache([]); + shift->set_cache(undef); } =head2 related_resultset @@ -1409,6 +1498,10 @@ use C instead: You can create your own accessors if required - see L for details. +Please note: This will NOT insert an C into the SQL statement +produced, it is used for internal access only. Thus attempting to use the accessor +in an C clause or similar will fail misrably. + =head2 join =over 4 @@ -1503,6 +1596,83 @@ 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'). +=head2 page + +=over 4 + +=item Value: $page + +=back + +Makes the resultset paged and specifies the page to retrieve. Effectively +identical to creating a non-pages resultset and then calling ->page($page) +on it. + +=head2 rows + +=over 4 + +=item Value: $rows + +=back + +Specifes the maximum number of rows for direct retrieval or the number of +rows per page if the page attribute or method is used. + +=head2 group_by + +=over 4 + +=item Value: \@columns + +=back + +A arrayref of columns to group by. Can include columns of joined tables. + + group_by => [qw/ column1 column2 ... /] + +=head2 having + +=over 4 + +=item Value: $condition + +=back + +HAVING is a select statement attribute that is applied between GROUP BY and +ORDER BY. It is applied to the after the grouping calculations have been +done. + + having => { 'count(employee)' => { '>=', 100 } } + +=head2 distinct + +=over 4 + +=item Value: (0 | 1) + +=back + +Set to 1 to group by all columns. + +=head2 cache + +Set to 1 to cache search results. This prevents extra SQL queries if you +revisit rows in your ResultSet: + + my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } ); + + while( my $artist = $resultset->next ) { + ... do stuff ... + } + + $rs->first; # without cache, this would issue a query + +By default, searches are not cached. + +For more examples of using these attributes, see +L. + =head2 from =over 4 @@ -1516,21 +1686,35 @@ statements generated by L, allowing you to express custom C clauses. NOTE: Use this on your own risk. This allows you to shoot off your foot! + C will usually do what you need and it is strongly recommended that you avoid using C unless you cannot achieve the desired result using C. +And we really do mean "cannot", not just tried and failed. Attempting to use +this because you're having problems with C is like trying to use x86 +ASM because you've got a syntax error in your C. Trust us on this. + +Now, if you're still really, really sure you need to use this (and if you're +not 100% sure, ask the mailing list first), here's an explanation of how this +works. -In simple terms, C works as follows: +The syntax is as follows - + [ + { => }, [ - { => , -join_type => 'inner|left|right' } - [] # nested JOIN (optional) - { => } - ] + { => , -join_type => 'inner|left|right' }, + [], # nested JOIN (optional) + { => , ... (more conditions) }, + ], + # More of the above [ ] may follow for additional joins + ] - JOIN -
- [JOIN ...] - ON = + + JOIN + + [JOIN ...] + ON = + An easy way to follow the examples below is to remember the following: @@ -1596,83 +1780,6 @@ with a father in the person table, we could explicitly use C: # SELECT child.* FROM person child # INNER JOIN person father ON child.father_id = father.id -=head2 page - -=over 4 - -=item Value: $page - -=back - -Makes the resultset paged and specifies the page to retrieve. Effectively -identical to creating a non-pages resultset and then calling ->page($page) -on it. - -=head2 rows - -=over 4 - -=item Value: $rows - -=back - -Specifes the maximum number of rows for direct retrieval or the number of -rows per page if the page attribute or method is used. - -=head2 group_by - -=over 4 - -=item Value: \@columns - -=back - -A arrayref of columns to group by. Can include columns of joined tables. - - group_by => [qw/ column1 column2 ... /] - -=head2 having - -=over 4 - -=item Value: $condition - -=back - -HAVING is a select statement attribute that is applied between GROUP BY and -ORDER BY. It is applied to the after the grouping calculations have been -done. - - having => { 'count(employee)' => { '>=', 100 } } - -=head2 distinct - -=over 4 - -=item Value: (0 | 1) - -=back - -Set to 1 to group by all columns. - -=head2 cache - -Set to 1 to cache search results. This prevents extra SQL queries if you -revisit rows in your ResultSet: - - my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } ); - - while( my $artist = $resultset->next ) { - ... do stuff ... - } - - $rs->first; # without cache, this would issue a query - -By default, searches are not cached. - -For more examples of using these attributes, see -L. - =cut 1;