discard_changes is also "refresh from storage"
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Relationship / CascadeActions.pm
1 package # hide from PAUSE
2     DBIx::Class::Relationship::CascadeActions;
3
4 use strict;
5 use warnings;
6
7 sub delete {
8   my ($self, @rest) = @_;
9   return $self->next::method(@rest) unless ref $self;
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
14   my $ret = $self->next::method(@rest);
15
16   my $source = $self->result_source;
17   my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
18   my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
19   foreach my $rel (@cascade) {
20     $self->search_related($rel)->delete_all;
21   }
22   return $ret;
23 }
24
25 sub update {
26   my ($self, @rest) = @_;
27   return $self->next::method(@rest) unless ref $self;
28     # Because update cascades on a class *really* don't make sense!
29
30   my $ret = $self->next::method(@rest);
31
32   my $source = $self->result_source;
33   my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
34   my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
35   foreach my $rel (@cascade) {
36     next if (
37       $rels{$rel}{attrs}{accessor} eq 'single'
38       && !exists($self->{_relationship_data}{$rel})
39     );
40     $_->update for grep defined, $self->$rel;
41   }
42   return $ret;
43 }
44
45 1;