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