From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 10 Aug 2016 14:16:33 +0000 (+0200)
Subject: Stop accepting foreign_values => undef/rowobj in the resolver
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=786c1cdd;p=dbsrgits%2FDBIx-Class.git

Stop accepting foreign_values => undef/rowobj in the resolver

There are just a few spots that need this, things are complex enough as it is

Introduces a subtle change in behavior - now results of $foreign->get_columns
are scrutinized just as a plain hashref, and as a result the sanity checks are
somewhat relaxed.

There should not be any fallout due to this - tested on a wide range of
downstreams

Adjust some tested-for exceptions added in 7e5a0e7c as a result of the above

Read under -w
---

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 8e4b280..f82d2ec 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -7,6 +7,7 @@ use base qw/DBIx::Class/;
 
 use Scalar::Util qw/weaken blessed/;
 use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION fail_on_internal_call );
+use DBIx::Class::Carp;
 use namespace::clean;
 
 =head1 NAME
@@ -822,7 +823,34 @@ sub set_from_related {
   $self->set_columns( $self->result_source->_resolve_relationship_condition (
     infer_values_based_on => {},
     rel_name => $rel,
-    foreign_values => $f_obj,
+    foreign_values => (
+      # maintain crazy set_from_related interface
+      #
+      ( ! defined $f_obj )          ? +{}
+    : ( ! defined blessed $f_obj )  ? $f_obj
+                                    : do {
+
+        my $f_result_class = $self->result_source->related_source($rel)->result_class;
+
+        unless( $f_obj->isa($f_result_class) ) {
+
+          $self->throw_exception(
+            'Object supplied to set_from_related() must inherit from '
+          . "'$DBIx::Class::ResultSource::__expected_result_class_isa'"
+          ) unless $f_obj->isa(
+            $DBIx::Class::ResultSource::__expected_result_class_isa
+          );
+
+          carp_unique(
+            'Object supplied to set_from_related() usually should inherit from '
+          . "the related ResultClass ('$f_result_class'), perhaps you've made "
+          . 'a mistake?'
+          );
+        }
+
+        +{ $f_obj->get_columns };
+      }
+    ),
     foreign_alias => $rel,
     self_alias => 'me',
   )->{inferred_values} );
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index cf6e129..7915e07 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -818,6 +818,7 @@ sub find {
 
   for my $key (keys %$call_cond) {
     if (
+      # either a structure or a result-ish object
       length ref($call_cond->{$key})
         and
       ( $rel_list ||= { map { $_ => 1 } $rsrc->relationships } )
@@ -826,7 +827,7 @@ sub find {
       ! is_literal_value( $call_cond->{$key} )
         and
       # implicitly skip has_many's (likely MC), via the delete()
-      ( ref( my $val = delete $call_cond->{$key} ) ne 'ARRAY' )
+      ( ref( my $foreign_val = delete $call_cond->{$key} ) ne 'ARRAY' )
     ) {
 
       # FIXME: it seems wrong that relationship conditions take precedence...?
@@ -835,7 +836,30 @@ sub find {
 
         %{ $rsrc->_resolve_relationship_condition(
           rel_name => $key,
-          foreign_values => $val,
+          foreign_values => (
+            (! defined blessed $foreign_val) ? $foreign_val : do {
+
+              my $f_result_class = $rsrc->related_source($key)->result_class;
+
+              unless( $foreign_val->isa($f_result_class) ) {
+
+                $self->throw_exception(
+                  'Objects supplied to find() must inherit from '
+                . "'$DBIx::Class::ResultSource::__expected_result_class_isa'"
+                ) unless $foreign_val->isa(
+                  $DBIx::Class::ResultSource::__expected_result_class_isa
+                );
+
+                carp_unique(
+                  "Objects supplied to find() via '$key' usually should inherit from "
+                . "the related ResultClass ('$f_result_class'), perhaps you've made "
+                . 'a mistake?'
+                );
+              }
+
+              +{ $foreign_val->get_columns };
+            }
+          ),
           infer_values_based_on => {},
 
           self_alias => "\xFE", # irrelevant
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index c7c741c..bb5d926 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -2160,6 +2160,10 @@ sub _resolve_condition {
         $is_objlike[$_] = 0;
         $res_args[$_] = '__gremlins__';
       }
+      # more compat
+      elsif( $_ == 0 and $res_args[0]->isa( $__expected_result_class_isa ) ) {
+        $res_args[0] = { $res_args[0]->get_columns };
+      }
     }
     else {
       $res_args[$_] ||= {};
@@ -2225,7 +2229,7 @@ Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
 ## self-explanatory API, modeled on the custom cond coderef:
 # rel_name              => (scalar)
 # foreign_alias         => (scalar)
-# foreign_values        => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
+# foreign_values        => (either not supplied or a hashref )
 # self_alias            => (scalar)
 # self_result_object    => (either not supplied or a result object)
 # require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
@@ -2287,67 +2291,78 @@ sub _resolve_relationship_condition {
 
   my $rel_rsrc = $self->related_source($args->{rel_name});
 
-  if (exists $args->{foreign_values}) {
-
-    if (! defined $args->{foreign_values} ) {
-      # fallback: undef => {}
-      $args->{foreign_values} = {};
-    }
-    elsif (defined blessed $args->{foreign_values}) {
-
-      $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from '$__expected_result_class_isa'" )
-        unless $args->{foreign_values}->isa( $__expected_result_class_isa );
-
-      carp_unique(
-        "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
-      . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
-      . "perhaps you've made a mistake invoking the condition resolver?"
-      ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
-
-      $args->{foreign_values} = { $args->{foreign_values}->get_columns };
-    }
-    elsif ( ref $args->{foreign_values} eq 'HASH' ) {
-
-      # re-build {foreign_values} excluding identically named rels
-      if( keys %{$args->{foreign_values}} ) {
+  if (
+    exists $args->{foreign_values}
+      and
+    (
+      ref $args->{foreign_values} eq 'HASH'
+        or
+      $self->throw_exception(
+        "Argument 'foreign_values' must be a hash reference"
+      )
+    )
+      and
+    keys %{$args->{foreign_values}}
+  ) {
 
-        my ($col_idx, $rel_idx) = map
-          { { map { $_ => 1 } $rel_rsrc->$_ } }
-          qw( columns relationships )
-        ;
+    my ($col_idx, $rel_idx) = map
+      { { map { $_ => 1 } $rel_rsrc->$_ } }
+      qw( columns relationships )
+    ;
 
-        my $equivalencies = extract_equality_conditions(
-          $args->{foreign_values},
-          'consider nulls',
-        );
+    my $equivalencies;
 
-        $args->{foreign_values} = { map {
-          # skip if relationship *and* a non-literal ref
-          # this means a multicreate stub was passed in
+    # re-build {foreign_values} excluding refs as follows
+    # ( hot codepath: intentionally convoluted )
+    #
+    $args->{foreign_values} = { map {
+      (
+        $_ !~ /^-/
+          or
+        $self->throw_exception(
+          "The key '$_' supplied as part of 'foreign_values' during "
+         . 'relationship resolution must be a column name, not a function'
+        )
+      )
+        and
+      (
+        # skip if relationship ( means a multicreate stub was passed in )
+        # skip if literal ( can't infer anything about it )
+        # or plain throw if nonequiv yet not literal
+        (
+          length ref $args->{foreign_values}{$_}
+            and
           (
             $rel_idx->{$_}
-              and
-            length ref $args->{foreign_values}{$_}
-              and
-            ! is_literal_value($args->{foreign_values}{$_})
+              or
+            is_literal_value($args->{foreign_values}{$_})
+              or
+            (
+              (
+                ! exists(
+                  ( $equivalencies ||= extract_equality_conditions( $args->{foreign_values}, 'consider nulls' ) )
+                    ->{$_}
+                )
+                  or
+                ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION
+              )
+                and
+              $self->throw_exception(
+                "Resolution of relationship '$args->{rel_name}' failed: "
+              . "supplied value for foreign column '$_' is not a direct "
+              . 'equivalence expression'
+              )
+            )
           )
-            ? ()
-            : ( $_ => (
-                ! $col_idx->{$_}
-                  ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
-              : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
-                  ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
-              : $args->{foreign_values}{$_}
-            ))
-        } keys %{$args->{foreign_values}} };
-      }
-    }
-    else {
-      $self->throw_exception(
-        "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
-      . "or a hash reference, or undef"
-      );
-    }
+        )                             ? ()
+      : $col_idx->{$_}                ? ( $_ => $args->{foreign_values}{$_} )
+                                      : $self->throw_exception(
+            "The key '$_' supplied as part of 'foreign_values' during "
+           . 'relationship resolution is not a column on related source '
+           . "'@{[ $rel_rsrc->source_name ]}'"
+          )
+      )
+    } keys %{$args->{foreign_values}} };
   }
 
   my $ret;
diff --git a/t/cdbi/06-hasa.t b/t/cdbi/06-hasa.t
index 6d47c12..abad170 100644
--- a/t/cdbi/06-hasa.t
+++ b/t/cdbi/06-hasa.t
@@ -118,7 +118,7 @@ sub fail_with_bad_object {
         NumExplodingSheep => 23
       }
     );
-  } qr/isn't a Director/;
+  } qr/is not a column on related source 'Director'/;
 }
 
 package Foo;
diff --git a/t/cdbi/18-has_a.t b/t/cdbi/18-has_a.t
index a7b069c..6304b2c 100644
--- a/t/cdbi/18-has_a.t
+++ b/t/cdbi/18-has_a.t
@@ -110,7 +110,7 @@ is(
         Rating            => 'R',
         NumExplodingSheep => 23
       });
-  } qr/isn't a Director/, "Can't have film as codirector";
+  } qr/is not a column on related source 'Director'/, "Can't have film as codirector";
   is $fail, undef, "We didn't get anything";
 
   my $tastes_bad = YA::Film->create({
diff --git a/t/relationship/resolve_relationship_condition.t b/t/relationship/resolve_relationship_condition.t
index a999dc6..801b1ea 100644
--- a/t/relationship/resolve_relationship_condition.t
+++ b/t/relationship/resolve_relationship_condition.t
@@ -27,7 +27,9 @@ for (
   } qr/
     \Qis not a column on related source 'CD'\E
       |
-    \QValue supplied for '...{foreign_values}{year}' is not a direct equivalence expression\E
+    \Qsupplied value for foreign column 'year' is not a direct equivalence expression\E
+      |
+    \QThe key '-\E \w+ \Q' supplied as part of 'foreign_values' during relationship resolution must be a column name, not a function\E
   /x;
 }