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;