Profile: /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship/CascadeActions.pm

File	/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship/CascadeActions.pm
Statements Executed	7
Total Time	0.000354 seconds

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
0	0	0	0	0	DBIx::Class::Relationship::CascadeActions::	BEGIN
0	0	0	0	0	DBIx::Class::Relationship::CascadeActions::	delete
0	0	0	0	0	DBIx::Class::Relationship::CascadeActions::	update

Line	Stmts.	Exclusive Time	Avg.	Code
1				package # hide from PAUSE
2				DBIx::Class::Relationship::CascadeActions;
3
4	3	3.8e-5	1.3e-5	use strict; # spent 17µs making 1 call to strict::import
5	3	0.00031	0.00010	use warnings; # spent 21µs making 1 call to warnings::import
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	3.0e-6	3.0e-6	1;