Profile of DBIx/Class/Relationship/CascadeActions.pm

Filename	/usr/share/perl5/DBIx/Class/Relationship/CascadeActions.pm
Statements	Executed 10 statements in 714µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	17µs	25µs	DBIx::Class::Relationship::CascadeActions::BEGIN@4
1	1	1	8µs	13µs	DBIx::Class::Relationship::CascadeActions::BEGIN@5
1	1	1	7µs	38µs	DBIx::Class::Relationship::CascadeActions::BEGIN@6
1	1	1	7µs	118µs	DBIx::Class::Relationship::CascadeActions::BEGIN@7
0	0	0	0s	0s	DBIx::Class::Relationship::CascadeActions::delete
0	0	0	0s	0s	DBIx::Class::Relationship::CascadeActions::update

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package # hide from PAUSE
2					DBIx::Class::Relationship::CascadeActions;
3
4	2	40µs	2	33µs	# spent 25µs (17+8) within DBIx::Class::Relationship::CascadeActions::BEGIN@4 which was called: # once (17µs+8µs) by Class::C3::Componentised::ensure_class_loaded at line 4 use strict; # spent 25µs making 1 call to DBIx::Class::Relationship::CascadeActions::BEGIN@4 # spent 8µs making 1 call to strict::import
5	2	30µs	2	18µs	# spent 13µs (8+5) within DBIx::Class::Relationship::CascadeActions::BEGIN@5 which was called: # once (8µs+5µs) by Class::C3::Componentised::ensure_class_loaded at line 5 use warnings; # spent 13µs making 1 call to DBIx::Class::Relationship::CascadeActions::BEGIN@5 # spent 5µs making 1 call to warnings::import
6	2	24µs	2	69µs	# spent 38µs (7+31) within DBIx::Class::Relationship::CascadeActions::BEGIN@6 which was called: # once (7µs+31µs) by Class::C3::Componentised::ensure_class_loaded at line 6 use DBIx::Class::Carp; # spent 38µs making 1 call to DBIx::Class::Relationship::CascadeActions::BEGIN@6 # spent 31µs making 1 call to DBIx::Class::Carp::import
7	2	615µs	2	230µs	# spent 118µs (7+111) within DBIx::Class::Relationship::CascadeActions::BEGIN@7 which was called: # once (7µs+111µs) by Class::C3::Componentised::ensure_class_loaded at line 7 use namespace::clean; # spent 118µs making 1 call to DBIx::Class::Relationship::CascadeActions::BEGIN@7 # spent 111µs making 1 call to namespace::clean::import
8
9	1	2µs			our %_pod_inherit_config =
10					(
11					class_map => { 'DBIx::Class::Relationship::CascadeActions' => 'DBIx::Class::Relationship' }
12					);
13
14					sub delete {
15					my ($self, @rest) = @_;
16					return $self->next::method(@rest) unless ref $self;
17					# I'm just ignoring this for class deletes because hell, the db should
18					# be handling this anyway. Assuming we have joins we probably actually
19					# could do them, but I'd rather not.
20
21					my $source = $self->result_source;
22					my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
23					my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
24
25					if (@cascade) {
26					my $guard = $source->schema->txn_scope_guard;
27
28					my $ret = $self->next::method(@rest);
29
30					foreach my $rel (@cascade) {
31					if( my $rel_rs = eval{ $self->search_related($rel) } ) {
32					$rel_rs->delete_all;
33					} else {
34					carp "Skipping cascade delete on relationship '$rel' - related resultsource '$rels{$rel}{class}' is not registered with this schema";
35					next;
36					}
37					}
38
39					$guard->commit;
40					return $ret;
41					}
42
43					$self->next::method(@rest);
44					}
45
46					sub update {
47					my ($self, @rest) = @_;
48					return $self->next::method(@rest) unless ref $self;
49					# Because update cascades on a class really don't make sense!
50
51					my $source = $self->result_source;
52					my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
53					my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
54
55					if (@cascade) {
56					my $guard = $source->schema->txn_scope_guard;
57
58					my $ret = $self->next::method(@rest);
59
60					foreach my $rel (@cascade) {
61					next if (
62					$rels{$rel}{attrs}{accessor}
63					&&
64					$rels{$rel}{attrs}{accessor} eq 'single'
65					&&
66					!exists($self->{_relationship_data}{$rel})
67					);
68					$_->update for grep defined, $self->$rel;
69					}
70
71					$guard->commit;
72					return $ret;
73					}
74
75					$self->next::method(@rest);
76					}
77
78	1	3µs	1	92µs	1; # spent 92µs making 1 call to B::Hooks::EndOfScope::XS::__ANON__