File Coverage

blib/lib/Acme/AutoloadAll.pm
Criterion Covered Total %
statement 35 35 100.0
branch 12 18 66.6
condition 6 10 60.0
subroutine 6 6 100.0
pod 0 1 0.0
total 59 70 84.2


line stmt bran cond sub pod time code
1             package Acme::AutoloadAll;
2             # ABSTRACT: Use every function everywhere.
3              
4             our $VERSION = '0.002'; # VERSION
5              
6              
7 2     2   13823 use strict;
  2         3  
  2         62  
8 2     2   9 use warnings;
  2         3  
  2         143  
9              
10             our $DEBUG = 0;
11              
12             BEGIN {
13             $SIG{__WARN__} = sub {
14 1 50       19 warn @_ unless $_[0] =~ m/inherited AUTOLOAD/;
15 2     2   235 };
16             }
17              
18             sub find_function {
19 59     59 0 47 my $function = shift;
20 59   100     69 my $package = shift || 'main';
21 59   100     71 my $seen = shift || {};
22             # remove last ::
23 59         109 $package =~ s/::$//;
24              
25 59 50       85 return undef if (exists($seen->{$package}));
26              
27 59 50       65 print STDERR "Searching '$function' in '$package'...\n" if ($DEBUG);
28              
29             # check if the current package has the function
30 59         405 my $sub = $package->can($function);
31 59 50 33     89 print STDERR "Found!\n" if ($DEBUG && (ref($sub) eq 'CODE'));
32 59 100       67 return $sub if (ref($sub) eq 'CODE');
33              
34 58         61 $seen->{$package} = 1;
35              
36             # check sub packages
37 2     2   9 my $symbols = do { no strict 'refs'; \%{$package . '::'} };
  2         6  
  2         384  
  58         39  
  58         32  
  58         69  
38 58         231 my @packages = grep { $_ =~ m/::$/ } keys(%$symbols);
  948         866  
39 58         81 foreach my $pkg (@packages) {
40 58 100       89 $pkg = $package . '::' . $pkg unless ($package eq 'main');
41 58         74 $sub = find_function($function, $pkg, $seen);
42 58 100       92 return $sub if (ref($sub) eq 'CODE');
43             }
44              
45             # not found
46 56         59 return undef;
47             }
48              
49             sub UNIVERSAL::AUTOLOAD {
50 1     1   6 (my $function = $UNIVERSAL::AUTOLOAD) =~ s/.*:://;
51 1         3 my $sub = find_function($function);
52 1 50 33     4 print STDERR "Not found!\n" if ($DEBUG && (ref($sub) ne 'CODE'));
53 1 50       10 goto &$sub if (ref($sub) eq 'CODE');
54             }
55              
56             1;
57              
58             __END__