← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:08 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Package/Stash.pm
StatementsExecuted 15685 statements in 43.9ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
6646211.8ms16.5msPackage::Stash::::has_package_symbolPackage::Stash::has_package_symbol
411426.44ms9.55msPackage::Stash::::get_package_symbolPackage::Stash::get_package_symbol
131116.38ms23.5msPackage::Stash::::remove_package_symbolPackage::Stash::remove_package_symbol
691414.74ms4.74msPackage::Stash::::_deconstruct_variable_namePackage::Stash::_deconstruct_variable_name
1215423.39ms3.39msPackage::Stash::::namespacePackage::Stash::namespace
140223.03ms5.09msPackage::Stash::::add_package_symbolPackage::Stash::add_package_symbol
140111.41ms1.62msPackage::Stash::::_valid_for_typePackage::Stash::_valid_for_type
131111.16ms1.52msPackage::Stash::::remove_package_globPackage::Stash::remove_package_glob
402321.13ms1.13msPackage::Stash::::namePackage::Stash::name
4551591µs591µsPackage::Stash::::newPackage::Stash::new
911242µs271µsPackage::Stash::::list_all_package_symbolsPackage::Stash::list_all_package_symbols
11118µs18µsPackage::Stash::::BEGIN@2Package::Stash::BEGIN@2
11112µs34µsPackage::Stash::::BEGIN@185Package::Stash::BEGIN@185
11112µs45µsPackage::Stash::::BEGIN@108Package::Stash::BEGIN@108
11112µs54µsPackage::Stash::::BEGIN@10Package::Stash::BEGIN@10
11111µs54µsPackage::Stash::::BEGIN@9Package::Stash::BEGIN@9
11111µs20µsPackage::Stash::::BEGIN@6Package::Stash::BEGIN@6
11111µs35µsPackage::Stash::::BEGIN@18Package::Stash::BEGIN@18
11111µs33µsPackage::Stash::::BEGIN@107Package::Stash::BEGIN@107
11111µs16µsPackage::Stash::::BEGIN@5Package::Stash::BEGIN@5
11111µs32µsPackage::Stash::::BEGIN@115Package::Stash::BEGIN@115
0000s0sPackage::Stash::::get_or_add_package_symbolPackage::Stash::get_or_add_package_symbol
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Package::Stash;
2
# spent 18µs within Package::Stash::BEGIN@2 which was called: # once (18µs+0s) by namespace::clean::BEGIN@16 at line 4
BEGIN {
316µs $Package::Stash::VERSION = '0.08';
4117µs118µs}
# spent 18µs making 1 call to Package::Stash::BEGIN@2
5225µs220µs
# spent 16µs (11+5) within Package::Stash::BEGIN@5 which was called: # once (11µs+5µs) by namespace::clean::BEGIN@16 at line 5
use strict;
# spent 16µs making 1 call to Package::Stash::BEGIN@5 # spent 5µs making 1 call to strict::import
6226µs230µs
# spent 20µs (11+9) within Package::Stash::BEGIN@6 which was called: # once (11µs+9µs) by namespace::clean::BEGIN@16 at line 6
use warnings;
# spent 20µs making 1 call to Package::Stash::BEGIN@6 # spent 9µs making 1 call to warnings::import
7# ABSTRACT: routines for manipulating stashes
8
9228µs297µs
# spent 54µs (11+43) within Package::Stash::BEGIN@9 which was called: # once (11µs+43µs) by namespace::clean::BEGIN@16 at line 9
use Carp qw(confess);
# spent 54µs making 1 call to Package::Stash::BEGIN@9 # spent 43µs making 1 call to Exporter::import
10249µs296µs
# spent 54µs (12+42) within Package::Stash::BEGIN@10 which was called: # once (12µs+42µs) by namespace::clean::BEGIN@16 at line 10
use Scalar::Util qw(reftype);
# spent 54µs making 1 call to Package::Stash::BEGIN@10 # spent 42µs making 1 call to Exporter::import
11
12
13
# spent 591µs within Package::Stash::new which was called 45 times, avg 13µs/call: # 9 times (142µs+0s) by namespace::clean::get_functions at line 151 of namespace/clean.pm, avg 16µs/call # 9 times (133µs+0s) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 27 of namespace/clean.pm, avg 15µs/call # 9 times (113µs+0s) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 26 of namespace/clean.pm, avg 13µs/call # 9 times (102µs+0s) by namespace::clean::get_class_store at line 140 of namespace/clean.pm, avg 11µs/call # 9 times (100µs+0s) by namespace::clean::import at line 90 of namespace/clean.pm, avg 11µs/call
sub new {
14225526µs my $class = shift;
15 my ($package) = @_;
16 my $namespace;
17 {
182352µs259µs
# spent 35µs (11+24) within Package::Stash::BEGIN@18 which was called: # once (11µs+24µs) by namespace::clean::BEGIN@16 at line 18
no strict 'refs';
# spent 35µs making 1 call to Package::Stash::BEGIN@18 # spent 24µs making 1 call to strict::unimport
19 # supposedly this caused a bug in earlier perls, but I can't reproduce
20 # it, so re-enabling the caching
2145133µs $namespace = \%{$package . '::'};
22 }
23 return bless {
24 'package' => $package,
25 'namespace' => $namespace,
26 }, $class;
27}
28
29
30
# spent 1.13ms within Package::Stash::name which was called 402 times, avg 3µs/call: # 140 times (384µs+0s) by Package::Stash::add_package_symbol at line 86, avg 3µs/call # 131 times (383µs+0s) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 43 of namespace/clean.pm, avg 3µs/call # 131 times (363µs+0s) by Package::Stash::remove_package_glob at line 116, avg 3µs/call
sub name {
314021.57ms return $_[0]->{package};
32}
33
34
35
# spent 3.39ms within Package::Stash::namespace which was called 1215 times, avg 3µs/call: # 664 times (1.81ms+0s) by Package::Stash::has_package_symbol at line 129, avg 3µs/call # 411 times (1.16ms+0s) by Package::Stash::get_package_symbol at line 157, avg 3µs/call # 131 times (384µs+0s) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 36 of namespace/clean.pm, avg 3µs/call # 9 times (30µs+0s) by Package::Stash::list_all_package_symbols at line 268, avg 3µs/call
sub namespace {
3612154.53ms return $_[0]->{namespace};
37}
38
39{
4026µs my %SIGIL_MAP = (
41 '$' => 'SCALAR',
42 '@' => 'ARRAY',
43 '%' => 'HASH',
44 '&' => 'CODE',
45 '' => 'IO',
46 );
47
48
# spent 4.74ms within Package::Stash::_deconstruct_variable_name which was called 691 times, avg 7µs/call: # 280 times (1.94ms+0s) by Package::Stash::get_package_symbol at line 154, avg 7µs/call # 271 times (1.86ms+0s) by Package::Stash::has_package_symbol at line 126, avg 7µs/call # 131 times (877µs+0s) by Package::Stash::remove_package_symbol at line 205, avg 7µs/call # 9 times (62µs+0s) by Package::Stash::add_package_symbol at line 83, avg 7µs/call
sub _deconstruct_variable_name {
4927645.62ms my ($self, $variable) = @_;
50
51 (defined $variable && length $variable)
52 || confess "You must pass a variable name";
53
54 my $sigil = substr($variable, 0, 1, '');
55
56 if (exists $SIGIL_MAP{$sigil}) {
57 return ($variable, $sigil, $SIGIL_MAP{$sigil});
58 }
59 else {
60 return ("${sigil}${variable}", '', $SIGIL_MAP{''});
61 }
62 }
63}
64
65
66
# spent 1.62ms (1.41+206µs) within Package::Stash::_valid_for_type which was called 140 times, avg 12µs/call: # 140 times (1.41ms+206µs) by Package::Stash::add_package_symbol at line 89, avg 12µs/call
sub _valid_for_type {
67420575µs my $self = shift;
68 my ($value, $type) = @_;
692621.13ms920µs if ($type eq 'HASH' || $type eq 'ARRAY'
# spent 20µs making 9 calls to Scalar::Util::reftype, avg 2µs/call
70 || $type eq 'IO' || $type eq 'CODE') {
71 return reftype($value) eq $type;
72 }
73 else {
74131187µs my $ref = reftype($value);
# spent 187µs making 131 calls to Scalar::Util::reftype, avg 1µs/call
75 return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE';
76 }
77}
78
79
# spent 5.09ms (3.03+2.06) within Package::Stash::add_package_symbol which was called 140 times, avg 36µs/call: # 131 times (2.76ms+1.86ms) by Package::Stash::remove_package_symbol at line 257, avg 35µs/call # 9 times (268µs+198µs) by namespace::clean::get_class_store at line 142 of namespace/clean.pm, avg 52µs/call
sub add_package_symbol {
807002.13ms my ($self, $variable, $initial_value, %opts) = @_;
81
82 my ($name, $sigil, $type) = ref $variable eq 'HASH'
83962µs ? @{$variable}{qw[name sigil type]}
# spent 62µs making 9 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
84 : $self->_deconstruct_variable_name($variable);
85
86140384µs my $pkg = $self->name;
# spent 384µs making 140 calls to Package::Stash::name, avg 3µs/call
87
88280760µs if (@_ > 2) {
891401.62ms $self->_valid_for_type($initial_value, $type)
# spent 1.62ms making 140 calls to Package::Stash::_valid_for_type, avg 12µs/call
90 || confess "$initial_value is not of type $type";
91
92 # cheap fail-fast check for PERLDBf_SUBLINE and '&'
93 if ($^P and $^P & 0x10 && $sigil eq '&') {
94 my $filename = $opts{filename};
95 my $first_line_num = $opts{first_line_num};
96
97 (undef, $filename, $first_line_num) = caller
98 if not defined $filename;
99
100 my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0);
101
102 # http://perldoc.perl.org/perldebguts.html#Debugger-Internals
103 $DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num";
104 }
105 }
106
107228µs256µs
# spent 33µs (11+23) within Package::Stash::BEGIN@107 which was called: # once (11µs+23µs) by namespace::clean::BEGIN@16 at line 107
no strict 'refs';
# spent 33µs making 1 call to Package::Stash::BEGIN@107 # spent 23µs making 1 call to strict::unimport
108278µs278µs
# spent 45µs (12+33) within Package::Stash::BEGIN@108 which was called: # once (12µs+33µs) by namespace::clean::BEGIN@16 at line 108
no warnings 'redefine', 'misc', 'prototype';
# spent 45µs making 1 call to Package::Stash::BEGIN@108 # spent 33µs making 1 call to warnings::unimport
109 *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
110}
111
112
113
# spent 1.52ms (1.16+363µs) within Package::Stash::remove_package_glob which was called 131 times, avg 12µs/call: # 131 times (1.16ms+363µs) by Package::Stash::remove_package_symbol at line 255, avg 12µs/call
sub remove_package_glob {
1142621.12ms my ($self, $name) = @_;
1152250µs253µs
# spent 32µs (11+21) within Package::Stash::BEGIN@115 which was called: # once (11µs+21µs) by namespace::clean::BEGIN@16 at line 115
no strict 'refs';
# spent 32µs making 1 call to Package::Stash::BEGIN@115 # spent 21µs making 1 call to strict::unimport
116131363µs delete ${$self->name . '::'}{$name};
# spent 363µs making 131 calls to Package::Stash::name, avg 3µs/call
117}
118
119# ... these functions deal with stuff on the namespace level
120
121
122
# spent 16.5ms (11.8+4.68) within Package::Stash::has_package_symbol which was called 664 times, avg 25µs/call: # 131 times (2.73ms+1.51ms) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 34 of namespace/clean.pm, avg 32µs/call # 131 times (2.61ms+1.44ms) by namespace::clean::import at line 102 of namespace/clean.pm, avg 31µs/call # 131 times (2.16ms+554µs) by Package::Stash::remove_package_symbol at line 241, avg 21µs/call # 131 times (2.10ms+541µs) by Package::Stash::remove_package_symbol at line 242, avg 20µs/call # 131 times (2.08ms+540µs) by Package::Stash::remove_package_symbol at line 243, avg 20µs/call # 9 times (145µs+98µs) by namespace::clean::get_class_store at line 142 of namespace/clean.pm, avg 27µs/call
sub has_package_symbol {
12339669.72ms my ($self, $variable) = @_;
124
125 my ($name, $sigil, $type) = ref $variable eq 'HASH'
1262711.86ms ? @{$variable}{qw[name sigil type]}
# spent 1.86ms making 271 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
127 : $self->_deconstruct_variable_name($variable);
128
1296641.81ms my $namespace = $self->namespace;
# spent 1.81ms making 664 calls to Package::Stash::namespace, avg 3µs/call
130
131 return unless exists $namespace->{$name};
132
133 my $entry_ref = \$namespace->{$name};
1346552.55ms6551.01ms if (reftype($entry_ref) eq 'GLOB') {
# spent 1.01ms making 655 calls to Scalar::Util::reftype, avg 2µs/call
135 if ( $type eq 'SCALAR' ) {
136 return defined ${ *{$entry_ref}{SCALAR} };
137 }
138 else {
139 return defined *{$entry_ref}{$type};
140 }
141 }
142 else {
143 # a symbol table entry can be -1 (stub), string (stub with prototype),
144 # or reference (constant)
145 return $type eq 'CODE';
146 }
147}
148
149
150
# spent 9.55ms (6.44+3.11) within Package::Stash::get_package_symbol which was called 411 times, avg 23µs/call: # 140 times (2.37ms+1.37ms) by namespace::clean::get_functions at line 153 of namespace/clean.pm, avg 27µs/call # 131 times (2.17ms+1.29ms) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 42 of namespace/clean.pm, avg 26µs/call # 131 times (1.74ms+361µs) by Package::Stash::remove_package_symbol at line 240, avg 16µs/call # 9 times (157µs+88µs) by namespace::clean::get_class_store at line 144 of namespace/clean.pm, avg 27µs/call
sub get_package_symbol {
15124666.06ms my ($self, $variable, %opts) = @_;
152
153 my ($name, $sigil, $type) = ref $variable eq 'HASH'
1542801.94ms ? @{$variable}{qw[name sigil type]}
# spent 1.94ms making 280 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
155 : $self->_deconstruct_variable_name($variable);
156
1574111.16ms my $namespace = $self->namespace;
# spent 1.16ms making 411 calls to Package::Stash::namespace, avg 3µs/call
158
159 if (!exists $namespace->{$name}) {
160 # assigning to the result of this function like
161 # @{$stash->get_package_symbol('@ISA')} = @new_ISA
162 # makes the result not visible until the variable is explicitly
163 # accessed... in the case of @ISA, this might never happen
164 # for instance, assigning like that and then calling $obj->isa
165 # will fail. see t/005-isa.t
166 if ($opts{vivify} && $type eq 'ARRAY' && $name ne 'ISA') {
167 $self->add_package_symbol($variable, []);
168 }
169 elsif ($opts{vivify} && $type eq 'HASH') {
170 $self->add_package_symbol($variable, {});
171 }
172 else {
173 # FIXME
174 $self->add_package_symbol($variable)
175 }
176 }
177
178 my $entry_ref = \$namespace->{$name};
179
180 if (ref($entry_ref) eq 'GLOB') {
181 return *{$entry_ref}{$type};
182 }
183 else {
184 if ($type eq 'CODE') {
1852525µs256µs
# spent 34µs (12+22) within Package::Stash::BEGIN@185 which was called: # once (12µs+22µs) by namespace::clean::BEGIN@16 at line 185
no strict 'refs';
# spent 34µs making 1 call to Package::Stash::BEGIN@185 # spent 22µs making 1 call to strict::unimport
186 return \&{ $self->name . '::' . $name };
187 }
188 else {
189 return undef;
190 }
191 }
192}
193
194
195sub get_or_add_package_symbol {
196 my $self = shift;
197 $self->get_package_symbol(@_, vivify => 1);
198}
199
200
201
# spent 23.5ms (6.38+17.1) within Package::Stash::remove_package_symbol which was called 131 times, avg 179µs/call: # 131 times (6.38ms+17.1ms) by namespace::clean::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/namespace/clean.pm:52] at line 50 of namespace/clean.pm, avg 179µs/call
sub remove_package_symbol {
20214413.89ms my ($self, $variable) = @_;
203
204 my ($name, $sigil, $type) = ref $variable eq 'HASH'
205131877µs ? @{$variable}{qw[name sigil type]}
# spent 877µs making 131 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
206 : $self->_deconstruct_variable_name($variable);
207
208 # FIXME:
209 # no doubt this is grossly inefficient and
210 # could be done much easier and faster in XS
211
212 my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = (
213 { sigil => '$', type => 'SCALAR', name => $name },
214 { sigil => '@', type => 'ARRAY', name => $name },
215 { sigil => '%', type => 'HASH', name => $name },
216 { sigil => '&', type => 'CODE', name => $name },
217 { sigil => '', type => 'IO', name => $name },
218 );
219
220 my ($scalar, $array, $hash, $code, $io);
2215241.93ms if ($type eq 'SCALAR') {
222 $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
223 $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
224 $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
225 $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
226 }
227 elsif ($type eq 'ARRAY') {
228 $scalar = $self->get_package_symbol($scalar_desc);
229 $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
230 $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
231 $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
232 }
233 elsif ($type eq 'HASH') {
234 $scalar = $self->get_package_symbol($scalar_desc);
235 $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
236 $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
237 $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
238 }
239 elsif ($type eq 'CODE') {
2401312.11ms $scalar = $self->get_package_symbol($scalar_desc);
# spent 2.11ms making 131 calls to Package::Stash::get_package_symbol, avg 16µs/call
2411312.71ms $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
# spent 2.71ms making 131 calls to Package::Stash::has_package_symbol, avg 21µs/call
2421312.64ms $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
# spent 2.64ms making 131 calls to Package::Stash::has_package_symbol, avg 20µs/call
2431312.62ms $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
# spent 2.62ms making 131 calls to Package::Stash::has_package_symbol, avg 20µs/call
244 }
245 elsif ($type eq 'IO') {
246 $scalar = $self->get_package_symbol($scalar_desc);
247 $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
248 $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
249 $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc);
250 }
251 else {
252 confess "This should never ever ever happen";
253 }
254
2551311.52ms $self->remove_package_glob($name);
# spent 1.52ms making 131 calls to Package::Stash::remove_package_glob, avg 12µs/call
256
2571314.62ms $self->add_package_symbol($scalar_desc => $scalar);
# spent 4.62ms making 131 calls to Package::Stash::add_package_symbol, avg 35µs/call
258 $self->add_package_symbol($array_desc => $array) if defined $array;
259 $self->add_package_symbol($hash_desc => $hash) if defined $hash;
260 $self->add_package_symbol($code_desc => $code) if defined $code;
261 $self->add_package_symbol($io_desc => $io) if defined $io;
262}
263
264
265
# spent 271µs (242+29) within Package::Stash::list_all_package_symbols which was called 9 times, avg 30µs/call: # 9 times (242µs+29µs) by namespace::clean::get_functions at line 153 of namespace/clean.pm, avg 30µs/call
sub list_all_package_symbols {
26636236µs my ($self, $type_filter) = @_;
267
268930µs my $namespace = $self->namespace;
# spent 30µs making 9 calls to Package::Stash::namespace, avg 3µs/call
269 return keys %{$namespace} unless defined $type_filter;
270
271 # NOTE:
272 # or we can filter based on
273 # type (SCALAR|ARRAY|HASH|CODE)
274 if ($type_filter eq 'CODE') {
275 return grep {
276 (ref($namespace->{$_})
277 ? (ref($namespace->{$_}) eq 'SCALAR')
278 : (ref(\$namespace->{$_}) eq 'GLOB'
279 && defined(*{$namespace->{$_}}{CODE})));
280 } keys %{$namespace};
281 } else {
282 return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
283 }
284}
285
286
28714µs1;
288
289__END__