Deprecate _build_unique_cond, move its guts to ::ResultSource where it belongs
Peter Rabbitson [Tue, 29 Jul 2014 00:12:33 +0000 (02:12 +0200)]
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
t/61findnot.t

index 7f21daf..d9d8959 100644 (file)
@@ -821,7 +821,6 @@ sub find {
     . "corresponding to the columns of the specified unique constraint '$constraint_name'"
     ) unless @c_cols == @_;
 
-    $call_cond = {};
     @{$call_cond}{@c_cols} = @_;
   }
 
@@ -848,17 +847,15 @@ sub find {
     }
   }
 
-  # add-in the resultset condition if any
-  ($call_cond) = $self->_merge_with_rscond($call_cond);
-
   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
   my $final_cond;
   if (defined $constraint_name) {
     $final_cond = $self->_qualify_cond_columns (
 
-      $self->_build_unique_cond (
-        $constraint_name,
-        $call_cond,
+      $self->result_source->_minimal_valueset_satisfying_constraint(
+        constraint_name => $constraint_name,
+        values => ($self->_merge_with_rscond($call_cond))[0],
+        carp_on_nulls => 1,
       ),
 
       $alias,
@@ -873,17 +870,28 @@ sub find {
     # relationship
   }
   else {
+    my (@unique_queries, %seen_column_combinations);
+
     # 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) {
+    #
+    # always start from 'primary' if it exists at all
+    for my $c_name ( sort {
+        $a eq 'primary' ? -1
+      : $b eq 'primary' ? 1
+      : $a cmp $b
+    } $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, 'croak_on_nulls')
+        $self->result_source->_minimal_valueset_satisfying_constraint(
+          constraint_name => $c_name,
+          values => ($self->_merge_with_rscond($call_cond))[0],
+        ),
       } || ();
     }
 
@@ -942,44 +950,20 @@ sub _qualify_cond_columns {
 }
 
 sub _build_unique_cond {
-  my ($self, $constraint_name, $final_cond, $croak_on_null) = @_;
-
-  my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
-
-  # trim out everything not in $columns
-  $final_cond = { map {
-    exists $final_cond->{$_}
-      ? ( $_ => $final_cond->{$_} )
-      : ()
-  } @c_cols };
-
-  if (my @missing = grep
-    { ! ($croak_on_null ? defined $final_cond->{$_} : exists $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),
-    ) );
-  }
-
-  if (
-    !$croak_on_null
-      and
-    !$ENV{DBIC_NULLABLE_KEY_NOWARN}
-      and
-    my @undefs = sort grep { ! defined $final_cond->{$_} } (keys %$final_cond)
-  ) {
-    carp_unique ( sprintf (
-      "NULL/undef values supplied for requested unique constraint '%s' (NULL "
-    . 'values in column(s): %s). This is almost certainly not what you wanted, '
-    . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
-      $constraint_name,
-      join (', ', map { "'$_'" } @undefs),
-    ));
-  }
-
-  return $final_cond;
+  carp_unique sprintf
+    '_build_unique_cond is a private method, and moreover is about to go '
+  . 'away. Please contact the development team at %s if you believe you '
+  . 'have a genuine use for this method, in order to discuss alternatives.',
+    DBIx::Class::_ENV_::HELP_URL,
+  ;
+
+  my ($self, $constraint_name, $cond, $croak_on_null) = @_;
+
+  $self->result_source->_minimal_valueset_satisfying_constraint(
+    constraint_name => $constraint_name,
+    values => $cond,
+    carp_on_nulls => !$croak_on_null
+  );
 }
 
 =head2 search_related
index c5feb09..47fa905 100644 (file)
@@ -1552,6 +1552,53 @@ sub _identifying_column_set {
   return undef;
 }
 
+sub _minimal_valueset_satisfying_constraint {
+  my $self = shift;
+  my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
+
+  my $vals = $self->storage->_extract_fixed_condition_columns(
+    $args->{values},
+    ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
+  );
+
+  my $cols;
+  for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
+    if( ! exists $vals->{$col} ) {
+      $cols->{missing}{$col} = 1;
+    }
+    elsif( ! defined $vals->{$col} ) {
+      $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = 1;
+    }
+    else {
+      $cols->{present}{$col} = 1;
+    }
+  }
+
+  $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
+    $args->{constraint_name},
+    join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
+  ) ) if $cols->{missing};
+
+  if (
+    $cols->{undefined}
+      and
+    !$ENV{DBIC_NULLABLE_KEY_NOWARN}
+  ) {
+    carp_unique ( sprintf (
+      "NULL/undef values supplied for requested unique constraint '%s' (NULL "
+    . 'values in column(s): %s). This is almost certainly not what you wanted, '
+    . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
+      $args->{constraint_name},
+      join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
+    ));
+  }
+
+  return { map
+    { $_ => $vals->{$_} }
+    ( keys %{$cols->{present}}, keys %{$cols->{undefined}} )
+  };
+}
+
 # Returns the {from} structure used to express JOIN conditions
 sub _resolve_join {
   my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
index b8b0d31..89070ce 100644 (file)
@@ -47,8 +47,10 @@ ok(@cd && !defined($cd[0]), 'Array contains an undef as only element');
 
 $cd = $schema->resultset("CD")->first;
 my $artist_rs = $schema->resultset("Artist")->search({ artistid => $cd->artist->artistid });
-$art = $artist_rs->find({ name => 'some other name' }, { key => 'primary' });
-ok($art, 'Artist found by key in the resultset');
+for my $key ('', 'primary') {
+  my $art = $artist_rs->find({ name => 'some other name' }, { $key ? (key => $key) : () });
+  is($art->artistid, $cd->get_column('artist'), "Artist found through @{[ $key ? 'explicit' : 'implicit' ]} key locked in the resultset");
+}
 
 # collapsing and non-collapsing are separate codepaths, thus the separate tests