X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=47bd139aa8a7616afcfdd7e42959734f41fec100;hb=0a3441ee8e0e747cfa05eff02df0d918ed5d6acb;hp=99882275b809995811a403a86a3b2d07f2b12adc;hpb=49ca473ec01bbf17cc35f7f112996b712470b438;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 9988227..47bd139 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -272,106 +272,96 @@ sub search_rs { # Special-case handling for (undef, undef). if ( @_ == 2 && !defined $_[1] && !defined $_[0] ) { - pop(@_); pop(@_); + @_ = (); } - my $attrs = {}; - $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH'; - my $our_attrs = { %{$self->{attrs}} }; - my $having = delete $our_attrs->{having}; - my $where = delete $our_attrs->{where}; - - my $rows; + my $call_attrs = {}; + $call_attrs = pop(@_) if @_ > 1 and ref $_[-1] eq 'HASH'; + # see if we can keep the cache (no $rs changes) + my $cache; 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; + if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and ( + ! defined $_[0] + or + ref $_[0] eq 'HASH' && ! keys %{$_[0]} + or + ref $_[0] eq 'ARRAY' && ! @{$_[0]} + )) { + $cache = $self->get_cache; } + my $old_attrs = { %{$self->{attrs}} }; + my $old_having = delete $old_attrs->{having}; + my $old_where = delete $old_attrs->{where}; + # reset the selector list - if (List::Util::first { exists $attrs->{$_} } qw{columns select as}) { - delete @{$our_attrs}{qw{select as columns +select +as +columns include_columns}}; + if (List::Util::first { exists $call_attrs->{$_} } qw{columns select as}) { + delete @{$old_attrs}{qw{select as columns +select +as +columns include_columns}}; } - my $new_attrs = { %{$our_attrs}, %{$attrs} }; + my $new_attrs = { %{$old_attrs}, %{$call_attrs} }; # merge new attrs into inherited foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) { - next unless exists $attrs->{$key}; - $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key}); + next unless exists $call_attrs->{$key}; + $new_attrs->{$key} = $self->_merge_attr($old_attrs->{$key}, $call_attrs->{$key}); } - my $cond = (@_ - ? ( - (@_ == 1 || ref $_[0] eq "HASH") - ? ( - (ref $_[0] eq 'HASH') - ? ( - (keys %{ $_[0] } > 0) - ? shift - : undef - ) - : shift - ) - : ( - (@_ % 2) - ? $self->throw_exception("Odd number of arguments to search") - : {@_} - ) - ) - : undef - ); + # rip apart the rest of @_, parse a condition + my $call_cond = do { - if (defined $where) { - $new_attrs->{where} = ( - defined $new_attrs->{where} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $where, $new_attrs->{where} - ] - } - : $where); - } + if (ref $_[0] eq 'HASH') { + (keys %{$_[0]}) ? $_[0] : undef + } + elsif (@_ == 1) { + $_[0] + } + elsif (@_ % 2) { + $self->throw_exception('Odd number of arguments to search') + } + else { + +{ @_ } + } - if (defined $cond) { - $new_attrs->{where} = ( - defined $new_attrs->{where} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $cond, $new_attrs->{where} - ] - } - : $cond); + } if @_; + + for ($old_where, $call_cond) { + if (defined $_) { + $new_attrs->{where} = $self->_stack_cond ( + $_, $new_attrs->{where} + ); + } } - if (defined $having) { - $new_attrs->{having} = ( - defined $new_attrs->{having} - ? { '-and' => [ - map { - ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ - } $having, $new_attrs->{having} - ] - } - : $having); + if (defined $old_having) { + $new_attrs->{having} = $self->_stack_cond ( + $old_having, $new_attrs->{having} + ) } my $rs = (ref $self)->new($self->result_source, $new_attrs); - $rs->set_cache($rows) if ($rows); + $rs->set_cache($cache) if ($cache); return $rs; } +sub _stack_cond { + my ($self, $left, $right) = @_; + if (defined $left xor defined $right) { + return defined $left ? $left : $right; + } + elsif (defined $left) { + return { -and => [ map + { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + ($left, $right) + ]}; + } + + return undef; +} + =head2 search_literal =over 4 @@ -418,25 +408,56 @@ sub search_literal { =over 4 -=item Arguments: @values | \%cols, \%attrs? +=item Arguments: \%columns_values | @pk_values, \%attrs? =item Return Value: $row_object | undef =back -Finds a row based on its primary key or unique constraint. For example, to find -a row by its primary key: +Finds and returns a single row based on supplied criteria. Takes either a +hashref with the same format as L (including inference of foreign +keys from related objects), or a list of primary key values in the same +order as the L +declaration on the L. + +In either case an attempt is made to combine conditions already existing on +the resultset with the condition passed to this method. + +To aid with preparing the correct query for the storage you may supply the +C attribute, which is the name of a +L (the +unique constraint corresponding to the +L is always named +C). If the C attribute has been supplied, and DBIC is unable +to construct a query that satisfies the named unique constraint fully ( +non-NULL values for each column member of the constraint) an exception is +thrown. + +If no C is specified, the search is carried over all unique constraints +which are fully defined by the available condition. + +If no such constraint is found, C currently defaults to a simple +C<< search->(\%column_values) >> which may or may not do what you expect. +Note that this fallback behavior may be deprecated in further versions. If +you need to search with arbitrary conditions - use L. If the query +resulting from this fallback produces more than one row, a warning to the +effect is issued, though only the first row is constructed and returned as +C<$row_object>. - my $cd = $schema->resultset('CD')->find(5); +In addition to C, L recognizes and applies standard +L in the same way as L does. -You can also find a row by a specific unique constraint using the C -attribute. For example: +Note that if you have extra concerns about the correctness of the resulting +query you need to specify the C attribute and supply the entire condition +as an argument to find (since it is not always possible to perform the +combination of the resultset condition with the supplied one, especially if +the resultset condition contains literal sql). - my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { - key => 'cd_artist_title' - }); +For example, to find a row by its primary key: + + my $cd = $schema->resultset('CD')->find(5); -Additionally, you can specify the columns explicitly by name: +You can also find a row by a specific unique constraint: my $cd = $schema->resultset('CD')->find( { @@ -446,24 +467,7 @@ Additionally, you can specify the columns explicitly by name: { key => 'cd_artist_title' } ); -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 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. +See also L and L. =cut @@ -471,14 +475,16 @@ sub find { my $self = shift; my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); - # Parse out a query from input - my $input_query; + my $rsrc = $self->result_source; + + # Parse out the condition from input + my $call_cond; if (ref $_[0] eq 'HASH') { - $input_query = { %{$_[0]} }; + $call_cond = { %{$_[0]} }; } else { my $constraint = exists $attrs->{key} ? $attrs->{key} : 'primary'; - my @c_cols = $self->result_source->unique_constraint_columns($constraint); + my @c_cols = $rsrc->unique_constraint_columns($constraint); $self->throw_exception( "No constraint columns, maybe a malformed '$constraint' constraint?" @@ -489,22 +495,22 @@ sub find { . "corresponding to the columns of the specified unique constraint '$constraint'" ) unless @c_cols == @_; - $input_query = {}; - @{$input_query}{@c_cols} = @_; + $call_cond = {}; + @{$call_cond}{@c_cols} = @_; } my %related; - for my $key (keys %$input_query) { + for my $key (keys %$call_cond) { if ( - my $keyref = ref($input_query->{$key}) + my $keyref = ref($call_cond->{$key}) and - my $relinfo = $self->result_source->relationship_info($key) + my $relinfo = $rsrc->relationship_info($key) ) { - my $val = delete $input_query->{$key}; + my $val = delete $call_cond->{$key}; next if $keyref eq 'ARRAY'; # has_many for multi_create - my $rel_q = $self->result_source->_resolve_condition( + my $rel_q = $rsrc->_resolve_condition( $relinfo->{cond}, $val, $key ); die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH'; @@ -513,17 +519,20 @@ sub find { } # relationship conditions take precedence (?) - @{$input_query}{keys %related} = values %related; + @{$call_cond}{keys %related} = 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; + my $final_cond; 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); + $final_cond = $self->_qualify_cond_columns ( + + $self->_build_unique_cond ( + $attrs->{key}, + $call_cond, + ), + + $alias, + ); } elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') { # This means that we got here after a merger of relationship conditions @@ -534,14 +543,28 @@ sub find { # relationship } 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); + # no key was specified - fall down to heuristics mode: + # run through all unique queries registered on the resultset, and + # 'OR' all qualifying queries together + my (@unique_queries, %seen_column_combinations); + for my $c_name ($rsrc->unique_constraint_names) { + next if $seen_column_combinations{ + join "\x00", sort $rsrc->unique_constraint_columns($c_name) + }++; + + push @unique_queries, try { + $self->_build_unique_cond ($c_name, $call_cond) + } || (); + } + + $final_cond = @unique_queries + ? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ] + : $self->_non_unique_find_fallback ($call_cond, $attrs) + ; } # Run the query, passing the result_class since it should propagate for find - my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs}); + my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); if (keys %{$rs->_resolved_attrs->{collapse}}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; @@ -552,71 +575,65 @@ sub find { } } -# _add_alias +# This is a stop-gap method as agreed during the discussion on find() cleanup: +# http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html # -# Add the specified alias to the specified query hash. A copy is made so the -# original query is not modified. +# It is invoked when find() is called in legacy-mode with insufficiently-unique +# condition. It is provided for overrides until a saner way forward is devised +# +# *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down +# the road. Please adjust your tests accordingly to catch this situation early +# DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable +# +# The method will not be removed without an adequately complete replacement +# for strict-mode enforcement +sub _non_unique_find_fallback { + my ($self, $cond, $attrs) = @_; + + return $self->_qualify_cond_columns( + $cond, + exists $attrs->{alias} + ? $attrs->{alias} + : $self->{attrs}{alias} + ); +} -sub _add_alias { - my ($self, $query, $alias) = @_; - my %aliased = %$query; - foreach my $col (grep { ! m/\./ } keys %aliased) { - $aliased{"$alias.$col"} = delete $aliased{$col}; +sub _qualify_cond_columns { + my ($self, $cond, $alias) = @_; + + my %aliased = %$cond; + for (keys %aliased) { + $aliased{"$alias.$_"} = delete $aliased{$_} + if $_ !~ /\./; } return \%aliased; } -# _unique_queries -# -# Build a list of queries which satisfy unique constraints. - -sub _unique_queries { - my ($self, $query, $attrs) = @_; - - my @constraint_names = exists $attrs->{key} - ? ($attrs->{key}) - : $self->result_source->unique_constraint_names; +sub _build_unique_cond { + my ($self, $constraint_name, $extra_cond) = @_; - my $where = $self->_collapse_cond($self->{attrs}{where} || {}); - my $num_where = scalar keys %$where; + my @c_cols = $self->result_source->unique_constraint_columns($constraint_name); - my (@unique_queries, %seen_column_combinations); - foreach my $name (@constraint_names) { - my @constraint_cols = $self->result_source->unique_constraint_columns($name); - - my $constraint_sig = join "\x00", sort @constraint_cols; - next if $seen_column_combinations{$constraint_sig}++; - - my $unique_query = $self->_build_unique_query($query, \@constraint_cols); + # combination may fail if $self->{cond} is non-trivial + my ($final_cond) = try { + $self->_merge_with_rscond ($extra_cond) + } catch { + +{ %$extra_cond } + }; - my $num_cols = scalar @constraint_cols; - my $num_query = scalar keys %$unique_query; + # trim out everything not in $columns + $final_cond = { map { $_ => $final_cond->{$_} } @c_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; - } + if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) { + $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s", + $constraint_name, + join (', ', map { "'$_'" } @missing), + ) ); } - return @unique_queries; -} - -# _build_unique_query -# -# Constrain the specified query hash based on the specified column names. - -sub _build_unique_query { - my ($self, $query, $unique_cols) = @_; - - return { - map { $_ => $query->{$_} } - grep { exists $query->{$_} } - @$unique_cols - }; + return $final_cond; } =head2 search_related @@ -1705,7 +1722,7 @@ sub populate { } ## inherit the data locked in the conditions of the resultset - my ($rs_data) = $self->_merge_cond_with_data({}); + my ($rs_data) = $self->_merge_with_rscond({}); delete @{$rs_data}{@columns}; my @inherit_cols = keys %$rs_data; my @inherit_data = values %$rs_data; @@ -2012,7 +2029,7 @@ sub new_result { $self->throw_exception( "new_result needs a hash" ) unless (ref $values eq 'HASH'); - my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values); + my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values); my %new = ( %$merged_cond, @@ -2026,13 +2043,13 @@ sub new_result { return $self->result_class->new(\%new); } -# _merge_cond_with_data +# _merge_with_rscond # # Takes a simple hash of K/V data and returns its copy merged with the # condition already present on the resultset. Additionally returns an # arrayref of value/condition names, which were inferred from related # objects (this is needed for in-memory related objects) -sub _merge_cond_with_data { +sub _merge_with_rscond { my ($self, $data) = @_; my (%new_data, @cols_from_relations); @@ -2058,11 +2075,13 @@ sub _merge_cond_with_data { 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 '=') { + my $vref = ref $value; + if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') { $new_data{$col} = $value->{'='}; - next; } - $new_data{$col} = $value if $self->_is_deterministic_value($value); + elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) { + $new_data{$col} = $value; + } } } @@ -2074,20 +2093,6 @@ sub _merge_cond_with_data { return (\%new_data, \@cols_from_relations); } -# _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 blessed $value; - return 0; -} - # _has_resolved_attr # # determines if the resultset defines at least one @@ -2245,17 +2250,18 @@ sub as_query { $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. +Find an existing record from this resultset using L. if none exists, +instantiate a new result object and return it. The object will not be saved +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. -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. -If you want objects to be saved immediately, use L -instead. +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious new objects. B: Take care when using C with a table having columns with default values that you intend to be automatically @@ -2397,6 +2403,10 @@ constraint. For example: { key => 'cd_artist_title' } ); +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious row creation. + 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 @@ -2430,16 +2440,15 @@ sub find_or_create { =item Arguments: \%col_values, { key => $unique_constraint }? -=item Return Value: $rowobject +=item Return Value: $row_object =back $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 -found, updates it with the other given column values. Otherwise, creates a new -row. +Like L, but if a row is found it is immediately updated via +C<< $found_row->update (\%col_values) >>. + Takes an optional C attribute to search on a specific unique constraint. For example: @@ -2461,14 +2470,9 @@ For example: key => 'primary', }); - -If no C is specified, 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. +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious row creation. B: Take care when using C with a table having columns with default values that you intend to be automatically @@ -2476,6 +2480,9 @@ 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 and L. For information on how to declare +unique constraints, see L. + =cut sub update_or_create { @@ -2504,13 +2511,9 @@ sub update_or_create { $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. +Like L but if a row is found it is immediately updated via +C<< $found_row->update (\%col_values) >>. -Takes an optional C attribute to search on a specific unique constraint. For example: # In your application @@ -2531,13 +2534,17 @@ For example: $cd->insert; } +B: Make sure to read the documentation of L and understand the +significance of the C attribute, as its lack may skew your search, and +subsequently result in spurious new objects. + B: Take care when using C with a table having columns with default values that you intend to be automatically 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 @@ -3114,34 +3121,9 @@ sub _resolved_attrs { carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); } else { - my $storage = $self->result_source->schema->storage; - my $rs_column_list = $storage->_resolve_column_info ($attrs->{from}); - - my $group_spec = $attrs->{group_by} = []; - my %group_index; - - for (@{$attrs->{select}}) { - if (! ref($_) or ref ($_) ne 'HASH' ) { - push @$group_spec, $_; - $group_index{$_}++; - if ($rs_column_list->{$_} and $_ !~ /\./ ) { - # add a fully qualified version as well - $group_index{"$rs_column_list->{$_}{-source_alias}.$_"}++; - } - } - } - # add any order_by parts that are not already present in the group_by - # we need to be careful not to add any named functions/aggregates - # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ] - for my $chunk ($storage->_extract_order_columns($attrs->{order_by})) { - - # only consider real columns (for functions the user got to do an explicit group_by) - my $colinfo = $rs_column_list->{$chunk} - or next; - - $chunk = "$colinfo->{-source_alias}.$chunk" if $chunk !~ /\./; - push @$group_spec, $chunk unless $group_index{$chunk}++; - } + $attrs->{group_by} = $source->storage->_group_over_selection ( + @{$attrs}{qw/from select order_by/} + ); } }