File Coverage

blib/lib/autouse.pm
Criterion Covered Total %
statement 43 46 93.4
branch 14 24 58.3
condition 4 8 50.0
subroutine 6 6 100.0
pod 0 2 0.0
total 67 86 77.9


line stmt bran cond sub pod time code
1             package autouse;
2              
3             #use strict; # debugging only
4 1     1   64037 use 5.006; # use warnings
  1         4  
  1         413  
5              
6             $autouse::VERSION = '1.08';
7              
8             $autouse::DEBUG ||= 0;
9              
10             sub vet_import ($);
11              
12             sub croak {
13 1     1 0 10 require Carp;
14 1         293 Carp::croak(@_);
15             }
16              
17             sub import {
18 9 50   9   9744 my $class = @_ ? shift : 'autouse';
19 9 50       24 croak "usage: use $class MODULE [,SUBS...]" unless @_;
20 9         11 my $module = shift;
21              
22 9         22 (my $pm = $module) =~ s{::}{/}g;
23 9         20 $pm .= '.pm';
24 9 100       25 if (exists $INC{$pm}) {
25 5         9 vet_import $module;
26 5         10 local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
27             # $Exporter::Verbose = 1;
28 5         7 return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_);
  7         15  
  7         3279  
29             }
30              
31             # It is not loaded: need to do real work.
32 4         10 my $callpkg = caller(0);
33 4 50       66 print "autouse called from $callpkg\n" if $autouse::DEBUG;
34              
35 4         7 my $index;
36 4         19 for my $f (@_) {
37 4         4 my $proto;
38 4 50       13 $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
39              
40 4         6 my $closure_import_func = $func; # Full name
41 4         6 my $closure_func = $func; # Name inside package
42 4         8 my $index = rindex($func, '::');
43 4 50       9 if ($index == -1) {
44 4         10 $closure_import_func = "${callpkg}::$func";
45             } else {
46 0         0 $closure_func = substr $func, $index + 2;
47 0 0       0 croak "autouse into different package attempted"
48             unless substr($func, 0, $index) eq $module;
49             }
50              
51             my $load_sub = sub {
52 3 100   3   6324 unless ($INC{$pm}) {
53 2         3138 require $pm;
54 2         5425 vet_import $module;
55             }
56 1     1   6 no warnings qw(redefine prototype);
  1         2  
  1         313  
57 2         5 *$closure_import_func = \&{"${module}::$closure_func"};
  2         22  
58 2 50       10 print "autousing $module; "
59             ."imported $closure_func as $closure_import_func\n"
60             if $autouse::DEBUG;
61 2         21 goto &$closure_import_func;
62 4         35 };
63              
64 4 50       13 if (defined $proto) {
65 0   0     0 *$closure_import_func = eval "sub ($proto) { goto &\$load_sub }"
66             || die;
67             } else {
68 4         333 *$closure_import_func = $load_sub;
69             }
70             }
71             }
72              
73             sub vet_import ($) {
74 7     7 0 12 my $module = shift;
75 7 50       103 if (my $import = $module->can('import')) {
76 7 100 100     57 croak "autoused module $module has unique import() method"
      33        
77             unless defined(&Exporter::import)
78             && ($import == \&Exporter::import ||
79             $import == \&UNIVERSAL::import)
80             }
81             }
82              
83             1;
84              
85             __END__