Check relationship declarations more consistently

diff --git a/Changes b/Changes
index 6024523..64a472d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -30,6 +30,7 @@ Revision history for DBIx::Class
           mode of a has_many prefetch off a search_related chain
         - Prevent erroneous database hit when accessing prefetched related
           resultsets with no rows
+        - Proper exceptions on malformed relationship conditions (RT#92234)
         - Fix incorrect handling of custom relationship conditions returning
           SQLA literal expressions
         - Fix long standing bug with populate() missing data from hashrefs with

diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm
index 4b1577c..f6ce3a5 100644 (file)
--- a/lib/DBIx/Class/Relationship/BelongsTo.pm
+++ b/lib/DBIx/Class/Relationship/BelongsTo.pm
@@ -60,6 +60,8 @@ sub belongs_to {
   else {
     if (ref $cond eq 'HASH') { # ARRAY is also valid
       my $cond_rel;
+      # FIXME This loop is ridiculously incomplete and dangerous
+      # staving off changes until implmentation of the swindon consensus
       for (keys %$cond) {
         if (m/\./) { # Explicit join condition
           $cond_rel = $cond;

diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index 7935a2b..fbc90f1 100644 (file)
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -91,8 +91,9 @@ sub _validate_has_one_condition {
     my $self_id = $cond->{$foreign_id};
 
     # we can ignore a bad $self_id because add_relationship handles this
-    # warning
+    # exception
     return unless $self_id =~ /^self\.(.*)$/;
+
     my $key = $1;
     $class->throw_exception("Defining rel on ${class} that includes '$key' but no such column defined here yet")
         unless $class->has_column($key);

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 262e2d8..4829904 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1320,10 +1320,11 @@ sub add_relationship {
 
   # Check foreign and self are right in cond
   if ( (ref $cond ||'') eq 'HASH') {
-    for (keys %$cond) {
-      $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
-        if /\./ && !/^foreign\./;
-    }
+    $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
+      for keys %$cond;
+
+    $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
+      for values %$cond;
   }
 
   my %rels = %{ $self->_relationships };

diff --git a/t/relationship/malformed_declaration.t b/t/relationship/malformed_declaration.t
new file mode 100644 (file)
index 0000000..a1abdb7
--- /dev/null
+++ b/t/relationship/malformed_declaration.t
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest::Schema::Artist;
+
+my $pkg = 'DBICTest::Schema::Artist';
+
+for my $call (qw(has_many might_have has_one belongs_to)) {
+  {
+    local $TODO = 'stupid stupid heuristic - needs to die'
+      if $call eq 'belongs_to';
+
+    throws_ok {
+      $pkg->$call( foos => 'nonexistent bars', { foo => 'self.artistid' } );
+    } qr/Malformed relationship condition key 'foo': must be prefixed with 'foreign.'/,
+    "Correct exception on $call with malformed foreign.";
+  }
+
+  throws_ok {
+    $pkg->has_many( foos => 'nonexistent bars', { 'foreign.foo' => 'name' } );
+  } qr/\QMalformed relationship condition value 'name': must be prefixed with 'self.'/,
+  "Correct exception on $call with malformed self.";
+}
+
+done_testing;