← Index
NYTProf Performance Profile   « block view • line view • sub view »
For -e
  Run on Wed Nov 17 21:45:08 2010
Reported on Wed Nov 17 22:10:21 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/MRO/Compat.pm
StatementsExecuted 31 statements in 5.22ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.00ms1.69msMRO::Compat::::BEGIN@10MRO::Compat::BEGIN@10
11163µs80µsMRO::Compat::::BEGIN@2MRO::Compat::BEGIN@2
11147µs128µsMRO::Compat::::BEGIN@39MRO::Compat::BEGIN@39
11142µs111µsMRO::Compat::::BEGIN@225MRO::Compat::BEGIN@225
11139µs106µsMRO::Compat::::BEGIN@116MRO::Compat::BEGIN@116
11138µs100µsMRO::Compat::::BEGIN@256MRO::Compat::BEGIN@256
11137µs101µsMRO::Compat::::BEGIN@226MRO::Compat::BEGIN@226
11135µs97µsMRO::Compat::::BEGIN@3MRO::Compat::BEGIN@3
0000s0sMRO::Compat::::__ANON__[:40]MRO::Compat::__ANON__[:40]
0000s0sMRO::Compat::::__ANON__[:41]MRO::Compat::__ANON__[:41]
0000s0sMRO::Compat::::__ANON__[:42]MRO::Compat::__ANON__[:42]
0000s0sMRO::Compat::::__get_all_pkgs_with_isasMRO::Compat::__get_all_pkgs_with_isas
0000s0sMRO::Compat::::__get_isarevMRO::Compat::__get_isarev
0000s0sMRO::Compat::::__get_isarev_recurseMRO::Compat::__get_isarev_recurse
0000s0sMRO::Compat::::__get_linear_isaMRO::Compat::__get_linear_isa
0000s0sMRO::Compat::::__get_linear_isa_dfsMRO::Compat::__get_linear_isa_dfs
0000s0sMRO::Compat::::__get_mroMRO::Compat::__get_mro
0000s0sMRO::Compat::::__get_pkg_gen_c3xsMRO::Compat::__get_pkg_gen_c3xs
0000s0sMRO::Compat::::__get_pkg_gen_ppMRO::Compat::__get_pkg_gen_pp
0000s0sMRO::Compat::::__importMRO::Compat::__import
0000s0sMRO::Compat::::__invalidate_all_method_cachesMRO::Compat::__invalidate_all_method_caches
0000s0sMRO::Compat::::__is_universalMRO::Compat::__is_universal
0000s0sMRO::Compat::::__method_changed_inMRO::Compat::__method_changed_in
0000s0sMRO::Compat::::__set_mroMRO::Compat::__set_mro
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package MRO::Compat;
23114µs296µs
# spent 80µs (63+16) within MRO::Compat::BEGIN@2 which was called: # once (63µs+16µs) by Class::MOP::BEGIN@9 at line 2
use strict;
# spent 80µs making 1 call to MRO::Compat::BEGIN@2 # spent 16µs making 1 call to strict::import
33714µs2158µs
# spent 97µs (35+61) within MRO::Compat::BEGIN@3 which was called: # once (35µs+61µs) by Class::MOP::BEGIN@9 at line 3
use warnings;
# spent 97µs making 1 call to MRO::Compat::BEGIN@3 # spent 61µs making 1 call to warnings::import
4162µsrequire 5.006_000;
5
6# Keep this < 1.00, so people can tell the fake
7# mro.pm from the real one
813µsour $VERSION = '0.11';
9
10
# spent 1.69ms (1.00+687µs) within MRO::Compat::BEGIN@10 which was called: # once (1.00ms+687µs) by Class::MOP::BEGIN@9 at line 44
BEGIN {
11 # Alias our private functions over to
12 # the mro:: namespace and load
13 # Class::C3 if Perl < 5.9.5
145348µs if($] < 5.009_005) {
15 $mro::VERSION # to fool Module::Install when generating META.yml
16 = $VERSION;
17 $INC{'mro.pm'} = __FILE__;
18 *mro::import = \&__import;
19 *mro::get_linear_isa = \&__get_linear_isa;
20 *mro::set_mro = \&__set_mro;
21 *mro::get_mro = \&__get_mro;
22 *mro::get_isarev = \&__get_isarev;
23 *mro::is_universal = \&__is_universal;
24 *mro::method_changed_in = \&__method_changed_in;
25 *mro::invalidate_all_method_caches
26 = \&__invalidate_all_method_caches;
27 require Class::C3;
28 if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03) {
29 *mro::get_pkg_gen = \&__get_pkg_gen_c3xs;
30 }
31 else {
32 *mro::get_pkg_gen = \&__get_pkg_gen_pp;
33 }
34 }
35
36 # Load mro.pm and provide no-op Class::C3::.*initialize() funcs for 5.9.5+
37 else {
38 require mro;
393377µs2210µs
# spent 128µs (47+82) within MRO::Compat::BEGIN@39 which was called: # once (47µs+82µs) by Class::MOP::BEGIN@9 at line 39
no warnings 'redefine';
# spent 128µs making 1 call to MRO::Compat::BEGIN@39 # spent 82µs making 1 call to warnings::unimport
40 *Class::C3::initialize = sub { 1 };
41 *Class::C3::reinitialize = sub { 1 };
42 *Class::C3::uninitialize = sub { 1 };
43 }
441151µs11.69ms}
# spent 1.69ms making 1 call to MRO::Compat::BEGIN@10
45
46=head1 NAME
47
- -
115sub __get_linear_isa_dfs {
11631.41ms2174µs
# spent 106µs (39+67) within MRO::Compat::BEGIN@116 which was called: # once (39µs+67µs) by Class::MOP::BEGIN@9 at line 116
no strict 'refs';
# spent 106µs making 1 call to MRO::Compat::BEGIN@116 # spent 67µs making 1 call to strict::unimport
117
118 my $classname = shift;
119
120 my @lin = ($classname);
121 my %stored;
122 foreach my $parent (@{"$classname\::ISA"}) {
123 my $plin = __get_linear_isa_dfs($parent);
124 foreach (@$plin) {
125 next if exists $stored{$_};
126 push(@lin, $_);
127 $stored{$_} = 1;
128 }
129 }
130 return \@lin;
131}
132
133sub __get_linear_isa {
134 my ($classname, $type) = @_;
135 die "mro::get_mro requires a classname" if !defined $classname;
136
137 $type ||= __get_mro($classname);
138 if($type eq 'dfs') {
139 return __get_linear_isa_dfs($classname);
140 }
141 elsif($type eq 'c3') {
142 return [Class::C3::calculateMRO($classname)];
143 }
144 die "type argument must be 'dfs' or 'c3'";
145}
146
147=head2 mro::import
148
- -
156sub __import {
157 if($_[1]) {
158 goto &Class::C3::import if $_[1] eq 'c3';
159 __set_mro(scalar(caller), $_[1]);
160 }
161}
162
163=head2 mro::set_mro($classname, $type)
164
- -
171sub __set_mro {
172 my ($classname, $type) = @_;
173
174 if(!defined $classname || !$type) {
175 die q{Usage: mro::set_mro($classname, $type)};
176 }
177
178 if($type eq 'c3') {
179 eval "package $classname; use Class::C3";
180 die $@ if $@;
181 }
182 elsif($type eq 'dfs') {
183 # In the dfs case, check whether we need to undo C3
184 if(defined $Class::C3::MRO{$classname}) {
185 Class::C3::_remove_method_dispatch_table($classname);
186 }
187 delete $Class::C3::MRO{$classname};
188 }
189 else {
190 die qq{Invalid mro type "$type"};
191 }
192
193 return;
194}
195
196=head2 mro::get_mro($classname)
197
- -
205sub __get_mro {
206 my $classname = shift;
207 die "mro::get_mro requires a classname" if !defined $classname;
208 return 'c3' if exists $Class::C3::MRO{$classname};
209 return 'dfs';
210}
211
212=head2 mro::get_isarev($classname)
213
- -
224sub __get_all_pkgs_with_isas {
2253100µs2180µs
# spent 111µs (42+69) within MRO::Compat::BEGIN@225 which was called: # once (42µs+69µs) by Class::MOP::BEGIN@9 at line 225
no strict 'refs';
# spent 111µs making 1 call to MRO::Compat::BEGIN@225 # spent 69µs making 1 call to strict::unimport
2263647µs2166µs
# spent 101µs (37+65) within MRO::Compat::BEGIN@226 which was called: # once (37µs+65µs) by Class::MOP::BEGIN@9 at line 226
no warnings 'recursion';
# spent 101µs making 1 call to MRO::Compat::BEGIN@226 # spent 65µs making 1 call to warnings::unimport
227
228 my @retval;
229
230 my $search = shift;
231 my $pfx;
232 my $isa;
233 if(defined $search) {
234 $isa = \@{"$search\::ISA"};
235 $pfx = "$search\::";
236 }
237 else {
238 $search = 'main';
239 $isa = \@main::ISA;
240 $pfx = '';
241 }
242
243 push(@retval, $search) if scalar(@$isa);
244
245 foreach my $cand (keys %{"$search\::"}) {
246 if($cand =~ s/::$//) {
247 next if $cand eq $search; # skip self-reference (main?)
248 push(@retval, @{__get_all_pkgs_with_isas($pfx . $cand)});
249 }
250 }
251
252 return \@retval;
253}
254
255sub __get_isarev_recurse {
25631.28ms2163µs
# spent 100µs (38+63) within MRO::Compat::BEGIN@256 which was called: # once (38µs+63µs) by Class::MOP::BEGIN@9 at line 256
no strict 'refs';
# spent 100µs making 1 call to MRO::Compat::BEGIN@256 # spent 62µs making 1 call to strict::unimport
257
258 my ($class, $all_isas, $level) = @_;
259
260 die "Recursive inheritance detected" if $level > 100;
261
262 my %retval;
263
264 foreach my $cand (@$all_isas) {
265 my $found_me;
266 foreach (@{"$cand\::ISA"}) {
267 if($_ eq $class) {
268 $found_me = 1;
269 last;
270 }
271 }
272 if($found_me) {
273 $retval{$cand} = 1;
274 map { $retval{$_} = 1 }
275 @{__get_isarev_recurse($cand, $all_isas, $level+1)};
276 }
277 }
278 return [keys %retval];
279}
280
281sub __get_isarev {
282 my $classname = shift;
283 die "mro::get_isarev requires a classname" if !defined $classname;
284
285 __get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0);
286}
287
288=head2 mro::is_universal($classname)
289
- -
300sub __is_universal {
301 my $classname = shift;
302 die "mro::is_universal requires a classname" if !defined $classname;
303
304 my $lin = __get_linear_isa('UNIVERSAL');
305 foreach (@$lin) {
306 return 1 if $classname eq $_;
307 }
308
309 return 0;
310}
311
312=head2 mro::invalidate_all_method_caches
313
- -
323sub __invalidate_all_method_caches {
324 # Super secret mystery code :)
325 @f845a9c1ac41be33::ISA = @f845a9c1ac41be33::ISA;
326 return;
327}
328
329=head2 mro::method_changed_in($classname)
330
- -
344sub __method_changed_in {
345 my $classname = shift;
346 die "mro::method_changed_in requires a classname" if !defined $classname;
347
348 __invalidate_all_method_caches();
349}
350
351=head2 mro::get_pkg_gen($classname)
352
- -
360{
36128µs my $__pkg_gen = 2;
362 sub __get_pkg_gen_pp {
363 my $classname = shift;
364 die "mro::get_pkg_gen requires a classname" if !defined $classname;
365 return $__pkg_gen++;
366 }
367}
368
369sub __get_pkg_gen_c3xs {
370 my $classname = shift;
371 die "mro::get_pkg_gen requires a classname" if !defined $classname;
372
373 return Class::C3::XS::_plsubgen();
374}
375
376=head1 USING C3
377
- -
409112µs1;
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.