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     $_->update for grep defined, $self->$rel;
  37   }
  38   return $ret;
  39 }
  40
  41 1;