| File | /project/perl/lib/Class/DBI/Cascade/None.pm |
| Statements Executed | 11 |
| Statement Execution Time | 493µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 1 | 1 | 99µs | 99µs | Class::DBI::Cascade::None::new |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Cascade::None::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Cascade::None::cascade |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Cascade::None::foreign_for |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::DBI::Cascade::None; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| 5 | Class::DBI::Cascade::None - Do nothing upon deletion | ||||
| 6 | |||||
| 7 | =head1 DESCRIPTION | ||||
| 8 | |||||
| 9 | This is a Cascading Delete strategy that will do nothing, leaving | ||||
| 10 | orphaned records behind. | ||||
| 11 | |||||
| 12 | It is the base class for most ofther Cascade strategies, and so provides | ||||
| 13 | several important methods: | ||||
| 14 | |||||
| 15 | =head1 CONSTRUCTOR | ||||
| 16 | |||||
| 17 | =head2 new | ||||
| 18 | |||||
| 19 | my $strategy = Cascade::Class->new($Relationship); | ||||
| 20 | |||||
| 21 | This must be instantiated with a Class::DBI::Relationship object. | ||||
| 22 | |||||
| 23 | =head1 METHODS | ||||
| 24 | |||||
| 25 | =head2 foreign_for | ||||
| 26 | |||||
| 27 | my $iterator = $strategy->foreign_for($obj); | ||||
| 28 | |||||
| 29 | This will return all the objects which are foreign to $obj across the | ||||
| 30 | relationship. It's a normal Class::DBI search you can get the results | ||||
| 31 | either as a list or as an iterator. | ||||
| 32 | |||||
| 33 | =head2 cascade | ||||
| 34 | |||||
| 35 | $strategy->cascade($obj); | ||||
| 36 | |||||
| 37 | Cascade across the related objects to $obj. | ||||
| 38 | |||||
| 39 | =head1 WRITING NEW STRATEGIES | ||||
| 40 | |||||
| 41 | Creating a Cascade strategy should be fairly simple. You usually just | ||||
| 42 | need to inherit from here, and then supply a cascade() method that does | ||||
| 43 | the required thing with the results from foreign_for(). | ||||
| 44 | |||||
| 45 | So, for example, Cascade::Delete is implemented simply as: | ||||
| 46 | |||||
| 47 | package Class::DBI::Cascade::Delete; | ||||
| 48 | |||||
| 49 | use base 'Class::DBI::Cascade::None'; | ||||
| 50 | |||||
| 51 | sub cascade { | ||||
| 52 | my ($self, $obj) = @_; | ||||
| 53 | $self->foreign_for($obj)->delete_all; | ||||
| 54 | } | ||||
| 55 | |||||
| 56 | =cut | ||||
| 57 | |||||
| 58 | 3 | 87µs | 1 | 26µs | use strict; # spent 26µs making 1 call to strict::import |
| 59 | 3 | 285µs | 1 | 116µs | use warnings; # spent 116µs making 1 call to warnings::import |
| 60 | |||||
| 61 | # spent 99µs within Class::DBI::Cascade::None::new which was called 2 times, avg 50µs/call:
# 2 times (99µs+0s) by Class::DBI::Relationship::HasMany::triggers at line 74 of Class/DBI/Relationship/HasMany.pm, avg 50µs/call | ||||
| 62 | 2 | 15µs | my ($class, $rel) = @_; | ||
| 63 | 2 | 94µs | bless { _rel => $rel } => $class; | ||
| 64 | } | ||||
| 65 | |||||
| 66 | sub foreign_for { | ||||
| 67 | my ($self, $obj) = @_; | ||||
| 68 | return $self->{_rel} | ||||
| 69 | ->foreign_class->search($self->{_rel}->args->{foreign_key} => $obj->id); | ||||
| 70 | } | ||||
| 71 | |||||
| 72 | sub cascade { return; } | ||||
| 73 | |||||
| 74 | 1 | 12µs | 1; |