From: Robert Buels Date: Sat, 12 Mar 2011 23:06:39 +0000 (-0500) Subject: cascading delete on a nonexistent relation should warn instead of X-Git-Tag: v0.08191~65 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51c9ead29aaceabb3603e89cc9790802fbfe89b3;p=dbsrgits%2FDBIx-Class.git cascading delete on a nonexistent relation should warn instead of dieing uninformatively. --- diff --git a/Changes b/Changes index 1306d67..c54d6a4 100644 --- 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 --- 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 --- 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 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 --- 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;