File Coverage

example/lib/Method/Modifiers.pm
Criterion Covered Total %
statement 33 35 94.2
branch 4 6 66.6
condition 2 3 66.6
subroutine 9 10 90.0
pod 4 4 100.0
total 52 58 89.6


line stmt bran cond sub pod time code
1             package # this is an example for modify_subroutine()/subroutne_modifier().
2             Method::Modifiers;
3              
4 2     2   31734 use strict;
  2         3  
  2         45  
5 2     2   5 use warnings;
  2         2  
  2         63  
6              
7             our $VERSION = '0.65';
8              
9 2     2   7 use Exporter qw(import);
  2         2  
  2         118  
10              
11             our @EXPORT = qw(before around after);
12             our @EXPORT_OK = (@EXPORT, qw(add_method_modifier));
13             our %EXPORT_TAGS = (
14             all => \@EXPORT_OK,
15             moose => \@EXPORT,
16             );
17              
18 2     2   723 use Data::Util ();
  2         2  
  2         216  
19              
20             sub _croak{
21 0     0   0 require Data::Util::Error;
22 0         0 goto &Data::Util::Error::croak;
23             }
24              
25             sub add_method_modifier{
26 12     12 1 11 my $into = shift;
27 12         9 my $type = shift;
28 12         9 my $modifier = pop;
29              
30 12         15 foreach my $name(@_){
31 12         22 my $method = Data::Util::get_code_ref($into, $name);
32              
33 12 100 66     41 if(!$method || !Data::Util::subroutine_modifier($method)){
34              
35 4 50       8 unless($method){
36 4 50       36 $method = $into->can($name)
37             or _croak(qq{The method '$name' is not found in the inheritance hierarchy for class $into});
38             }
39              
40 4         19 $method = Data::Util::modify_subroutine($method, $type => [$modifier]);
41              
42 2     2   9 no warnings 'redefine';
  2         2  
  2         256  
43 4         13 Data::Util::install_subroutine($into, $name => $method);
44             }
45             else{ # $method exists and is modified
46 8         22 Data::Util::subroutine_modifier($method, $type => $modifier);
47             }
48             }
49 12         1070 return;
50             }
51              
52             sub before{
53 4     4 1 20 my $into = caller;
54 4         8 add_method_modifier($into, before => @_);
55             }
56             sub around{
57 4     4 1 19 my $into = caller;
58 4         6 add_method_modifier($into, around => @_);
59             }
60             sub after{
61 4     4 1 446 my $into = caller;
62 4         7 add_method_modifier($into, after => @_);
63             }
64              
65              
66             1;
67             __END__