File Coverage

inc/Exporter.pm
Criterion Covered Total %
statement 0 44 0.0
branch 0 14 0.0
condition 0 27 0.0
subroutine 0 9 0.0
pod 0 7 0.0
total 0 101 0.0


line stmt bran cond sub pod time code
1             #line 1
2             package Exporter;
3              
4             require 5.006;
5              
6             # Be lean.
7             #use strict;
8             #no strict 'refs';
9              
10             our $Debug = 0;
11             our $ExportLevel = 0;
12             our $Verbose ||= 0;
13             our $VERSION = '5.64_01';
14             our (%Cache);
15              
16 0     0 0   sub as_heavy {
17             require Exporter::Heavy;
18             # Unfortunately, this does not work if the caller is aliased as *name = \&foo
19 0           # Thus the need to create a lot of identical subroutines
20 0           my $c = (caller(1))[3];
21 0           $c =~ s/.*:://;
  0            
22             \&{"Exporter::Heavy::heavy_$c"};
23             }
24              
25 0     0 0   sub export {
  0            
26             goto &{as_heavy()};
27             }
28              
29 0     0     sub import {
30 0           my $pkg = shift;
31             my $callpkg = caller($ExportLevel);
32 0 0 0        
      0        
33 0           if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
  0            
34 0           *{$callpkg."::import"} = \&import;
35             return;
36             }
37              
38 0           # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
  0            
  0            
39 0 0 0       my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"});
      0        
40             return export $pkg, $callpkg, @_
41 0   0       if $Verbose or $Debug or @$fail > 1;
42 0 0         my $export_cache = ($Cache{$pkg} ||= {});
43             my $args = @_ or @_ = @$exports;
44 0            
45 0 0 0       local $_;
46 0           if ($args and not %$export_cache) {
47 0           s/^&//, $export_cache->{$_} = 1
48             foreach (@$exports, @{"$pkg\::EXPORT_OK"});
49 0           }
50             my $heavy;
51             # Try very hard not to use {} and hence have to enter scope on the foreach
52 0 0 0       # We bomb out of the loop with last as soon as heavy is set.
53             if ($args or $fail) {
54             ($heavy = (/\W/ or $args and not exists $export_cache->{$_}
55 0   0       or @$fail and $_ eq $fail->[0])) and last
      0        
56             foreach (@_);
57             } else {
58 0   0       ($heavy = /\W/) and last
59             foreach (@_);
60 0 0         }
    0          
61 0     0     return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy;
62 0           local $SIG{__WARN__} =
  0            
63             sub {require Carp; &Carp::carp};
64 0           # shortcut for the common case of no type character
  0            
  0            
65             *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
66             }
67              
68             # Default methods
69              
70 0     0 0   sub export_fail {
71 0           my $self = shift;
72             @_;
73             }
74              
75             # Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
76             # *name = \&foo. Thus the need to create a lot of identical subroutines
77             # Otherwise we could have aliased them to export().
78              
79 0     0 0   sub export_to_level {
  0            
80             goto &{as_heavy()};
81             }
82              
83 0     0 0   sub export_tags {
  0            
84             goto &{as_heavy()};
85             }
86              
87 0     0 0   sub export_ok_tags {
  0            
88             goto &{as_heavy()};
89             }
90              
91 0     0 0   sub require_version {
  0            
92             goto &{as_heavy()};
93             }
94              
95             1;
96             __END__