← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:07 2010

File /usr/share/perl/5.10/Exporter/Heavy.pm
Statements Executed 1239
Total Time 0.00705339999999992 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11168µs68µsExporter::Heavy::::_rebuild_cacheExporter::Heavy::_rebuild_cache
0000s0sExporter::Heavy::::BEGINExporter::Heavy::BEGIN
0000s0sExporter::Heavy::::__ANON__[:40]Exporter::Heavy::__ANON__[:40]
0000s0sExporter::Heavy::::__ANON__[:46]Exporter::Heavy::__ANON__[:46]
0000s0sExporter::Heavy::::_push_tagsExporter::Heavy::_push_tags
0000s0sExporter::Heavy::::heavy_exportExporter::Heavy::heavy_export
0000s0sExporter::Heavy::::heavy_export_ok_tagsExporter::Heavy::heavy_export_ok_tags
0000s0sExporter::Heavy::::heavy_export_tagsExporter::Heavy::heavy_export_tags
0000s0sExporter::Heavy::::heavy_export_to_levelExporter::Heavy::heavy_export_to_level
0000s0sExporter::Heavy::::heavy_require_versionExporter::Heavy::heavy_require_version
LineStmts.Exclusive
Time
Avg.Code
1package Exporter::Heavy;
2
3335µs12µsuse strict;
# spent 12µs making 1 call to strict::import
431.27ms422µsno strict 'refs';
# spent 24µs making 1 call to strict::unimport
5
6# On one line so MakeMaker will see it.
724µs2µsrequire Exporter; our $VERSION = $Exporter::VERSION;
8# Carp does this now for us, so we can finally live w/o Carp
9#$Carp::Internal{"Exporter::Heavy"} = 1;
10
11#
12# We go to a lot of trouble not to 'require Carp' at file scope,
13# because Carp requires Exporter, and something has to give.
14#
15
16
# spent 68µs within Exporter::Heavy::_rebuild_cache which was called # once (68µs+0s) by Exporter::Heavy::heavy_export at line 55
sub _rebuild_cache {
17961µs7µs my ($pkg, $exports, $cache) = @_;
18 s/^&// foreach @$exports;
19 @{$cache}{@$exports} = (1) x @$exports;
20 my $ok = \@{"${pkg}::EXPORT_OK"};
21 if (@$ok) {
22 s/^&// foreach @$ok;
23 @{$cache}{@$ok} = (1) x @$ok;
24 }
25}
26
27sub heavy_export {
28
29 # First make import warnings look like they're coming from the "use".
30 local $SIG{__WARN__} = sub {
31 my $text = shift;
32 if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
33 require Carp;
34 local $Carp::CarpLevel = 1; # ignore package calling us too.
35 Carp::carp($text);
36 }
37 else {
38 warn $text;
39 }
4012135.11ms4µs };
41 local $SIG{__DIE__} = sub {
42 require Carp;
43 local $Carp::CarpLevel = 1; # ignore package calling us too.
44 Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
45 if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
46 };
47
48 my($pkg, $callpkg, @imports) = @_;
49 my($type, $sym, $cache_is_current, $oops);
50 my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
51 $Exporter::Cache{$pkg} ||= {});
52
53 if (@imports) {
54 if (!%$export_cache) {
55 _rebuild_cache ($pkg, $exports, $export_cache);
# spent 68µs making 1 call to Exporter::Heavy::_rebuild_cache
56 $cache_is_current = 1;
57 }
58
59 if (grep m{^[/!:]}, @imports) {
60 my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
61 my $tagdata;
62 my %imports;
63 my($remove, $spec, @names, @allexports);
64 # negated first item implies starting with default set:
65 unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
66 foreach $spec (@imports){
67 $remove = $spec =~ s/^!//;
68
69 if ($spec =~ s/^://){
70 if ($spec eq 'DEFAULT'){
71 @names = @$exports;
72 }
73 elsif ($tagdata = $tagsref->{$spec}) {
74 @names = @$tagdata;
75 }
76 else {
77 warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
78 ++$oops;
79 next;
80 }
81 }
82 elsif ($spec =~ m:^/(.*)/$:){
83 my $patn = $1;
84 @allexports = keys %$export_cache unless @allexports; # only do keys once
85 @names = grep(/$patn/, @allexports); # not anchored by default
86 }
87 else {
88 @names = ($spec); # is a normal symbol name
89 }
90
91 warn "Import ".($remove ? "del":"add").": @names "
92 if $Exporter::Verbose;
93
94 if ($remove) {
95 foreach $sym (@names) { delete $imports{$sym} }
96 }
97 else {
98 @imports{@names} = (1) x @names;
99 }
100 }
101 @imports = keys %imports;
102 }
103
104 my @carp;
105 foreach $sym (@imports) {
106 if (!$export_cache->{$sym}) {
107 if ($sym =~ m/^\d/) {
108 $pkg->VERSION($sym); # inherit from UNIVERSAL
109 # If the version number was the only thing specified
110 # then we should act as if nothing was specified:
111 if (@imports == 1) {
112 @imports = @$exports;
113 last;
114 }
115 # We need a way to emulate 'use Foo ()' but still
116 # allow an easy version check: "use Foo 1.23, ''";
117 if (@imports == 2 and !$imports[1]) {
118 @imports = ();
119 last;
120 }
121 } elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
122 # Last chance - see if they've updated EXPORT_OK since we
123 # cached it.
124
125 unless ($cache_is_current) {
126 %$export_cache = ();
127 _rebuild_cache ($pkg, $exports, $export_cache);
128 $cache_is_current = 1;
129 }
130
131 if (!$export_cache->{$sym}) {
132 # accumulate the non-exports
133 push @carp,
134 qq["$sym" is not exported by the $pkg module\n];
135 $oops++;
136 }
137 }
138 }
139 }
140 if ($oops) {
141 require Carp;
142 Carp::croak("@{carp}Can't continue after import errors");
143 }
144 }
145 else {
146 @imports = @$exports;
147 }
148
149 my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
150 $Exporter::FailCache{$pkg} ||= {});
151
152 if (@$fail) {
153 if (!%$fail_cache) {
154 # Build cache of symbols. Optimise the lookup by adding
155 # barewords twice... both with and without a leading &.
156 # (Technique could be applied to $export_cache at cost of memory)
157 my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
158 warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
159 @{$fail_cache}{@expanded} = (1) x @expanded;
160 }
161 my @failed;
162 foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
163 if (@failed) {
164 @failed = $pkg->export_fail(@failed);
165 foreach $sym (@failed) {
166 require Carp;
167 Carp::carp(qq["$sym" is not implemented by the $pkg module ],
168 "on this architecture");
169 }
170 if (@failed) {
171 require Carp;
172 Carp::croak("Can't continue after import errors");
173 }
174 }
175 }
176
177 warn "Importing into $callpkg from $pkg: ",
178 join(", ",sort @imports) if $Exporter::Verbose;
179
180 foreach $sym (@imports) {
181 # shortcut for the common case of no type character
182 (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
183 unless $sym =~ s/^(\W)//;
184 $type = $1;
1853555µs185µs no warnings 'once';
# spent 26µs making 1 call to warnings::unimport
186 *{"${callpkg}::$sym"} =
187 $type eq '&' ? \&{"${pkg}::$sym"} :
188 $type eq '$' ? \${"${pkg}::$sym"} :
189 $type eq '@' ? \@{"${pkg}::$sym"} :
190 $type eq '%' ? \%{"${pkg}::$sym"} :
191 $type eq '*' ? *{"${pkg}::$sym"} :
192 do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
193 }
194}
195
196sub heavy_export_to_level
197{
198512µs2µs my $pkg = shift;
199 my $level = shift;
200 (undef) = shift; # XXX redundant arg
201 my $callpkg = caller($level);
202 $pkg->export($callpkg, @_);
# spent 20µs making 1 call to Exporter::export
203}
204
205# Utility functions
206
207sub _push_tags {
208 my($pkg, $var, $syms) = @_;
209 my @nontag = ();
210 my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
211 push(@{"${pkg}::$var"},
212 map { $export_tags->{$_} ? @{$export_tags->{$_}}
213 : scalar(push(@nontag,$_),$_) }
214 (@$syms) ? @$syms : keys %$export_tags);
215 if (@nontag and $^W) {
216 # This may change to a die one day
217 require Carp;
218 Carp::carp(join(", ", @nontag)." are not tags of $pkg");
219 }
220}
221
222sub heavy_require_version {
223 my($self, $wanted) = @_;
224 my $pkg = ref $self || $self;
225 return ${pkg}->VERSION($wanted);
226}
227
228sub heavy_export_tags {
229 _push_tags((caller)[0], "EXPORT", \@_);
230}
231
232sub heavy_export_ok_tags {
233 _push_tags((caller)[0], "EXPORT_OK", \@_);
234}
235
23614µs4µs1;