added tests for required modules, minor documentation update
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Relationship / CascadeActions.pm
CommitLineData
c0e7b4e5 1package # hide from PAUSE
2 DBIx::Class::Relationship::CascadeActions;
4a07648a 3
bf5ecff9 4use strict;
5use warnings;
6
4a07648a 7sub delete {
8 my ($self, @rest) = @_;
147dd158 9 return $self->next::method(@rest) unless ref $self;
4a07648a 10 # I'm just ignoring this for class deletes because hell, the db should
11 # be handling this anyway. Assuming we have joins we probably actually
12 # *could* do them, but I'd rather not.
13
147dd158 14 my $ret = $self->next::method(@rest);
4a07648a 15
71e65b39 16 my $source = $self->result_source;
17 my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
4a07648a 18 my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
19 foreach my $rel (@cascade) {
b1a94f98 20 $self->search_related($rel)->delete_all;
4a07648a 21 }
22 return $ret;
23}
24
25sub update {
26 my ($self, @rest) = @_;
147dd158 27 return $self->next::method(@rest) unless ref $self;
4a07648a 28 # Because update cascades on a class *really* don't make sense!
29
147dd158 30 my $ret = $self->next::method(@rest);
4a07648a 31
71e65b39 32 my $source = $self->result_source;
33 my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
4a07648a 34 my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
35 foreach my $rel (@cascade) {
8417f5ee 36 next if (
37 $rels{$rel}{attrs}{accessor} eq 'single'
38 && !exists($self->{_relationship_data}{$rel})
39 );
b044b5d3 40 $_->update for grep defined, $self->$rel;
4a07648a 41 }
42 return $ret;
43}
44
451;