File Coverage

blib/lib/Sub/Prepend.pm
Criterion Covered Total %
statement 34 34 100.0
branch 2 2 100.0
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 47 47 100.0


line stmt bran cond sub pod time code
1             package Sub::Prepend;
2 6     6   27443 use 5.006001;
  6         21  
  6         285  
3              
4             $VERSION = 0.01;
5              
6 6     6   34 use Exporter;
  6         12  
  6         456  
7             @ISA = Exporter::;
8             @EXPORT_OK = qw/ prepend /;
9             $EXPORT_TAGS{ALL} = \@EXPORT_OK;
10              
11 6     6   30 use strict;
  6         21  
  6         185  
12 6     6   31 use Carp;
  6         10  
  6         437  
13 6     6   33 use Scalar::Util 1.11 'set_prototype';
  6         129  
  6         565  
14 6     6   4958 use Symbol qw/ qualify_to_ref qualify /;
  6         5291  
  6         406  
15              
16 6     6   37 use vars qw/ $CALLER /;
  6         10  
  6         1038  
17              
18             *CALLER = \1;
19              
20             sub prepend {
21 8     8 1 6476 my ($name, $code) = @_;
22              
23 8         39 my $glob = qualify_to_ref($name => scalar caller);
24              
25 8 100       237 defined &$glob
26             or croak(sprintf __PACKAGE__ . ": Subroutine &%s not defined", qualify($name => scalar caller));
27              
28 7         13 my $orig = \&$glob;
29              
30             my $prepender = set_prototype(
31             sub {
32 7     7   2059 &$code; # Don't use parenthesis!
33 7         1694 goto &$orig;
34             },
35 7         42 prototype $orig
36             );
37              
38             {
39 6     6   31 no warnings 'redefine';
  6         9  
  6         450  
  7         12  
40 7         17 *$glob = $prepender;
41             }
42              
43 7         21 return;
44             }
45              
46             1;
47              
48             __END__