From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 19 Sep 2016 12:14:27 +0000 (+0200)
Subject: Centralize specification of expected Result class base in the codebase
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=c6ec79000b160e7491d9ab9d95d6e69c473b0862

Centralize specification of expected Result class base in the codebase

Some parts of the stack need to be able to disambiguate Result instances from
other objects. In odrder to avoid tight coupling introduce a single override
point $DBIx::Class::ResultSource::__expected_result_class_isa for esoteric
use cases

No functional changes
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 4338392..bf7e88f 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -10,7 +10,7 @@ use DBIx::Class::ResultSetColumn;
 use DBIx::Class::ResultClass::HashRefInflator;
 use Scalar::Util qw( blessed reftype );
 use DBIx::Class::_Util qw(
-  dbic_internal_try dbic_internal_catch dump_value
+  dbic_internal_try dbic_internal_catch dump_value emit_loud_diag
   fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
 );
 use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions );
@@ -2288,7 +2288,18 @@ sub populate {
                 or
               ref $data->[$i][$_->{pos}] eq 'HASH'
                 or
-              ( defined blessed $data->[$i][$_->{pos}] and $data->[$i][$_->{pos}]->isa('DBIx::Class::Row') )
+              (
+                defined blessed $data->[$i][$_->{pos}]
+                  and
+                $data->[$i][$_->{pos}]->isa(
+                  $DBIx::Class::ResultSource::__expected_result_class_isa
+                    ||
+                  emit_loud_diag(
+                    confess => 1,
+                    msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...'
+                  )
+                )
+              )
             )
               and
             1
@@ -2296,7 +2307,18 @@ sub populate {
 
             # moar sanity check... sigh
             for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) {
-              if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
+              if (
+                defined blessed $_
+                  and
+                $_->isa(
+                  $DBIx::Class::ResultSource::__expected_result_class_isa
+                    ||
+                  emit_loud_diag(
+                    confess => 1,
+                    msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...'
+                  )
+                )
+              ) {
                 carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
                 return my $throwaway = $self->populate(@_);
               }
@@ -2338,7 +2360,18 @@ sub populate {
               or
             ref $data->[$i]{$_} eq 'HASH'
               or
-            ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIx::Class::Row') )
+            (
+              defined blessed $data->[$i]{$_}
+                and
+              $data->[$i]{$_}->isa(
+                $DBIx::Class::ResultSource::__expected_result_class_isa
+                  ||
+                emit_loud_diag(
+                  confess => 1,
+                  msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...'
+                )
+              )
+            )
           )
             and
           1
@@ -2346,7 +2379,18 @@ sub populate {
 
           # moar sanity check... sigh
           for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) {
-            if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
+            if (
+              defined blessed $_
+                and
+              $_->isa(
+                $DBIx::Class::ResultSource::__expected_result_class_isa
+                  ||
+                emit_loud_diag(
+                  confess => 1,
+                  msg => 'Global $DBIx::Class::ResultSource::__expected_result_class_isa unexpectedly unset...'
+                )
+              )
+            ) {
               carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
               return my $throwaway = $self->populate(@_);
             }
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index e5af674..0c0cb9d 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -31,6 +31,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
@@ -2265,11 +2272,15 @@ 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 )
+      )
     )
   ;
 
@@ -2284,8 +2295,8 @@ sub _resolve_relationship_condition {
     }
     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');
+      $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}) "
@@ -2399,11 +2410,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 "
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 87f3716..4188d10 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -356,7 +356,7 @@ sub insert {
     my $rel_obj = $related_stuff{$rel_name};
 
     if (! $self->{_rel_in_storage}{$rel_name}) {
-      next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
+      next unless (blessed $rel_obj && $rel_obj->isa(__PACKAGE__));
 
       next unless $rsrc->_pk_depends_on(
                     $rel_name, { $rel_obj->get_columns }
@@ -441,7 +441,7 @@ sub insert {
       : $related_stuff{$rel_name}
     ;
 
-    if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
+    if (@cands && blessed $cands[0] && $cands[0]->isa(__PACKAGE__)
     ) {
       my $reverse = $rsrc->reverse_relationship_info($rel_name);
       foreach my $obj (@cands) {
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 4a91bb4..99a895e 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1754,9 +1754,7 @@ sub _gen_sql_bind {
     $op eq 'select'
       and
     grep {
-      length ref $_->[1]
-        and
-      blessed($_->[1])
+      defined blessed($_->[1])
         and
       $_->[1]->isa('DateTime')
     } @$bind