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 our %_pod_inherit_config =
   8   (
   9    class_map => { 'DBIx::Class::Relationship::CascadeActions' => 'DBIx::Class::Relationship' }
  10   );
  11
  12 sub delete {
  13   my ($self, @rest) = @_;
  14   return $self->next::method(@rest) unless ref $self;
  15     # I'm just ignoring this for class deletes because hell, the db should
  16     # be handling this anyway. Assuming we have joins we probably actually
  17     # *could* do them, but I'd rather not.
  18
  19   my $source = $self->result_source;
  20   my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
  21   my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
  22
  23   if (@cascade) {
  24     my $guard = $source->schema->txn_scope_guard;
  25
  26     my $ret = $self->next::method(@rest);
  27
  28     foreach my $rel (@cascade) {
  29       $self->search_related($rel)->delete_all;
  30     }
  31
  32     $guard->commit;
  33     return $ret;
  34   }
  35
  36   $self->next::method(@rest);
  37 }
  38
  39 sub update {
  40   my ($self, @rest) = @_;
  41   return $self->next::method(@rest) unless ref $self;
  42     # Because update cascades on a class *really* don't make sense!
  43
  44   my $source = $self->result_source;
  45   my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
  46   my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
  47
  48   if (@cascade) {
  49     my $guard = $source->schema->txn_scope_guard;
  50
  51     my $ret = $self->next::method(@rest);
  52
  53     foreach my $rel (@cascade) {
  54       next if (
  55         $rels{$rel}{attrs}{accessor}
  56           &&
  57         $rels{$rel}{attrs}{accessor} eq 'single'
  58           &&
  59         !exists($self->{_relationship_data}{$rel})
  60       );
  61       $_->update for grep defined, $self->$rel;
  62     }
  63
  64     $guard->commit;
  65     return $ret;
  66   }
  67
  68   $self->next::method(@rest);
  69 }
  70
  71 1;