cascading delete on a nonexistent relation should warn instead of

dieing uninformatively.

diff --git a/Changes b/Changes
index 1306d67..c54d6a4 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,7 +9,6 @@ Revision history for DBIx::Class
           plain ::Storage::DBI
 
     * Fixes
-        - Fix exiting via next warnings from ResultSource
         - Fix ::Storage::DBI::* MRO problems on 5.8.x perls
         - Disable mysql_auto_reconnect for MySQL - depending on the ENV
           it sometimes defaults to on and causes major borkage on older
@@ -22,9 +21,12 @@ Revision history for DBIx::Class
           when deploying a schema via sql file
         - Fix reverse_relationship_info on prototypical result sources
           (sources not yet registered with a schema)
+        - Warn and skip relationships missing from a partial schema during
+          dbic cascade_delete
         - Automatically require the requested cursor class before use
           (RT#64795)
         - Work around a Firebird ODBC driver bug exposed by DBD::ODBC 1.29
+        - Fix exiting via next warnings in ResultSource::sequence()
 
     * Misc
         - Only load Class::C3 and friends if necessary ($] < 5.010)

diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index fde8f5d..c46f00c 100644 (file)
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -3,6 +3,7 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
+use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
 
 our %_pod_inherit_config = 
   (
@@ -26,7 +27,12 @@ sub delete {
     my $ret = $self->next::method(@rest);
 
     foreach my $rel (@cascade) {
-      $self->search_related($rel)->delete_all;
+      if( my $rel_rs = eval{ $self->search_related($rel) } ) {
+        $rel_rs->delete_all;
+      } else {
+        carp "Skipping cascade delete on relationship '$rel' - related resultsource '$rels{$rel}{class}' is not registered with this schema";
+        next;
+      }
     }
 
     $guard->commit;

diff --git a/t/60core.t b/t/60core.t
index 0a052b8..d2582f4 100644 (file)
--- a/t/60core.t
+++ b/t/60core.t
@@ -523,12 +523,7 @@ lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't
 {
   my $handle = $schema->source('Artist')->handle;
 
-  my $rowdata = {
-    artistid => 3,
-    charfield => undef,
-    name => "We Are In Rehab",
-    rank => 13
-  };
+  my $rowdata = { $schema->resultset('Artist')->next->get_columns };
 
   my $rs = DBIx::Class::ResultSet->new($handle);
   my $rs_result = $rs->next;

diff --git a/t/delete/cascade_missing.t b/t/delete/cascade_missing.t
new file mode 100644 (file)
index 0000000..f5b95a1
--- /dev/null
+++ b/t/delete/cascade_missing.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Warn;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+$schema->_unregister_source('CD');
+
+warnings_like {
+  lives_ok {
+    $_->delete for $schema->resultset('Artist')->all;
+  } 'delete on rows with dangling rels lives';
+} [
+  # 12 == 3 artists * failed cascades:
+  #   cds
+  #   cds_unordered
+  #   cds_very_very_very_long_relationship_name
+  (qr/skipping cascad/i) x 9
+], 'got warnings about cascading deletes';
+
+done_testing;
+

diff --git a/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm b/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
index 2f4d85f..4ade6a0 100644 (file)
--- a/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
+++ b/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
@@ -15,6 +15,7 @@ __PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_dele
 __PACKAGE__->has_many(
   'mapped_artists', 'DBICTest::Schema::Artist',
   [ {'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'} ],
+  { cascade_delete => 0 },
 );
 
 1;