From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Thu, 25 Jul 2013 15:03:58 +0000 (-0500)
Subject: Further tradeoffs on relationship sanity checking (augments 9e7525a2)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=38fe1ff920de99761b02e5674e83cced61a809a2;p=dbsrgits%2FDBIx-Class-Historic.git

Further tradeoffs on relationship sanity checking (augments 9e7525a2)

It turns out what we did earlier is not enough - what is truly needed is
shutting off *all* checks on non-belongs_to rels. Otherwise industrious devs
will inevitable tie themselves into a circual loading order knot.

The problem (as in 9e7525a2) is not so much that we need to bend over
backwards to support circular loads, but that these problems could very
well be masked by stable hash ordering of perl < 5.18. In other words this
commit serves to prevent perfectly working code from suffering intermittent
and hard-to-debug issues when someone upgrades their perl in 2018.
---

diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index 664f4fd..fd84b30 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -28,12 +28,13 @@ sub has_many {
       $guess = "using our class name '$class' as foreign key source";
     }
 
-    # only perform checks if the far side appears already loaded
-    if (my $f_rsrc = try { $f_class->result_source_instance } ) {
-      $class->throw_exception(
-        "No such column '$f_key' on foreign class ${f_class} ($guess)"
-      ) if !$f_rsrc->has_column($f_key);
-    }
+# FIXME - this check needs to be moved to schema-composition time...
+#    # only perform checks if the far side appears already loaded
+#    if (my $f_rsrc = try { $f_class->result_source_instance } ) {
+#      $class->throw_exception(
+#        "No such column '$f_key' on foreign class ${f_class} ($guess)"
+#      ) if !$f_rsrc->has_column($f_key);
+#    }
 
     $cond = { "foreign.${f_key}" => "self.${pri}" };
   }
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index f1c9ccc..7935a2b 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -35,7 +35,10 @@ sub _has_one {
       $class->ensure_class_loaded($f_class);
 
       $f_rsrc = try {
-        $f_class->result_source_instance;
+        my $r = $f_class->result_source_instance;
+        die "There got to be some columns by now... (exception caught and rewritten by catch below)"
+          unless $r->columns;
+        $r;
       }
       catch {
         $class->throw_exception(
@@ -54,13 +57,14 @@ sub _has_one {
       }
     }
 
-    # only perform checks if the far side was not preloaded above *AND*
-    # appears to have been loaded by something else (has a rsrc_instance)
-    if (! $f_rsrc and $f_rsrc = try { $f_class->result_source_instance }) {
-      $class->throw_exception(
-        "No such column '$f_key' on foreign class ${f_class} ($guess)"
-      ) if !$f_rsrc->has_column($f_key);
-    }
+# FIXME - this check needs to be moved to schema-composition time...
+#    # only perform checks if the far side was not preloaded above *AND*
+#    # appears to have been loaded by something else (has a rsrc_instance)
+#    if (! $f_rsrc and $f_rsrc = try { $f_class->result_source_instance }) {
+#      $class->throw_exception(
+#        "No such column '$f_key' on foreign class ${f_class} ($guess)"
+#      ) if !$f_rsrc->has_column($f_key);
+#    }
 
     $cond = { "foreign.${f_key}" => "self.${pri}" };
   }
diff --git a/t/lib/DBICTest/DynamicForeignCols/Computer.pm b/t/lib/DBICTest/DynamicForeignCols/Computer.pm
new file mode 100644
index 0000000..a74c0ce
--- /dev/null
+++ b/t/lib/DBICTest/DynamicForeignCols/Computer.pm
@@ -0,0 +1,16 @@
+package DBICTest::DynamicForeignCols::Computer;
+
+use warnings;
+use strict;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->table('Computers');
+
+__PACKAGE__->add_columns('id');
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->has_many(computer_test_links => 'DBICTest::DynamicForeignCols::TestComputer', 'computer_id');
+
+1;
diff --git a/t/lib/DBICTest/DynamicForeignCols/TestComputer.pm b/t/lib/DBICTest/DynamicForeignCols/TestComputer.pm
new file mode 100644
index 0000000..ea85aa1
--- /dev/null
+++ b/t/lib/DBICTest/DynamicForeignCols/TestComputer.pm
@@ -0,0 +1,39 @@
+package DBICTest::DynamicForeignCols::TestComputer;
+
+use warnings;
+use strict;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->table('TestComputer');
+__PACKAGE__->add_columns(qw( test_id ));
+__PACKAGE__->_add_join_column({ class => 'DBICTest::DynamicForeignCols::Computer', method => 'computer' });
+__PACKAGE__->set_primary_key('test_id', 'computer_id');
+__PACKAGE__->belongs_to(computer => 'DBICTest::DynamicForeignCols::Computer', 'computer_id');
+
+###
+### This is a pathological case lifted from production. Yes, there is code
+### like this in the wild
+###
+sub _add_join_column {
+   my ($self, $params) = @_;
+
+   my $class = $params->{class};
+   my $method = $params->{method};
+
+   $self->ensure_class_loaded($class);
+
+   my @class_columns = $class->primary_columns;
+
+   if (@class_columns = 1) {
+      $self->add_columns( "${method}_id" );
+   } else {
+      my $i = 0;
+      for (@class_columns) {
+         $i++;
+         $self->add_columns( "${method}_${i}_id" );
+      }
+   }
+}
+
+1;
diff --git a/t/relationship/dynamic_foreign_columns.t b/t/relationship/dynamic_foreign_columns.t
new file mode 100644
index 0000000..a9fc254
--- /dev/null
+++ b/t/relationship/dynamic_foreign_columns.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+require DBICTest::DynamicForeignCols::TestComputer;
+
+is_deeply (
+  [ DBICTest::DynamicForeignCols::TestComputer->columns ],
+  [qw( test_id computer_id )],
+  'All columns properly defined from DBICTest::DynamicForeignCols::Computer parentclass'
+);
+
+done_testing;