File Coverage

blib/lib/Acme/AutoloadAll.pm
Criterion Covered Total %
statement 35 35 100.0
branch 13 18 72.2
condition 6 10 60.0
subroutine 6 6 100.0
pod 0 1 0.0
total 60 70 85.7


line stmt bran cond sub pod time code
1             package Acme::AutoloadAll;
2             # ABSTRACT: Use every function everywhere.
3              
4             our $VERSION = '0.005'; # VERSION
5              
6 2     2   24553 use strict;
  2         3  
  2         83  
7 2     2   12 use warnings;
  2         3  
  2         170  
8              
9             our $DEBUG = 0;
10              
11             BEGIN {
12             $SIG{__WARN__} = sub {
13 1 50       35 warn @_ unless $_[0] =~ m/inherited AUTOLOAD/;
14 2     2   257 };
15             }
16              
17             sub find_function {
18 100     100 0 117 my $function = shift;
19 100   100     185 my $package = shift || 'main';
20 100   100     186 my $seen = shift || {};
21             # remove last ::
22 100         402 $package =~ s/::$//;
23              
24 100 100       234 return undef if (exists($seen->{$package}));
25              
26 99 50       166 print STDERR "Searching '$function' in '$package'...\n" if ($DEBUG);
27              
28             # check if the current package has the function
29 99         1443 my $sub = $package->can($function);
30 99 50 33     223 print STDERR "Found!\n" if ($DEBUG && (ref($sub) eq 'CODE'));
31 99 100       177 return $sub if (ref($sub) eq 'CODE');
32              
33 98         161 $seen->{$package} = 1;
34              
35             # check sub packages
36 2     2   10 my $symbols = do { no strict 'refs'; \%{$package . '::'} };
  2         5  
  2         442  
  98         100  
  98         87  
  98         240  
37 98         608 my @packages = grep { $_ =~ m/::$/ } keys(%$symbols);
  1721         2797  
38 98         244 foreach my $pkg (@packages) {
39 99 100       288 $pkg = $package . '::' . $pkg unless ($package eq 'main');
40 99         172 $sub = find_function($function, $pkg, $seen);
41 99 100       273 return $sub if (ref($sub) eq 'CODE');
42             }
43              
44             # not found
45 96         192 return undef;
46             }
47              
48             sub UNIVERSAL::AUTOLOAD {
49 1     1   10 (my $function = $UNIVERSAL::AUTOLOAD) =~ s/.*:://;
50 1         5 my $sub = find_function($function);
51 1 50 33     7 print STDERR "Not found!\n" if ($DEBUG && (ref($sub) ne 'CODE'));
52 1 50       15 goto &$sub if (ref($sub) eq 'CODE');
53             }
54              
55             1;
56              
57             __END__