File Coverage

blib/lib/Aspect/Advice.pm
Criterion Covered Total %
statement 22 25 88.0
branch 4 6 66.6
condition 0 3 0.0
subroutine 8 9 88.8
pod 0 2 0.0
total 34 45 75.5


line stmt bran cond sub pod time code
1             package Aspect::Advice;
2              
3 26     26   136 use strict;
  26         46  
  26         1554  
4 26     26   133 use Carp ();
  26         48  
  26         12998  
5              
6             our $VERSION = '1.04';
7              
8             sub new {
9 155     155 0 372 my $class = shift;
10 155         1188 my $self = bless {
11             @_,
12             installed => 0,
13             }, $class;
14              
15             # Validate the advice and pointcut combination
16 155         828 my $error = $self->_validate;
17 155 50       507 Carp::croak($error) if defined $error;
18              
19             # Install and save the lexical hook
20 155         647 $self->{hook} = $self->_install;
21              
22 155         1173 return $self;
23             }
24              
25             sub code {
26             $_[0]->{code};
27             }
28              
29             sub pointcut {
30             $_[0]->{pointcut};
31             }
32              
33             sub lexical {
34             $_[0]->{lexical};
35             }
36              
37             sub installed {
38 3     3 0 58 $_[0]->{installed};
39             }
40              
41             sub DESTROY {
42 155 100   155   79193 $_[0]->{hook}->() if $_[0]->{hook};
43             }
44              
45              
46              
47              
48              
49             ######################################################################
50             # Installation Internals
51              
52             sub _install {
53 0   0 0   0 my $class = ref $_[0] || $_[0];
54 0         0 die("Method '_install' is not implemented by class '$class'");
55             }
56              
57             sub _validate {
58 155     155   322 my $self = shift;
59              
60             # The use of more than one highest rule in a pointcut is not supported
61 155 50       1025 if ( $self->pointcut->match_contains('Aspect::Pointcut::Highest') > 1 ) {
62 0         0 return "Multiple highest pointcut use is not yet supported";
63             }
64              
65 155         420 return;
66             }
67              
68              
69              
70              
71              
72             ######################################################################
73             # Optional XS Acceleration
74              
75             BEGIN {
76 26     26   63 local $@;
77 26     26   3599 eval <<'END_PERL';
  26         165  
  26         1982  
  26         279  
78             use Class::XSAccessor 1.08 {
79             replace => 1,
80             getters => {
81             'code' => 'code',
82             'pointcut' => 'pointcut',
83             'lexical' => 'lexical',
84             },
85             };
86             END_PERL
87             }
88              
89             1;
90              
91             __END__