Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE |
2 | DBIx::Class::Relationship::CascadeActions; |
4a07648a |
3 | |
bf5ecff9 |
4 | use strict; |
5 | use warnings; |
70c28808 |
6 | use DBIx::Class::Carp; |
ddcc02d1 |
7 | use DBIx::Class::_Util 'dbic_internal_try'; |
64c50e81 |
8 | use namespace::clean; |
bf5ecff9 |
9 | |
8273e845 |
10 | our %_pod_inherit_config = |
044e70c7 |
11 | ( |
12 | class_map => { 'DBIx::Class::Relationship::CascadeActions' => 'DBIx::Class::Relationship' } |
13 | ); |
14 | |
4a07648a |
15 | sub delete { |
16 | my ($self, @rest) = @_; |
147dd158 |
17 | return $self->next::method(@rest) unless ref $self; |
4a07648a |
18 | # I'm just ignoring this for class deletes because hell, the db should |
19 | # be handling this anyway. Assuming we have joins we probably actually |
20 | # *could* do them, but I'd rather not. |
21 | |
71e65b39 |
22 | my $source = $self->result_source; |
23 | my %rels = map { $_ => $source->relationship_info($_) } $source->relationships; |
4a07648a |
24 | my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels; |
fb61e30c |
25 | |
26 | if (@cascade) { |
27 | my $guard = $source->schema->txn_scope_guard; |
28 | |
29 | my $ret = $self->next::method(@rest); |
30 | |
31 | foreach my $rel (@cascade) { |
ddcc02d1 |
32 | if( my $rel_rs = dbic_internal_try { $self->search_related($rel) } ) { |
51c9ead2 |
33 | $rel_rs->delete_all; |
34 | } else { |
35 | carp "Skipping cascade delete on relationship '$rel' - related resultsource '$rels{$rel}{class}' is not registered with this schema"; |
36 | next; |
37 | } |
fb61e30c |
38 | } |
39 | |
40 | $guard->commit; |
41 | return $ret; |
4a07648a |
42 | } |
fb61e30c |
43 | |
44 | $self->next::method(@rest); |
4a07648a |
45 | } |
46 | |
47 | sub update { |
48 | my ($self, @rest) = @_; |
147dd158 |
49 | return $self->next::method(@rest) unless ref $self; |
4a07648a |
50 | # Because update cascades on a class *really* don't make sense! |
51 | |
71e65b39 |
52 | my $source = $self->result_source; |
53 | my %rels = map { $_ => $source->relationship_info($_) } $source->relationships; |
4a07648a |
54 | my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels; |
fb61e30c |
55 | |
56 | if (@cascade) { |
57 | my $guard = $source->schema->txn_scope_guard; |
58 | |
59 | my $ret = $self->next::method(@rest); |
60 | |
61 | foreach my $rel (@cascade) { |
62 | next if ( |
63 | $rels{$rel}{attrs}{accessor} |
64 | && |
65 | $rels{$rel}{attrs}{accessor} eq 'single' |
66 | && |
67 | !exists($self->{_relationship_data}{$rel}) |
68 | ); |
69 | $_->update for grep defined, $self->$rel; |
70 | } |
71 | |
72 | $guard->commit; |
73 | return $ret; |
4a07648a |
74 | } |
fb61e30c |
75 | |
76 | $self->next::method(@rest); |
4a07648a |
77 | } |
78 | |
79 | 1; |