File Coverage

blib/lib/Net/PSYC/Hook.pm
Criterion Covered Total %
statement 28 39 71.7
branch 10 20 50.0
condition n/a
subroutine 3 3 100.0
pod 0 3 0.0
total 41 65 63.0


line stmt bran cond sub pod time code
1             package Net::PSYC::Hook;
2              
3             sub trigger {
4 91     91 0 124 my $self = shift;
5 91         112 my $hook = shift;
6              
7 91 100       361 return 1 if (!exists $self->{'hooks'}->{$hook});
8 15         20 foreach (@{$self->{'hooks'}->{$hook}}) {
  15         36  
9 15 50       415 unless ($_->[0]->(@_)) {
10 0         0 return 0;
11             }
12             }
13 15         40 return 1;
14             }
15              
16             sub hook {
17 4     4 0 11 my $self = shift;
18 4         19 my $hook = shift;
19 4         8 my $obj = shift;
20 4         8 my $prio = shift;
21            
22 4 50       15 unless (ref $obj) {
23 0         0 $obj = eval "$hook->new(\$self);";
24 0 0       0 return 0 if (!ref $obj);
25             }
26 4 50       52 return 0 unless ($obj->can($hook));
27 4 50       17 unless (exists $self->{'hooks'}->{$hook}) {
28 4         13 $self->{'hooks'}->{$hook} = [];
29             }
30 4         1023 my $sub = eval "sub { \$obj->$hook(\@_) }";
31 4 50       20 return 0 unless $sub;
32              
33 4 100       14 if ($prio > 0) {
34 2         3 unshift(@{$self->{'hooks'}->{$hook}}, [$sub, $obj]);
  2         12  
35             } else {
36 2         4 push(@{$self->{'hooks'}->{$hook}}, [$sub, $obj] );
  2         10  
37             }
38 4         14 return 1;
39             }
40              
41             sub rmhook {
42 2     2 0 3 my $self = shift;
43 2         6 my $hook = shift;
44 2         5 my $obj = shift;
45 2         4 my $i = 0;
46 2 50       13 return 1 unless (exists $self->{'hooks'}->{$hook});
47              
48 0           foreach (@{$self->{'hooks'}->{$hook}}) {
  0            
49 0 0         if ($_->[1] eq $obj) {
50 0           splice(@{$self->{'hooks'}->{$hook}}, $i, 1);
  0            
51 0           return 1;
52             }
53 0           $i++;
54             }
55 0           return 0;
56             }
57              
58              
59             1;