Fix unpredictable use of reverse_relationship_info() in the SQLT parser

When reverse_relationship_info got introduced in de60a93d, it was inexplicably
mis-applied at the very spot it was needed in the first place. A result class
pair can (and sometimes do) have more than one relationship between them,
possibly with differing cascade_* settings. Grabbing the first set of values
from the multi-member hash is inconsistent at best.

Fix so that if at least one "hard-dependency" is encountered we go ahead with
marking the reverse part as a CASCADE

diff --git a/Changes b/Changes
index 8ca5192..91c525b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -69,6 +69,8 @@ Revision history for DBIx::Class
         - Fix spurious warning on MSSQL cursor invalidation retries (RT#102166)
         - Fix incorrect ::Storage->_ping() behavior under Sybase (RT#114214)
         - Fix several corner cases with Many2Many over custom relationships
+        - Fix intermittent failure to infer the CASCADE attributes of relations
+          during deployment_statements()/deploy()
         - Fix corner cases of C3 composition being broken on OLD_MRO (5.8.x)
           only: https://github.com/frioux/DBIx-Class-Helpers/issues/61
 

diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index 74d455a..623171e 100644 (file)
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -230,9 +230,9 @@ sub parse {
                 $fk_constraint = not $source->_compare_relationship_keys(\@keys, \@primary);
             }
 
-            my ($otherrelname, $otherrelationship) = %{ $source->reverse_relationship_info($rel) };
 
             my $cascade;
+            CASCADE_TYPE:
             for my $c (qw/delete update/) {
                 if (exists $rel_info->{attrs}{"on_$c"}) {
                     if ($fk_constraint) {
@@ -243,8 +243,16 @@ sub parse {
                             . "If you are sure that SQLT must generate a constraint for this relationship, add 'is_foreign_key_constraint => 1' to the attributes.\n";
                     }
                 }
-                elsif (defined $otherrelationship and $otherrelationship->{attrs}{$c eq 'update' ? 'cascade_copy' : 'cascade_delete'}) {
-                    $cascade->{$c} = 'CASCADE';
+                else {
+                  for my $revrelinfo (values %{ $source->reverse_relationship_info($rel) } ) {
+                    ( ( $cascade->{$c} = 'CASCADE' ), next CASCADE_TYPE ) if (
+                      $revrelinfo->{attrs}
+                                  ->{ ($c eq 'update')
+                                      ? 'cascade_copy'
+                                      : 'cascade_delete'
+                                    }
+                    );
+                  }
                 }
             }
 

diff --git a/t/lib/DBICTest/Schema/SelfRef.pm b/t/lib/DBICTest/Schema/SelfRef.pm
index 41ae6d9..8bcd243 100644 (file)
--- a/t/lib/DBICTest/Schema/SelfRef.pm
+++ b/t/lib/DBICTest/Schema/SelfRef.pm
@@ -20,5 +20,6 @@ __PACKAGE__->add_columns(
 __PACKAGE__->set_primary_key('id');
 
 __PACKAGE__->has_many( aliases => 'DBICTest::Schema::SelfRefAlias' => 'self_ref' );
+__PACKAGE__->has_many( aliases_no_copy => 'DBICTest::Schema::SelfRefAlias' => 'self_ref', { cascade_copy => 0 } );
 
 1;