Hi Peter,
The problem goes a little deeper: I applied this change to SVN, and
immediately saw the 60core.t unit test fail doing deep recursion.
Apparently this will break when there's a loop in the relationship
graph. So, to avoid the loop, I made a version of delete_all which
has loop protection. That fixes my unit test, but it breaks again in
60core.t because one of the search_related()->delete() calls produces
ambigious SQL. Sigh.
I attached my patch, which would reproduce this error when aplied to SVN:
make test
...
ok 15 - Correct artist too
DBIx::Class::Relationship::CascadeActions::delete(): DBI Exception:
DBD::SQLite::db prepare_cached failed: ambiguous column name: id2(1)
at dbdimp.c line 271 [for Statement "SELECT
artist_undirected_maps.id1, artist_undirected_maps.id2 FROM
artist_undirected_map me LEFT JOIN artist mapped_artists ON (
mapped_artists.artistid = me.id1 ) OR ( mapped_artists.artistid =
me.id2 ) LEFT JOIN artist_undirected_map artist_undirected_maps ON (
artist_undirected_maps.id1 = mapped_artists.artistid ) OR (
artist_undirected_maps.id2 = mapped_artists.artistid ) WHERE ( ( id1 =
? ) OR ( id2 = ? ) )"] at t/60core.t line 74
I'm not sure how to fix the ambiguous column name error though. Any thoughts?
~Noel
On Fri, Oct 24, 2008 at 2:32 PM, Peter Rabbitson <[EMAIL PROTECTED]> wrote:
> Noel Burton-Krahn wrote:
>> DBIx's cascading delete_all (in DBIx::Class::ResultSet) it broken,
>> because it deletes the parent table before it deletes the children.
>> The database will throw a referential integrity exception when the
>> parent is deleted before the children. I've attached a test program
>> below. Here's a fixed version in
>> DBIx-Class-0.08010/lib/DBIx/Class/Relationship/CascadeActions.pm:
>>
>> Regards,
>> Noel Burton-Krahn
>>
>> ###################################
>> # fixed DBIx/Class/Relationship/CascadeActions.pm in DBIx-Class-0.08010
>>
>> sub delete {
>> my ($self, @rest) = @_;
>>
>> # delete from tables that depend on me first
>> my $source = $self->result_source;
>> my %rels = map { $_ => $source->relationship_info($_) }
>> $source->relationships;
>> my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
>> foreach my $rel (@cascade) {
>> $self->search_related($rel)->delete_all;
>> }
>>
>> # delete me
>> return $self->next::method(@rest) unless ref $self;
>> # I'm just ignoring this for class deletes because hell, the db should
>> # be handling this anyway. Assuming we have joins we probably actually
>> # *could* do them, but I'd rather not.
>>
>> my $ret = $self->next::method(@rest);
>>
>> return $ret;
>> }
>>
>>
>>
>> # Test program
>> ###################################
>> #! /usr/bin/perl -w
>> =head1 NAME
>>
>> dbix_cascade_delete.t - reproduce DBIx's failure in delete_all
>>
>> =head1 DESCRIPTION
>>
>> DBIx::Class::ResultSet::delete_all fails in version 0.08010 because it
>> deletes the parent before the children
>>
>> =head1 AUTHOR
>>
>> Noel Burton-Krahn <[EMAIL PROTECTED]>
>>
>> =cut
>>
>> use strict;
>> use warnings;
>>
>> #--------------------
>> package My::DBIx::Class;
>> use base qw/DBIx::Class/;
>>
>> __PACKAGE__->load_components(qw/PK::Auto Core/);
>>
>> use overload '""' => 'dump';
>>
>> sub dump {
>> my($self) = shift;
>> return join(" ", map { "$_=" . $self->get_column($_) } $self->columns);
>> }
>>
>> #--------------------
>> package MySchema::Person;
>> use base qw/My::DBIx::Class/;
>> __PACKAGE__->table('person');
>> __PACKAGE__->add_columns(qw(person_id name));
>> __PACKAGE__->set_primary_key('person_id');
>> __PACKAGE__->has_many(address => 'MySchema::Address', 'person_id');
>>
>> #--------------------
>> package MySchema::Address;
>> use base qw/My::DBIx::Class/;
>> __PACKAGE__->table('address');
>> __PACKAGE__->add_columns(qw(address_id person_id address));
>> __PACKAGE__->set_primary_key('address_id');
>> __PACKAGE__->belongs_to(person => 'MySchema::Person', 'person_id');
>>
>> #--------------------
>> package MySchema;
>> use base qw/DBIx::Class::Schema/;
>>
>> __PACKAGE__->load_classes({
>> 'MySchema' => [ qw(Person Address) ],
>> });
>>
>> #--------------------
>> package Test::DbixCascaseDelete;
>> use Test::More tests => 16;
>>
>> # create a mysql database to test with
>> system(<<'EOS');
>> mysqladmin -f drop mytest >/dev/null 2>&1
>>
>> mysqladmin create mytest
>>
>> mysql mytest <<ESQL
>> create table person (
>> person_id INT NOT NULL AUTO_INCREMENT PRIMARY KEY
>> ,name VARCHAR(1024) NOT NULL
>> ) ENGINE=INNODB;
>>
>> create table address (
>> address_id INT NOT NULL AUTO_INCREMENT PRIMARY KEY
>> ,person_id INT NOT NULL
>> ,address VARCHAR(1024) NOT NULL
>> ,FOREIGN KEY (person_id) REFERENCES person (person_id)
>> ) ENGINE=INNODB;
>> ESQL
>>
>> #mysql mytest <<ESQL
>> #show tables;
>> #show create table person;
>> #show create table address;
>> #ESQL
>>
>> EOS
>> ;
>> is($?, 0, "create database");
>>
>> # connect
>> my $schema = MySchema->connect("dbi:mysql:mytest", 'script', 'tlby14')
>> or die("connect: $!");
>> ok($schema, "connect to db");
>>
>> #$schema->storage->debug(1);
>>
>> my $rs;
>> my $person;
>>
>> $person = $schema->resultset('Person')->create({ name => 'fred'});
>> ok($person, "create Person: $person");
>>
>> $rs = $schema->resultset('Person')->search();
>> while( my $row = $rs->next() ) {
>> $person = $row;
>> }
>> ok($rs, "found Person: $person");
>>
>> my $address;
>> for my $i (1..3) {
>> $address = $schema->resultset('Address')->create({ person => $person,
>> address => "fred's address $i"});
>> ok($address, "create Address: $address");
>> }
>>
>> $rs = $schema->resultset('Address')->search({ person_id =>
>> $person->person_id });
>> while( my $row = $rs->next ) {
>> $address = $row;
>> ok($address, "found created Address: $address");
>> }
>>
>> ok($address->person, "address->person: " . $address->person->dump);
>>
>> $rs = $person->address_rs;
>> while( my $row = $rs->next ) {
>> $address = $row;
>> ok($address, "person->address: $address");
>> }
>>
>> $rs = $schema->resultset('Person')->search({ name => 'fred'});
>>
>> $rs->delete_all;
>> ok(1, "delete_all");
>>
>> is($rs->count, 0, "Person really gone");
>>
>
> Please submit the lonely pieces of code above as a real diff against
> dbic trunk[1], so the actual set of changes is clearly visible
> (facilitates review and potential inclusion).
>
> Cheers
>
> [1]: svn co http://dev.catalyst.perl.org/repos/bast/DBIx-Class/0.08/trunk
>
> _______________________________________________
> List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
> IRC: irc.perl.org#dbix-class
> SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
> Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk
>
Index: t/100delete_all_cascades.t
===================================================================
--- t/100delete_all_cascades.t (revision 0)
+++ t/100delete_all_cascades.t (revision 0)
@@ -0,0 +1,136 @@
+#! /usr/bin/perl -w
+=head1 NAME
+
+ dbix_cascade_delete.t - reproduce DBIx's failure in delete_all
+
+=head1 DESCRIPTION
+
+DBIx::Class::ResultSet::delete_all fails in version 0.08010 because it
+deletes the parent before the children
+
+=head1 AUTHOR
+
+Noel Burton-Krahn <[EMAIL PROTECTED]>
+
+=cut
+
+use strict;
+use warnings;
+
+#--------------------
+package My::DBIx::Class;
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/PK::Auto Core/);
+
+use overload '""' => 'dump';
+
+sub dump {
+ my($self) = shift;
+ return join(" ", map { "$_=" . $self->get_column($_) } $self->columns);
+}
+
+#--------------------
+package MySchema::Person;
+use base qw/My::DBIx::Class/;
+__PACKAGE__->table('person');
+__PACKAGE__->add_columns(qw(id name));
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->has_many(address => 'MySchema::Address', 'person_id');
+
+#--------------------
+package MySchema::Address;
+use base qw/My::DBIx::Class/;
+__PACKAGE__->table('address');
+__PACKAGE__->add_columns(qw(id person_id address));
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->belongs_to(person => 'MySchema::Person', 'person_id');
+
+#--------------------
+package MySchema;
+use base qw/DBIx::Class::Schema/;
+
+__PACKAGE__->load_classes({
+ 'MySchema' => [ qw(Person Address) ],
+});
+
+#--------------------
+package Test::DbixCascaseDelete;
+use Test::More tests => 16;
+
+# create a mysql database to test with
+system(<<'EOS');
+mysqladmin -f drop mytest >/dev/null 2>&1
+
+mysqladmin create mytest
+
+mysql mytest <<ESQL
+create table person (
+ id INT NOT NULL AUTO_INCREMENT PRIMARY KEY
+ ,name VARCHAR(1024) NOT NULL
+) ENGINE=INNODB;
+
+create table address (
+ id INT NOT NULL AUTO_INCREMENT PRIMARY KEY
+ ,person_id INT NOT NULL
+ ,address VARCHAR(1024) NOT NULL
+ ,FOREIGN KEY (person_id) REFERENCES person (id)
+) ENGINE=INNODB;
+ESQL
+
+#mysql mytest <<ESQL
+#show tables;
+#show create table person;
+#show create table address;
+#ESQL
+
+EOS
+ ;
+is($?, 0, "create database");
+
+# connect
+my $schema = MySchema->connect("dbi:mysql:mytest", 'script', 'tlby14') or die("connect: $!");
+ok($schema, "connect to db");
+
+#$schema->storage->debug(1);
+
+my $rs;
+my $person;
+
+$person = $schema->resultset('Person')->create({ name => 'fred'});
+ok($person, "create Person: $person");
+
+$rs = $schema->resultset('Person')->search();
+while( my $row = $rs->next() ) {
+ $person = $row;
+}
+ok($rs, "found Person: $person");
+
+my $address;
+for my $i (1..3) {
+ $address = $schema->resultset('Address')->create({ person => $person, address => "fred's address $i"});
+ ok($address, "create Address: $address");
+}
+
+$rs = $schema->resultset('Address');
+while( my $row = $rs->next ) {
+ $address = $row;
+ ok($address, "found created Address: $address");
+}
+
+ok($address->person, "address->person: " . $address->person->dump);
+
+$rs = $person->search_related('address');
+while( my $row = $rs->next ) {
+ $address = $row;
+ ok($address, "person->address: $address");
+}
+
+$rs = $schema->resultset('Person')->search({ name => 'fred'});
+
+$rs->delete_all;
+ok(1, "delete_all");
+
+is($rs->count, 0, "Person really gone");
+
+
Index: lib/DBIx/Class/ResultSet.pm
===================================================================
--- lib/DBIx/Class/ResultSet.pm (revision 4975)
+++ lib/DBIx/Class/ResultSet.pm (working copy)
@@ -1319,6 +1319,34 @@
return 1;
}
+=head2 _delete_all_recursive
+
+internal function to delete all related tables recursively with loop
+protection.
+
+=cut
+sub _delete_all_recursive {
+ my ($self) = shift;
+ my ($visited) = @_;
+
+ # delete from my tables that depend on me
+ my $source = $self->result_source;
+ foreach my $rel ($source->relationships) {
+ my $relinfo = $source->relationship_info($rel);
+
+ # debug
+ #my $revinfo = $source->reverse_relationship_info($rel);
+ #use Data::Dumper;
+ #warn("rel=$rel relinfo=" . Dumper($relinfo) . " revinfo=" . Dumper($revinfo));
+
+ next unless $relinfo->{attrs}{cascade_delete};
+ next if( $visited->{$rel} );
+ $visited->{$rel} = 1;
+ $self->search_related($rel)->_delete_all_recursive($visited);
+ }
+ $_->delete for $self->all;
+}
+
=head2 delete_all
=over 4
@@ -1333,10 +1361,14 @@
will run DBIC cascade triggers, while L</delete> will not.
=cut
-
sub delete_all {
my ($self) = @_;
- $_->delete for $self->all;
+
+ # delete all my dependent tables recursively careful to avoid loops
+ $self->_delete_all_recursive({});
+
+ #$_->delete for $self->all;
+
return 1;
}
_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk
