File Coverage

blib/lib/Aspect/Pointcut/Throwing.pm
Criterion Covered Total %
statement 35 36 97.2
branch 5 6 83.3
condition n/a
subroutine 11 11 100.0
pod 3 3 100.0
total 54 56 96.4


line stmt bran cond sub pod time code
1             package Aspect::Pointcut::Throwing;
2              
3 26     26   179 use strict;
  26         48  
  26         1094  
4 26     26   142 use Carp ();
  26         45  
  26         418  
5 26     26   136 use Params::Util ();
  26         57  
  26         367  
6 26     26   131 use Aspect::Pointcut ();
  26         46  
  26         372  
7 26     26   135 use Aspect::Pointcut::Not ();
  26         46  
  26         388  
8 26     26   15495 use Aspect::Pointcut::Returning ();
  26         72  
  26         8987  
9              
10             our $VERSION = '1.04';
11             our @ISA = 'Aspect::Pointcut';
12              
13              
14              
15              
16              
17             ######################################################################
18             # Constructor
19              
20             sub new {
21 21     21 1 49 my $class = shift;
22 21         41 my $spec = shift;
23              
24             # Handle the any exception case
25 21 100       73 unless ( defined $spec ) {
26 18         328 return bless [
27             $spec,
28             '$Aspect::POINT->{exception}',
29             ], $class;
30             }
31              
32             # Handle a specific die message
33 3 100       14 if ( Params::Util::_STRING($spec) ) {
34 2         85 return bless [
35             $spec,
36             "Params::Util::_INSTANCE(\$Aspect::POINT->{exception}, '$spec')",
37             ], $class;
38             }
39              
40             # Handle a specific exception class
41 1 50       5 if ( Params::Util::_REGEX($spec) ) {
42 1         3 my $regex = "/$spec/";
43 1         5 $regex =~ s|^/\(\?([xism]*)-[xism]*:(.*)\)/\z|/$2/$1|s;
44 1         82 return bless [
45             $spec,
46             "defined \$Aspect::POINT->{exception} and not ref \$Aspect::POINT->{exception} and \$Aspect::POINT->{exception} =~ $regex",
47             ], $class;
48             }
49              
50 0         0 Carp::croak("Invalid throwing pointcut specification");
51             }
52              
53              
54              
55              
56              
57             ######################################################################
58             # Weaving Methods
59              
60             # Exception pointcuts always match at weave time and should curry away
61             sub curry_weave {
62 21     21 1 54 return;
63             }
64              
65             # Throwing pointcuts do not curry.
66             # (But maybe they should, when used with say a before {} block)
67             sub curry_runtime {
68 21     21 1 79 return $_[0];
69             }
70              
71             sub compile_runtime {
72             $_[0]->[1];
73             }
74              
75              
76              
77              
78              
79             ######################################################################
80             # Optional XS Acceleration
81              
82             BEGIN {
83 26     26   65 local $@;
84 26     26   2876 eval <<'END_PERL';
  26         162  
  26         796  
  26         282  
85             use Class::XSAccessor::Array 1.08 {
86             replace => 1,
87             getters => {
88             'compile_runtime' => 1,
89             },
90             };
91             END_PERL
92             }
93              
94             1;
95              
96             __END__