From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 16 Oct 2010 16:40:53 +0000 (+0200)
Subject: Fix find() with an explicit constraint name (... { key => $cname } )
X-Git-Tag: v0.08124~37^2~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b7743dabe3354b4a43954ec44a226dc1c44722ac;p=dbsrgits%2FDBIx-Class.git

Fix find() with an explicit constraint name (... { key => $cname } )

Fix the code being overly lax on evaluation of the combined
condition (user supplied + $rs inherited). If we can not prove
that a constraint is deteministic - we throw

Also fix the heuristics invoked without a key attr. to not
consider constraints for which NULL values have been supplied
---

diff --git a/Changes b/Changes
index d724473..c1291c7 100644
--- a/Changes
+++ b/Changes
@@ -22,6 +22,8 @@ Revision history for DBIx::Class
           at instantiation time
         - New documentation map organized by features
           (DBIx::Class::Manual::Features)
+        - find( { ... }, { key => $constraint } ) now throws an exception
+          when the supplied data does not fully specify $constraint
         - find( col1 => $val1, col2 => $val2, ... ) is no longer supported
           (it has been in deprecated state for more than 4 years)
 
@@ -31,6 +33,8 @@ Revision history for DBIx::Class
         - Make sure exception_action does not allow exception-hiding
           due to badly-written handlers (the mechanism was never meant
           to be able to suppress exceptions)
+        - Fix find() without a key attr. choosing constraints even if
+          some of the supplied values are NULL (RT#59219)
         - Fixed rels ending with me breaking subqueried limit realiasing
         - Fixed $rs->update/delete on resutsets constrained by an
           -or condition
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 7d413d7..3c879a3 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -461,14 +461,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?"
@@ -479,22 +481,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';
@@ -503,17 +505,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
@@ -524,18 +529,28 @@ sub find {
     # relationship
   }
   else {
-    # no key was specified - fall down to heuristics mode
-    # get all possible unique queries based on the combination of $query
-    # and the condition available in $self, and then run a search with
-    # each and every possible constraint (as long as it's completely specified)
-    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->_qualify_cond_columns($call_cond, $alias)
+    ;
   }
 
   # 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;
@@ -546,71 +561,41 @@ sub find {
   }
 }
 
-# _add_alias
-#
-# Add the specified alias to the specified query hash. A copy is made so the
-# original query is not modified.
-
-sub _add_alias {
-  my ($self, $query, $alias) = @_;
+sub _qualify_cond_columns {
+  my ($self, $cond, $alias) = @_;
 
-  my %aliased = %$query;
-  foreach my $col (grep { ! m/\./ } keys %aliased) {
-    $aliased{"$alias.$col"} = delete $aliased{$col};
+  my %aliased = %$cond;
+  for (keys %aliased) {
+    $aliased{"$alias.$_"} = delete $aliased{$_}
+      if $_ !~ /\./;
   }
 
   return \%aliased;
 }
 
-# _unique_queries
-#
-# Build a list of queries which satisfy the unique constraint(s) as per $attrs
-
-sub _unique_queries {
-  my ($self, $query, $attrs) = @_;
-
-  my @constraint_names = exists $attrs->{key}
-    ? ($attrs->{key})
-    : $self->result_source->unique_constraint_names;
-
-  my $where = $self->_collapse_cond($self->{attrs}{where} || {});
-  my $num_where = scalar keys %$where;
+sub _build_unique_cond {
+  my ($self, $constraint_name, $extra_cond) = @_;
 
-  my (@unique_queries, %seen_column_combinations);
-  foreach my $name (@constraint_names) {
-    my @constraint_cols = $self->result_source->unique_constraint_columns($name);
+  my @c_cols = $self->result_source->unique_constraint_columns($constraint_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 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
@@ -1699,7 +1684,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;
@@ -2006,7 +1991,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,
@@ -2020,13 +2005,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);
diff --git a/t/61findnot.t b/t/61findnot.t
index 8479494..e7f4249 100644
--- a/t/61findnot.t
+++ b/t/61findnot.t
@@ -1,15 +1,14 @@
 use strict;
-use warnings;  
+use warnings;
 
 use Test::More;
 use Test::Warn;
+use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 20;
-
 my $art = $schema->resultset("Artist")->find(4);
 ok(!defined($art), 'Find on primary id: artist not found');
 my @cd = $schema->resultset("CD")->find(6);
@@ -51,13 +50,23 @@ my $artist_rs = $schema->resultset("Artist")->search({ artistid => $cd->artist->
 $art = $artist_rs->find({ name => 'some other name' }, { key => 'primary' });
 ok($art, 'Artist found by key in the resultset');
 
+# collapsing and non-collapsing are separate codepaths, thus the separate tests
+
 $artist_rs = $schema->resultset("Artist");
-warning_is {
-  $artist_rs->find({}, { key => 'primary' })
-} "DBIx::Class::ResultSet::find(): Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single"
+warnings_exist {
+  $artist_rs->find({})
+} qr/\QDBIx::Class::ResultSet::find(): Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single/
     =>  "Non-unique find generated a cursor inexhaustion warning";
+throws_ok {
+  $artist_rs->find({}, { key => 'primary' })
+} qr/Unable to satisfy constraint 'primary'/;
 
 $artist_rs = $schema->resultset("Artist")->search({}, { prefetch => 'cds' });
-warning_is {
+warnings_exist {
+  $artist_rs->find({})
+} qr/\QDBIx::Class::ResultSet::find(): Query returned more than one row/, "Non-unique find generated a cursor inexhaustion warning";
+throws_ok {
   $artist_rs->find({}, { key => 'primary' })
-} "DBIx::Class::ResultSet::find(): Query returned more than one row", "Non-unique find generated a cursor inexhaustion warning";
+} qr/Unable to satisfy constraint 'primary'/;
+
+done_testing;
diff --git a/t/80unique.t b/t/80unique.t
index dfd7819..2264f61 100644
--- a/t/80unique.t
+++ b/t/80unique.t
@@ -132,6 +132,12 @@ is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
 is($cd8->title, $cd1->title, 'title is correct');
 is($cd8->year, $cd1->year, 'year is correct');
 
+# Add an extra row to potentially confuse the query
+$schema->resultset('CD')->create ({
+  artist => 2,
+  title => $title,
+  year => 2022,
+});
 my $cd9 = $artist->cds->update_or_create(
   {
     cdid   => $cd1->cdid,
diff --git a/t/relationship/update_or_create_multi.t b/t/relationship/update_or_create_multi.t
index 56936f8..6bb0e86 100644
--- a/t/relationship/update_or_create_multi.t
+++ b/t/relationship/update_or_create_multi.t
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
 use DBIC::SqlMakerTest;
@@ -10,14 +11,13 @@ use DBIC::SqlMakerTest;
 my $schema = DBICTest->init_schema();
 my $sdebug = $schema->storage->debug;
 
-plan tests => 6;
-
 my $artist = $schema->resultset ('Artist')->first;
 
 my $genre = $schema->resultset ('Genre')
             ->create ({ name => 'par excellence' });
+my $genre_cds = $genre->cds;
 
-is ($genre->search_related( 'cds' )->count, 0, 'No cds yet');
+is ($genre_cds->count, 0, 'No cds yet');
 
 # expect a create
 $genre->update_or_create_related ('cds', {
@@ -27,8 +27,8 @@ $genre->update_or_create_related ('cds', {
 });
 
 # verify cd was inserted ok
-is ($genre->search_related( 'cds' )->count, 1, 'One cd');
-my $cd = $genre->find_related ('cds', {});
+is ($genre_cds->count, 1, 'One cd');
+my $cd = $genre_cds->first;
 is_deeply (
   { map { $_, $cd->get_column ($_) } qw/artist year title/ },
   {
@@ -40,15 +40,16 @@ is_deeply (
 );
 
 # expect a year update on the only related row
-# (non-qunique column + unique column as disambiguator)
+# (non-qunique column + unique column set as disambiguator)
 $genre->update_or_create_related ('cds', {
   year => 2010,
   title => 'the best thing since sliced bread',
+  artist => 1,
 });
 
 # re-fetch the cd, verify update
 is ($genre->search_related( 'cds' )->count, 1, 'Still one cd');
-$cd = $genre->find_related ('cds', {});
+$cd = $genre_cds->first;
 is_deeply (
   { map { $_, $cd->get_column ($_) } qw/artist year title/ },
   {
@@ -59,6 +60,16 @@ is_deeply (
   'CD year column updated correctly',
 );
 
+# expect a failing create:
+# the unique constraint is not complete, and there is nothing
+# in the database with such a year yet - insertion will fail due
+# to missing artist fk
+throws_ok {
+  $genre->update_or_create_related ('cds', {
+    year => 2020,
+    title => 'the best thing since sliced bread',
+  })
+} qr/\Qcd.artist may not be NULL/, 'ambiguous find + create failed';
 
 # expect a create, after a failed search using *only* the
 # *current* relationship and the unique column constraints
@@ -88,3 +99,5 @@ is_same_sql (
 
 # a has_many search without a unique constraint makes no sense
 # but I am not sure what to test for - leaving open
+
+done_testing;