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"); _______________________________________________ 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