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.004'; # VERSION
5              
6 2     2   16935 use strict;
  2         3  
  2         69  
7 2     2   8 use warnings;
  2         3  
  2         149  
8              
9             our $DEBUG = 0;
10              
11             BEGIN {
12             $SIG{__WARN__} = sub {
13 1 50       26 warn @_ unless $_[0] =~ m/inherited AUTOLOAD/;
14 2     2   262 };
15             }
16              
17             sub find_function {
18 147     147 0 128 my $function = shift;
19 147   100     225 my $package = shift || 'main';
20 147   100     224 my $seen = shift || {};
21             # remove last ::
22 147         380 $package =~ s/::$//;
23              
24 147 100       269 return undef if (exists($seen->{$package}));
25              
26 146 50       208 print STDERR "Searching '$function' in '$package'...\n" if ($DEBUG);
27              
28             # check if the current package has the function
29 146         1416 my $sub = $package->can($function);
30 146 50 33     258 print STDERR "Found!\n" if ($DEBUG && (ref($sub) eq 'CODE'));
31 146 100       214 return $sub if (ref($sub) eq 'CODE');
32              
33 145         188 $seen->{$package} = 1;
34              
35             # check sub packages
36 2     2   8 my $symbols = do { no strict 'refs'; \%{$package . '::'} };
  2         5  
  2         403  
  145         106  
  145         101  
  145         267  
37 145         830 my @packages = grep { $_ =~ m/::$/ } keys(%$symbols);
  3175         3748  
38 145         342 foreach my $pkg (@packages) {
39 146 100       267 $pkg = $package . '::' . $pkg unless ($package eq 'main');
40 146         194 $sub = find_function($function, $pkg, $seen);
41 146 100       290 return $sub if (ref($sub) eq 'CODE');
42             }
43              
44             # not found
45 143         207 return undef;
46             }
47              
48             sub UNIVERSAL::AUTOLOAD {
49 1     1   10 (my $function = $UNIVERSAL::AUTOLOAD) =~ s/.*:://;
50 1         3 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__