Added warnning to $rs->delete which fires if delete is done on a joined/chained resultset

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index e240c64..42dade5 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1293,12 +1293,26 @@ Deletes the contents of the resultset from its result source. Note that this
 will not run DBIC cascade triggers. See L</delete_all> if you need triggers
 to run. See also L<DBIx::Class::Row/delete>.
 
+delete may not generate correct SQL for a query with joins or a resultset
+chained from a related resultset.  In this case it will generate a warning:-
+
+  WARNING! Currently $rs->delete() does not generate proper SQL on
+  joined resultsets, and may delete rows well outside of the contents
+  of $rs. Use at your own risk
+
+In these cases you may find that delete_all is more appropriate, or you
+need to respecify your query in a way that can be expressed without a join.
+
 =cut
 
 sub delete {
   my ($self) = @_;
   $self->throw_exception("Delete should not be passed any arguments")
     if $_[1];
+  carp(   'WARNING! Currently $rs->delete() does not generate proper SQL'
+        . ' on joined resultsets, and may delete rows well outside of the'
+        . ' contents of $rs. Use at your own risk' )
+    if ( $self->{attrs}{seen_join} );
   my $cond = $self->_cond_for_update_delete;
 
   $self->result_source->storage->delete($self->result_source, $cond);

diff --git a/t/53delete_chained.t b/t/53delete_chained.t
new file mode 100644 (file)
index 0000000..4619548
--- /dev/null
+++ b/t/53delete_chained.t
@@ -0,0 +1,45 @@
+use Test::More;
+use strict;
+use warnings;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 9;
+
+# This set of tests attempts to do a delete on a chained resultset, which
+# would lead to SQL DELETE with a JOIN, which is not supported by the 
+# SQL generator right now.
+# So it currently checks that these operations fail with a warning.
+# When the SQL generator is fixed this test will need fixing up appropriately.
+
+my $schema = DBICTest->init_schema();
+my $total_tracks = $schema->resultset('Track')->count;
+cmp_ok($total_tracks, '>', 0, 'need track records');
+
+# test that delete_related w/o conditions deletes all related records only
+{
+  my $w;
+  local $SIG{__WARN__} = sub { $w = shift };
+
+  my $artist = $schema->resultset("Artist")->find(3);
+  my $artist_tracks = $artist->cds->search_related('tracks')->count;
+  cmp_ok($artist_tracks, '<', $total_tracks, 'need more tracks than just related tracks');
+
+  ok(!eval{$artist->cds->search_related('tracks')->delete});
+  cmp_ok($schema->resultset('Track')->count, '==', $total_tracks, 'No tracks should be deleted');
+  like ($w, qr/Currently \$rs->delete\(\) does not generate proper SQL/, 'Delete join warning');
+}
+
+# test that delete_related w/conditions deletes just the matched related records only
+{
+  my $w;
+  local $SIG{__WARN__} = sub { $w = shift };
+
+  my $artist2 = $schema->resultset("Artist")->find(2);
+  my $artist2_tracks = $artist2->search_related('cds')->search_related('tracks')->count;
+  cmp_ok($artist2_tracks, '<', $total_tracks, 'need more tracks than related tracks');
+  
+  ok(!eval{$artist2->search_related('cds')->search_related('tracks')->delete});
+  cmp_ok($schema->resultset('Track')->count, '==', $total_tracks, 'No tracks should be deleted');
+  like ($w, qr/Currently \$rs->delete\(\) does not generate proper SQL/, 'Delete join warning');
+}