Stop accepting foreign_values => undef/rowobj in the resolver
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
index f8a1661..bb5d926 100644 (file)
@@ -1,5 +1,15 @@
 package DBIx::Class::ResultSource;
 
+### !!!NOTE!!!
+#
+# Some of the methods defined here will be around()-ed by code at the
+# end of ::ResultSourceProxy. The reason for this strange arrangement
+# is that the list of around()s of methods in this class depends
+# directly on the list of may-not-be-defined-yet methods within
+# ::ResultSourceProxy itself.
+# If this sounds terrible - it is. But got to work with what we have.
+#
+
 use strict;
 use warnings;
 
@@ -11,6 +21,8 @@ use DBIx::Class::_Util qw(
   dbic_internal_try fail_on_internal_call
   refdesc emit_loud_diag
 );
+use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions );
+use DBIx::Class::ResultSource::FromSpec::Util 'fromspec_columns_info';
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
 use Scalar::Util qw( blessed weaken isweak refaddr );
@@ -20,6 +32,13 @@ use DBIx::Class::ResultSet;
 
 use namespace::clean;
 
+# This global is present for the afaik nonexistent, but nevertheless possible
+# case of folks using stock ::ResultSet with a completely custom Result-class
+# hierarchy, not derived from DBIx::Class::Row at all
+# Instead of patching stuff all over the place - this would be one convenient
+# place to override things if need be
+our $__expected_result_class_isa = 'DBIx::Class::Row';
+
 my @hashref_attributes = qw(
   source_info resultset_attributes
   _columns _unique_constraints _relationships
@@ -447,7 +466,7 @@ sub __emit_stale_metadata_diag {
 
 =head2 clone
 
-  $rsrc_instance->clone( atribute_name => overriden_value );
+  $rsrc_instance->clone( atribute_name => overridden_value );
 
 A wrapper around L</new> inheriting any defaults from the callee. This method
 also not normally invoked directly by end users.
@@ -704,7 +723,7 @@ sub add_columns {
   return $self;
 }
 
-sub add_column {
+sub add_column :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->add_columns(@_)
 }
@@ -748,7 +767,7 @@ contents of the hashref.
 
 =cut
 
-sub column_info {
+sub column_info :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
   #my ($self, $column) = @_;
@@ -912,7 +931,7 @@ sub remove_columns {
   $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
 }
 
-sub remove_column {
+sub remove_column :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->remove_columns(@_)
 }
@@ -1143,7 +1162,7 @@ See also L</add_unique_constraint>.
 
 =cut
 
-sub add_unique_constraints {
+sub add_unique_constraints :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
   my $self = shift;
@@ -1606,7 +1625,7 @@ Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
 
 =cut
 
-sub storage {
+sub storage :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->schema->storage
 }
@@ -1918,7 +1937,7 @@ sub _minimal_valueset_satisfying_constraint {
 
   $args->{columns_info} ||= $self->columns_info;
 
-  my $vals = $self->schema->storage->_extract_fixed_condition_columns(
+  my $vals = extract_equality_conditions(
     $args->{values},
     ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
   );
@@ -1932,7 +1951,7 @@ sub _minimal_valueset_satisfying_constraint {
       $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
     }
     else {
-      # we need to inject back the '=' as _extract_fixed_condition_columns
+      # we need to inject back the '=' as extract_equality_conditions()
       # will strip it from literals and values alike, resulting in an invalid
       # condition in the end
       $cols->{present}{$col} = { '=' => $vals->{$col} };
@@ -2141,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[$_] ||= {};
@@ -2206,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)
@@ -2254,78 +2277,92 @@ sub _resolve_relationship_condition {
 
   $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
 
-  $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
+  $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from '$__expected_result_class_isa'" )
     if (
       exists $args->{self_result_object}
         and
-      ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
+      (
+        ! defined blessed $args->{self_result_object}
+          or
+        ! $args->{self_result_object}->isa( $__expected_result_class_isa )
+      )
     )
   ;
 
   my $rel_rsrc = $self->related_source($args->{rel_name});
-  my $storage = $self->schema->storage;
-
-  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 DBIx::Class::Row" )
-        unless $args->{foreign_values}->isa('DBIx::Class::Row');
-
-      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 = $storage->_extract_fixed_condition_columns(
-          $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;
@@ -2388,11 +2425,9 @@ sub _resolve_relationship_condition {
       ) for keys %$jfc;
 
       (
-        length ref $_
-          and
         defined blessed($_)
           and
-        $_->isa('DBIx::Class::Row')
+        $_->isa( $__expected_result_class_isa )
           and
         $self->throw_exception (
           "The join-free condition returned for $exception_rel_id may not "
@@ -2475,12 +2510,12 @@ sub _resolve_relationship_condition {
         $ret = $subconds[0];
       }
       else {
-        # we are discarding inferred values here... likely incorrect...
-        # then again - the entire thing is an OR, so we *can't* use them anyway
         for my $subcond ( @subconds ) {
           $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
             if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
 
+          # we are discarding inferred_values from individual 'OR' branches here
+          # see @nonvalues checks below
           $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
         }
       }
@@ -2490,6 +2525,19 @@ sub _resolve_relationship_condition {
     $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
   }
 
+
+  # Explicit normalization pass
+  # ( nobody really knows what a CODE can return )
+  # Explicitly leave U_C alone - it would be normalized
+  # to an { -and => [ U_C ] }
+  defined $ret->{$_}
+    and
+  $ret->{$_} ne UNRESOLVABLE_CONDITION
+    and
+  $ret->{$_} = normalize_sqla_condition($ret->{$_})
+    for qw(condition join_free_condition);
+
+
   if (
     $args->{require_join_free_condition}
       and
@@ -2509,37 +2557,50 @@ sub _resolve_relationship_condition {
     $ret->{join_free_condition}
       and
     $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
-      and
-    my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
   ) {
 
-    my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
-
-    if (keys %$jfc_eqs) {
+    my $jfc_eqs = extract_equality_conditions(
+      $ret->{join_free_condition},
+      'consider_nulls'
+    );
 
-      for (keys %$jfc) {
-        # $jfc is fully qualified by definition
-        my ($col) = $_ =~ /\.(.+)/;
+    for( keys %{ $ret->{join_free_condition} } ) {
+      if( $_ =~ /^-/ ) {
+        push @nonvalues, { $_ => $ret->{join_free_condition}{$_} };
+      }
+      else {
+        # a join_free_condoition is fully qualified by definition
+        my ($col) = $_ =~ /\.(.+)/ or carp_unique(
+          'Internal error - extract_equality_conditions() returned a '
+        . "non-fully-qualified key '$_'. *Please* file a bugreport "
+        . "including your definition of $exception_rel_id"
+        );
 
         if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
           $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
         }
         elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
-          push @nonvalues, $col;
+          push @nonvalues, { $_ => $ret->{join_free_condition}{$_} };
         }
       }
-
-      # all or nothing
-      delete $ret->{inferred_values} if @nonvalues;
     }
+
+    # all or nothing
+    delete $ret->{inferred_values} if @nonvalues;
   }
 
   # did the user explicitly ask
   if ($args->{infer_values_based_on}) {
 
     $self->throw_exception(sprintf (
-      "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
-      map { "'$_'" } @nonvalues
+      "Unable to complete value inferrence - $exception_rel_id results in expression(s) instead of definitive values: %s",
+      do {
+        # FIXME - used for diag only, but still icky
+        my $sqlm = $self->schema->storage->sql_maker;
+        local $sqlm->{quote_char};
+        local $sqlm->{_dequalify_idents} = 1;
+        ($sqlm->_recurse_where({ -and => \@nonvalues }))[0]
+      }
     )) if @nonvalues;
 
 
@@ -2553,7 +2614,7 @@ sub _resolve_relationship_condition {
   # (may already be there, since easy to calculate on the fly in the HASH case)
   if ( ! $ret->{identity_map} ) {
 
-    my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
+    my $col_eqs = extract_equality_conditions($ret->{condition});
 
     my $colinfos;
     for my $lhs (keys %$col_eqs) {
@@ -2563,7 +2624,7 @@ sub _resolve_relationship_condition {
       # there is no way to know who is right and who is left in a cref
       # therefore a full blown resolution call, and figure out the
       # direction a bit further below
-      $colinfos ||= $storage->_resolve_column_info([
+      $colinfos ||= fromspec_columns_info([
         { -alias => $args->{self_alias}, -rsrc => $self },
         { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
       ]);
@@ -2601,8 +2662,15 @@ sub _resolve_relationship_condition {
   }
 
   # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
-  $ret->{condition} = { -and => [ $ret->{condition} ] }
-    unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
+  $ret->{condition} = { -and => [ $ret->{condition} ] } unless (
+    $ret->{condition} eq UNRESOLVABLE_CONDITION
+      or
+    (
+      ref $ret->{condition} eq 'HASH'
+        and
+      grep { $_ =~ /^-/ } keys %{$ret->{condition}}
+    )
+  );
 
   $ret;
 }