← Index
NYTProf Performance Profile   « block view • line view • sub view »
For reply.pl
  Run on Thu Oct 21 22:40:13 2010
Reported on Thu Oct 21 22:44:43 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Package/Stash.pm
StatementsExecuted 12331 statements in 35.6ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
522629.33ms13.1msPackage::Stash::::has_package_symbolPackage::Stash::has_package_symbol
323425.14ms7.59msPackage::Stash::::get_package_symbolPackage::Stash::get_package_symbol
103115.04ms18.7msPackage::Stash::::remove_package_symbolPackage::Stash::remove_package_symbol
543413.81ms3.81msPackage::Stash::::_deconstruct_variable_namePackage::Stash::_deconstruct_variable_name
955422.72ms2.72msPackage::Stash::::namespacePackage::Stash::namespace
110222.44ms4.10msPackage::Stash::::add_package_symbolPackage::Stash::add_package_symbol
110111.14ms1.30msPackage::Stash::::_valid_for_typePackage::Stash::_valid_for_type
10311945µs1.23msPackage::Stash::::remove_package_globPackage::Stash::remove_package_glob
31632893µs893µsPackage::Stash::::namePackage::Stash::name
3551845µs845µsPackage::Stash::::newPackage::Stash::new
711200µs226µsPackage::Stash::::list_all_package_symbolsPackage::Stash::list_all_package_symbols
11119µs19µsPackage::Stash::::BEGIN@2Package::Stash::BEGIN@2
11117µs39µsPackage::Stash::::BEGIN@107Package::Stash::BEGIN@107
11113µs45µsPackage::Stash::::BEGIN@108Package::Stash::BEGIN@108
11111µs58µsPackage::Stash::::BEGIN@9Package::Stash::BEGIN@9
11111µs54µsPackage::Stash::::BEGIN@10Package::Stash::BEGIN@10
11111µs22µsPackage::Stash::::BEGIN@6Package::Stash::BEGIN@6
11111µs16µsPackage::Stash::::BEGIN@5Package::Stash::BEGIN@5
11111µs34µsPackage::Stash::::BEGIN@18Package::Stash::BEGIN@18
11110µs31µsPackage::Stash::::BEGIN@115Package::Stash::BEGIN@115
11110µs32µsPackage::Stash::::BEGIN@185Package::Stash::BEGIN@185
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 19µs within Package::Stash::BEGIN@2 which was called: # once (19µs+0s) by namespace::clean::BEGIN@16 at line 4
BEGIN {
316µs $Package::Stash::VERSION = '0.08';
4126µs119µs}
# spent 19µs making 1 call to Package::Stash::BEGIN@2
5229µs221µ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
6232µs234µs
# spent 22µs (11+11) within Package::Stash::BEGIN@6 which was called: # once (11µs+11µs) by namespace::clean::BEGIN@16 at line 6
use warnings;
# spent 22µs making 1 call to Package::Stash::BEGIN@6 # spent 11µs making 1 call to warnings::import
7# ABSTRACT: routines for manipulating stashes
8
9228µs2104µs
# spent 58µs (11+46) within Package::Stash::BEGIN@9 which was called: # once (11µs+46µs) by namespace::clean::BEGIN@16 at line 9
use Carp qw(confess);
# spent 58µs making 1 call to Package::Stash::BEGIN@9 # spent 46µs making 1 call to Exporter::import
10245µs296µs
# spent 54µs (11+42) within Package::Stash::BEGIN@10 which was called: # once (11µ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 845µs within Package::Stash::new which was called 35 times, avg 24µs/call: # 7 times (488µ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 70µs/call # 7 times (113µs+0s) by namespace::clean::get_functions at line 151 of namespace/clean.pm, avg 16µs/call # 7 times (88µ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 # 7 times (79µs+0s) by namespace::clean::import at line 90 of namespace/clean.pm, avg 11µs/call # 7 times (78µs+0s) by namespace::clean::get_class_store at line 140 of namespace/clean.pm, avg 11µs/call
sub new {
143542µs my $class = shift;
153550µs my ($package) = @_;
163532µs my $namespace;
17 {
1837429µs256µs
# spent 34µs (11+23) within Package::Stash::BEGIN@18 which was called: # once (11µs+23µs) by namespace::clean::BEGIN@16 at line 18
no strict 'refs';
# spent 34µs making 1 call to Package::Stash::BEGIN@18 # spent 23µ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
2135488µs $namespace = \%{$package . '::'};
22 }
2335222µs return bless {
24 'package' => $package,
25 'namespace' => $namespace,
26 }, $class;
27}
28
29
30
# spent 893µs within Package::Stash::name which was called 316 times, avg 3µs/call: # 110 times (309µs+0s) by Package::Stash::add_package_symbol at line 86, avg 3µs/call # 103 times (298µ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 # 103 times (286µs+0s) by Package::Stash::remove_package_glob at line 116, avg 3µs/call
sub name {
313161.25ms return $_[0]->{package};
32}
33
34
35
# spent 2.72ms within Package::Stash::namespace which was called 955 times, avg 3µs/call: # 522 times (1.46ms+0s) by Package::Stash::has_package_symbol at line 129, avg 3µs/call # 323 times (935µs+0s) by Package::Stash::get_package_symbol at line 157, avg 3µs/call # 103 times (299µ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 # 7 times (26µs+0s) by Package::Stash::list_all_package_symbols at line 268, avg 4µs/call
sub namespace {
369553.64ms 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 3.81ms within Package::Stash::_deconstruct_variable_name which was called 543 times, avg 7µs/call: # 220 times (1.52ms+0s) by Package::Stash::get_package_symbol at line 154, avg 7µs/call # 213 times (1.53ms+0s) by Package::Stash::has_package_symbol at line 126, avg 7µs/call # 103 times (719µs+0s) by Package::Stash::remove_package_symbol at line 205, avg 7µs/call # 7 times (47µs+0s) by Package::Stash::add_package_symbol at line 83, avg 7µs/call
sub _deconstruct_variable_name {
49543627µs my ($self, $variable) = @_;
50
51543639µs (defined $variable && length $variable)
52 || confess "You must pass a variable name";
53
54543785µs my $sigil = substr($variable, 0, 1, '');
55
565432.42ms 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.30ms (1.14+168µs) within Package::Stash::_valid_for_type which was called 110 times, avg 12µs/call: # 110 times (1.14ms+168µs) by Package::Stash::add_package_symbol at line 89, avg 12µs/call
sub _valid_for_type {
67110122µs my $self = shift;
68110140µs my ($value, $type) = @_;
69110212µs716µs if ($type eq 'HASH' || $type eq 'ARRAY'
# spent 16µs making 7 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 {
74103510µs103152µs my $ref = reftype($value);
# spent 152µs making 103 calls to Scalar::Util::reftype, avg 1µs/call
75103382µs return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE';
76 }
77}
78
79
# spent 4.10ms (2.44+1.66) within Package::Stash::add_package_symbol which was called 110 times, avg 37µs/call: # 103 times (2.22ms+1.50ms) by Package::Stash::remove_package_symbol at line 257, avg 36µs/call # 7 times (220µs+156µs) by namespace::clean::get_class_store at line 142 of namespace/clean.pm, avg 54µs/call
sub add_package_symbol {
80110173µs my ($self, $variable, $initial_value, %opts) = @_;
81
82 my ($name, $sigil, $type) = ref $variable eq 'HASH'
83110226µs747µs ? @{$variable}{qw[name sigil type]}
# spent 47µs making 7 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
84 : $self->_deconstruct_variable_name($variable);
85
86110388µs110309µs my $pkg = $self->name;
# spent 309µs making 110 calls to Package::Stash::name, avg 3µs/call
87
88110250µs if (@_ > 2) {
89110421µs1101.30ms $self->_valid_for_type($initial_value, $type)
# spent 1.30ms making 110 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 '&'
93110203µs 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
107230µs260µs
# spent 39µs (17+22) within Package::Stash::BEGIN@107 which was called: # once (17µs+22µs) by namespace::clean::BEGIN@16 at line 107
no strict 'refs';
# spent 39µs making 1 call to Package::Stash::BEGIN@107 # spent 21µs making 1 call to strict::unimport
108269µs277µs
# spent 45µs (13+32) within Package::Stash::BEGIN@108 which was called: # once (13µs+32µ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 32µs making 1 call to warnings::unimport
109110689µs *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
110}
111
112
113
# spent 1.23ms (945µs+286µs) within Package::Stash::remove_package_glob which was called 103 times, avg 12µs/call: # 103 times (945µs+286µs) by Package::Stash::remove_package_symbol at line 255, avg 12µs/call
sub remove_package_glob {
114103140µs my ($self, $name) = @_;
1152249µs253µs
# spent 31µs (10+22) within Package::Stash::BEGIN@115 which was called: # once (10µs+22µs) by namespace::clean::BEGIN@16 at line 115
no strict 'refs';
# spent 31µs making 1 call to Package::Stash::BEGIN@115 # spent 22µs making 1 call to strict::unimport
116103770µs103286µs delete ${$self->name . '::'}{$name};
# spent 286µs making 103 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 13.1ms (9.33+3.80) within Package::Stash::has_package_symbol which was called 522 times, avg 25µs/call: # 103 times (2.16ms+1.25ms) 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 33µs/call # 103 times (2.06ms+1.17ms) by namespace::clean::import at line 102 of namespace/clean.pm, avg 31µs/call # 103 times (1.71ms+459µs) by Package::Stash::remove_package_symbol at line 241, avg 21µs/call # 103 times (1.67ms+423µs) by Package::Stash::remove_package_symbol at line 242, avg 20µs/call # 103 times (1.63ms+428µs) by Package::Stash::remove_package_symbol at line 243, avg 20µs/call # 7 times (110µs+71µs) by namespace::clean::get_class_store at line 142 of namespace/clean.pm, avg 26µs/call
sub has_package_symbol {
123522688µs my ($self, $variable) = @_;
124
125 my ($name, $sigil, $type) = ref $variable eq 'HASH'
1265221.43ms2131.53ms ? @{$variable}{qw[name sigil type]}
# spent 1.53ms making 213 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
127 : $self->_deconstruct_variable_name($variable);
128
1295221.82ms5221.46ms my $namespace = $self->namespace;
# spent 1.46ms making 522 calls to Package::Stash::namespace, avg 3µs/call
130
131522607µs return unless exists $namespace->{$name};
132
133515624µs my $entry_ref = \$namespace->{$name};
1345152.55ms515811µs if (reftype($entry_ref) eq 'GLOB') {
# spent 811µs making 515 calls to Scalar::Util::reftype, avg 2µs/call
135 if ( $type eq 'SCALAR' ) {
136 return defined ${ *{$entry_ref}{SCALAR} };
137 }
138 else {
1395152.04ms 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 7.59ms (5.14+2.45) within Package::Stash::get_package_symbol which was called 323 times, avg 23µs/call: # 110 times (1.90ms+1.08ms) by namespace::clean::get_functions at line 153 of namespace/clean.pm, avg 27µs/call # 103 times (1.73ms+1.00ms) 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 27µs/call # 103 times (1.38ms+303µs) by Package::Stash::remove_package_symbol at line 240, avg 16µs/call # 7 times (122µs+70µs) by namespace::clean::get_class_store at line 144 of namespace/clean.pm, avg 27µs/call
sub get_package_symbol {
151323478µs my ($self, $variable, %opts) = @_;
152
153 my ($name, $sigil, $type) = ref $variable eq 'HASH'
1543231.08ms2201.52ms ? @{$variable}{qw[name sigil type]}
# spent 1.52ms making 220 calls to Package::Stash::_deconstruct_variable_name, avg 7µs/call
155 : $self->_deconstruct_variable_name($variable);
156
1573231.19ms323935µs my $namespace = $self->namespace;
# spent 935µs making 323 calls to Package::Stash::namespace, avg 3µs/call
158
159323365µs 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
178323388µs my $entry_ref = \$namespace->{$name};
179
1803231.31ms if (ref($entry_ref) eq 'GLOB') {
181 return *{$entry_ref}{$type};
182 }
183 else {
184 if ($type eq 'CODE') {
1852480µs254µs
# spent 32µs (10+22) within Package::Stash::BEGIN@185 which was called: # once (10µs+22µs) by namespace::clean::BEGIN@16 at line 185
no strict 'refs';
# spent 32µ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 18.7ms (5.04+13.7) within Package::Stash::remove_package_symbol which was called 103 times, avg 182µs/call: # 103 times (5.04ms+13.7ms) 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 182µs/call
sub remove_package_symbol {
202103145µs my ($self, $variable) = @_;
203
204 my ($name, $sigil, $type) = ref $variable eq 'HASH'
205103433µs103719µs ? @{$variable}{qw[name sigil type]}
# spent 719µs making 103 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
212103530µs 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
220103110µs my ($scalar, $array, $hash, $code, $io);
221103261µs 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') {
240103381µs1031.69ms $scalar = $self->get_package_symbol($scalar_desc);
# spent 1.69ms making 103 calls to Package::Stash::get_package_symbol, avg 16µs/call
241103387µs1032.17ms $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc);
# spent 2.17ms making 103 calls to Package::Stash::has_package_symbol, avg 21µs/call
242103375µs1032.09ms $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc);
# spent 2.09ms making 103 calls to Package::Stash::has_package_symbol, avg 20µs/call
243103386µs1032.06ms $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc);
# spent 2.06ms making 103 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
255103372µs1031.23ms $self->remove_package_glob($name);
# spent 1.23ms making 103 calls to Package::Stash::remove_package_glob, avg 12µs/call
256
257103376µs1033.72ms $self->add_package_symbol($scalar_desc => $scalar);
# spent 3.72ms making 103 calls to Package::Stash::add_package_symbol, avg 36µs/call
258103108µs $self->add_package_symbol($array_desc => $array) if defined $array;
25910387µs $self->add_package_symbol($hash_desc => $hash) if defined $hash;
26010382µs $self->add_package_symbol($code_desc => $code) if defined $code;
261103562µs $self->add_package_symbol($io_desc => $io) if defined $io;
262}
263
264
265
# spent 226µs (200+26) within Package::Stash::list_all_package_symbols which was called 7 times, avg 32µs/call: # 7 times (200µs+26µs) by namespace::clean::get_functions at line 153 of namespace/clean.pm, avg 32µs/call
sub list_all_package_symbols {
266711µs my ($self, $type_filter) = @_;
267
268729µs726µs my $namespace = $self->namespace;
# spent 26µs making 7 calls to Package::Stash::namespace, avg 4µs/call
26979µs return keys %{$namespace} unless defined $type_filter;
270
271 # NOTE:
272 # or we can filter based on
273 # type (SCALAR|ARRAY|HASH|CODE)
2747149µs 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__