Profile of SelfLoader.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For bin/dpath
Run on Tue Jun 5 15:31:33 2012
Reported on Tue Jun 5 15:31:39 2012

Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/SelfLoader.pm
Statements | Executed 25 statements in 6.54ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 10.5ms | 18.0ms | SelfLoader::::BEGIN@4SelfLoader::BEGIN@4
1 | 1 | 1 | 530µs | 3.69ms | SelfLoader::::BEGIN@10SelfLoader::BEGIN@10
1 | 1 | 1 | 63µs | 63µs | SelfLoader::::BEGIN@2SelfLoader::BEGIN@2
1 | 1 | 1 | 41µs | 142µs | SelfLoader::::BEGIN@42SelfLoader::BEGIN@42
1 | 1 | 1 | 41µs | 55µs | SelfLoader::::BEGIN@158SelfLoader::BEGIN@158
1 | 1 | 1 | 37µs | 54µs | SelfLoader::::BEGIN@73SelfLoader::BEGIN@73
1 | 1 | 1 | 35µs | 137µs | SelfLoader::::BEGIN@9SelfLoader::BEGIN@9
1 | 1 | 1 | 30µs | 30µs | SelfLoader::::CORE:qrSelfLoader::CORE:qr (opcode)
1 | 1 | 1 | 28µs | 39µs | SelfLoader::::BEGIN@93SelfLoader::BEGIN@93
1 | 1 | 1 | 27µs | 38µs | SelfLoader::::BEGIN@3SelfLoader::BEGIN@3
1 | 1 | 1 | 27µs | 78µs | SelfLoader::::BEGIN@91SelfLoader::BEGIN@91
0 | 0 | 0 | 0s | 0s | SelfLoader::::AUTOLOADSelfLoader::AUTOLOAD
0 | 0 | 0 | 0s | 0s | SelfLoader::::VersionSelfLoader::Version
0 | 0 | 0 | 0s | 0s | SelfLoader::::_add_to_cacheSelfLoader::_add_to_cache
0 | 0 | 0 | 0s | 0s | SelfLoader::::_load_stubsSelfLoader::_load_stubs
0 | 0 | 0 | 0s | 0s | SelfLoader::::_package_definedSelfLoader::_package_defined
0 | 0 | 0 | 0s | 0s | SelfLoader::::carpSelfLoader::carp
0 | 0 | 0 | 0s | 0s | SelfLoader::::croakSelfLoader::croak
0 | 0 | 0 | 0s | 0s | SelfLoader::::load_stubsSelfLoader::load_stubs

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package SelfLoader;
2 | 2 | 157µs | 1 | 63µs | # spent 63µs within SelfLoader::BEGIN@2 which was called: # once (63µs+0s) by Text::Balanced::BEGIN@9 at line 2 use 5.008; # spent 63µs making 1 call to SelfLoader::BEGIN@2
3 | 2 | 89µs | 2 | 50µs | # spent 38µs (27+11) within SelfLoader::BEGIN@3 which was called: # once (27µs+11µs) by Text::Balanced::BEGIN@9 at line 3 use strict; # spent 38µs making 1 call to SelfLoader::BEGIN@3 # spent 11µs making 1 call to strict::import
4 | 2 | 1.21ms | 2 | 18.1ms | # spent 18.0ms (10.5+7.49) within SelfLoader::BEGIN@4 which was called: # once (10.5ms+7.49ms) by Text::Balanced::BEGIN@9 at line 4 use IO::Handle; # spent 18.0ms making 1 call to SelfLoader::BEGIN@4 # spent 98µs making 1 call to Exporter::import
5 | 1 | 3µs |  |  | our $VERSION = "1.18";
6 |  |  |  |  |
7 |  |  |  |  | # The following bit of eval-magic is necessary to make this work on
8 |  |  |  |  | # perls < 5.009005.
9 | 2 | 266µs | 2 | 238µs | # spent 137µs (35+101) within SelfLoader::BEGIN@9 which was called: # once (35µs+101µs) by Text::Balanced::BEGIN@9 at line 9 use vars qw/$AttrList/; # spent 137µs making 1 call to SelfLoader::BEGIN@9 # spent 101µs making 1 call to vars::import
10 |  |  |  |  | # spent 3.69ms (530µs+3.16) within SelfLoader::BEGIN@10 which was called: # once (530µs+3.16ms) by Text::Balanced::BEGIN@9 at line 41 BEGIN {
11 | 2 | 132µs |  |  | if ($] > 5.009004) {
12 |  |  |  |  | eval <<'NEWERPERL'; # spent 3.37ms executing statements in string eval # includes 3.04ms spent executing 2 calls to 2 subs defined therein.
13 |  |  |  |  | use 5.009005; # due to new regexp features
14 |  |  |  |  | # allow checking for valid ': attrlist' attachments
15 |  |  |  |  | # see also AutoSplit
16 |  |  |  |  | $AttrList = qr{
17 |  |  |  |  | \s* : \s*
18 |  |  |  |  | (?:
19 |  |  |  |  | # one attribute
20 |  |  |  |  | (?> # no backtrack
21 |  |  |  |  | (?! \d) \w+
22 |  |  |  |  | (?<nested> \( (?: [^()]++ | (?&nested)++ )*+ \) ) ?
23 |  |  |  |  | )
24 |  |  |  |  | (?: \s* : \s* | \s+ (?! :) )
25 |  |  |  |  | )*
26 |  |  |  |  | }x;
27 |  |  |  |  |
28 |  |  |  |  | NEWERPERL
29 |  |  |  |  | }
30 |  |  |  |  | else {
31 |  |  |  |  | eval <<'OLDERPERL';
32 |  |  |  |  | # allow checking for valid ': attrlist' attachments
33 |  |  |  |  | # (we use 'our' rather than 'my' here, due to the rather complex and buggy
34 |  |  |  |  | # behaviour of lexicals with qr// and (??{$lex}) )
35 |  |  |  |  | our $nested;
36 |  |  |  |  | $nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
37 |  |  |  |  | our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
38 |  |  |  |  | $AttrList = qr{ \s* : \s* (?: $one_attr )* }x;
39 |  |  |  |  | OLDERPERL
40 |  |  |  |  | }
41 | 1 | 113µs | 1 | 3.69ms | } # spent 3.69ms making 1 call to SelfLoader::BEGIN@10
42 | 2 | 1.09ms | 2 | 243µs | # spent 142µs (41+101) within SelfLoader::BEGIN@42 which was called: # once (41µs+101µs) by Text::Balanced::BEGIN@9 at line 42 use Exporter; # spent 142µs making 1 call to SelfLoader::BEGIN@42 # spent 101µs making 1 call to Exporter::import
43 | 1 | 29µs |  |  | our @ISA = qw(Exporter);
44 | 1 | 4µs |  |  | our @EXPORT = qw(AUTOLOAD);
45 |  |  |  |  | sub Version {$VERSION}
46 |  |  |  |  | sub DEBUG () { 0 }
47 |  |  |  |  |
48 | 1 | 1µs |  |  | my %Cache; # private cache for all SelfLoader's client packages
49 |  |  |  |  |
50 |  |  |  |  | # in croak and carp, protect $@ from "require Carp;" RT #40216
51 |  |  |  |  |
52 |  |  |  |  | sub croak { { local $@; require Carp; } goto &Carp::croak }
53 |  |  |  |  | sub carp { { local $@; require Carp; } goto &Carp::carp }
54 |  |  |  |  |
55 |  |  |  |  | AUTOLOAD {
56 |  |  |  |  | our $AUTOLOAD;
57 |  |  |  |  | print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if DEBUG;
58 |  |  |  |  | my $SL_code = $Cache{$AUTOLOAD};
59 |  |  |  |  | my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@
60 |  |  |  |  | unless ($SL_code) {
61 |  |  |  |  | # Maybe this pack had stubs before __DATA__, and never initialized.
62 |  |  |  |  | # Or, this maybe an automatic DESTROY method call when none exists.
63 |  |  |  |  | $AUTOLOAD =~ m/^(.*)::/;
64 |  |  |  |  | SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
65 |  |  |  |  | $SL_code = $Cache{$AUTOLOAD};
66 |  |  |  |  | $SL_code = "sub $AUTOLOAD { }"
67 |  |  |  |  | if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
68 |  |  |  |  | croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
69 |  |  |  |  | }
70 |  |  |  |  | print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if DEBUG;
71 |  |  |  |  |
72 |  |  |  |  | {
73 | 2 | 542µs | 2 | 70µs | # spent 54µs (37+16) within SelfLoader::BEGIN@73 which was called: # once (37µs+16µs) by Text::Balanced::BEGIN@9 at line 73 no strict; # spent 54µs making 1 call to SelfLoader::BEGIN@73 # spent 16µs making 1 call to strict::unimport
74 |  |  |  |  | eval $SL_code;
75 |  |  |  |  | }
76 |  |  |  |  | if ($@) {
77 |  |  |  |  | $@ =~ s/ at .*\n//;
78 |  |  |  |  | croak $@;
79 |  |  |  |  | }
80 |  |  |  |  | $@ = $save;
81 |  |  |  |  | defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
82 |  |  |  |  | delete $Cache{$AUTOLOAD};
83 |  |  |  |  | goto &$AUTOLOAD
84 |  |  |  |  | }
85 |  |  |  |  |
86 |  |  |  |  | sub load_stubs { shift->_load_stubs((caller)[0]) }
87 |  |  |  |  |
88 |  |  |  |  | sub _load_stubs {
89 |  |  |  |  | # $endlines is used by Devel::SelfStubber to capture lines after __END__
90 |  |  |  |  | my($self, $callpack, $endlines) = @_;
91 | 2 | 142µs | 2 | 129µs | # spent 78µs (27+51) within SelfLoader::BEGIN@91 which was called: # once (27µs+51µs) by Text::Balanced::BEGIN@9 at line 91 no strict "refs"; # spent 78µs making 1 call to SelfLoader::BEGIN@91 # spent 51µs making 1 call to strict::unimport
92 |  |  |  |  | my $fh = \*{"${callpack}::DATA"};
93 | 2 | 2.01ms | 2 | 50µs | # spent 39µs (28+11) within SelfLoader::BEGIN@93 which was called: # once (28µs+11µs) by Text::Balanced::BEGIN@9 at line 93 use strict; # spent 39µs making 1 call to SelfLoader::BEGIN@93 # spent 11µs making 1 call to strict::import
94 |  |  |  |  | my $currpack = $callpack;
95 |  |  |  |  | my($line,$name,@lines, @stubs, $protoype);
96 |  |  |  |  |
97 |  |  |  |  | print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG;
98 |  |  |  |  | croak("$callpack doesn't contain an __DATA__ token")
99 |  |  |  |  | unless defined fileno($fh);
100 |  |  |  |  | # Protect: fork() shares the file pointer between the parent and the kid
101 |  |  |  |  | if(sysseek($fh, tell($fh), 0)) {
102 |  |  |  |  | open my $nfh, '<&', $fh or croak "reopen: $!";# dup() the fd
103 |  |  |  |  | close $fh or die "close: $!"; # autocloses, but be paranoid
104 |  |  |  |  | open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
105 |  |  |  |  | close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
106 |  |  |  |  | $fh->untaint;
107 |  |  |  |  | }
108 |  |  |  |  | $Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
109 |  |  |  |  |
110 |  |  |  |  | local($/) = "\n";
111 |  |  |  |  | while(defined($line = <$fh>) and $line !~ m/^__END__/) {
112 |  |  |  |  | if ($line =~ m/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) {
113 |  |  |  |  | push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
114 |  |  |  |  | $protoype = $2;
115 |  |  |  |  | @lines = ($line);
116 |  |  |  |  | if (index($1,'::') == -1) { # simple sub name
117 |  |  |  |  | $name = "${currpack}::$1";
118 |  |  |  |  | } else { # sub name with package
119 |  |  |  |  | $name = $1;
120 |  |  |  |  | $name =~ m/^(.*)::/;
121 |  |  |  |  | if (defined(&{"${1}::AUTOLOAD"})) {
122 |  |  |  |  | \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
123 |  |  |  |  | die 'SelfLoader Error: attempt to specify Selfloading',
124 |  |  |  |  | " sub $name in non-selfloading module $1";
125 |  |  |  |  | } else {
126 |  |  |  |  | $self->export($1,'AUTOLOAD');
127 |  |  |  |  | }
128 |  |  |  |  | }
129 |  |  |  |  | } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
130 |  |  |  |  | push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
131 |  |  |  |  | $self->_package_defined($line);
132 |  |  |  |  | $name = '';
133 |  |  |  |  | @lines = ();
134 |  |  |  |  | $currpack = $1;
135 |  |  |  |  | $Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
136 |  |  |  |  | if (defined(&{"${1}::AUTOLOAD"})) {
137 |  |  |  |  | \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
138 |  |  |  |  | die 'SelfLoader Error: attempt to specify Selfloading',
139 |  |  |  |  | " package $currpack which already has AUTOLOAD";
140 |  |  |  |  | } else {
141 |  |  |  |  | $self->export($currpack,'AUTOLOAD');
142 |  |  |  |  | }
143 |  |  |  |  | } else {
144 |  |  |  |  | push(@lines,$line);
145 |  |  |  |  | }
146 |  |  |  |  | }
147 |  |  |  |  | if (defined($line) && $line =~ /^__END__/) { # __END__
148 |  |  |  |  | unless ($line =~ /^__END__\s*DATA/) {
149 |  |  |  |  | if ($endlines) {
150 |  |  |  |  | # Devel::SelfStubber would like us to capture the lines after
151 |  |  |  |  | # __END__ so it can write out the entire file
152 |  |  |  |  | @$endlines = <$fh>;
153 |  |  |  |  | }
154 |  |  |  |  | close($fh);
155 |  |  |  |  | }
156 |  |  |  |  | }
157 |  |  |  |  | push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
158 | 2 | 730µs | 2 | 70µs | # spent 55µs (41+14) within SelfLoader::BEGIN@158 which was called: # once (41µs+14µs) by Text::Balanced::BEGIN@9 at line 158 no strict; # spent 55µs making 1 call to SelfLoader::BEGIN@158 # spent 14µs making 1 call to strict::unimport
159 |  |  |  |  | eval join('', @stubs) if @stubs;
160 |  |  |  |  | }
161 |  |  |  |  |
162 |  |  |  |  |
163 |  |  |  |  | sub _add_to_cache {
164 |  |  |  |  | my($self,$fullname,$pack,$lines, $protoype) = @_;
165 |  |  |  |  | return () unless $fullname;
166 |  |  |  |  | carp("Redefining sub $fullname")
167 |  |  |  |  | if exists $Cache{$fullname};
168 |  |  |  |  | $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack; ", @$lines);
169 |  |  |  |  | #$Cache{$fullname} = join('', "package $pack; ",@$lines);
170 |  |  |  |  | print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG;
171 |  |  |  |  | # return stub to be eval'd
172 |  |  |  |  | defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
173 |  |  |  |  | }
174 |  |  |  |  |
175 |  |  |  |  | sub _package_defined {}
176 |  |  |  |  |
177 | 1 | 20µs |  |  | 1;
178 |  |  |  |  | __END__
|  |  |  |  | # spent 30µs within SelfLoader::CORE:qr which was called: # once (30µs+0s) by SelfLoader::BEGIN@10 at line 4 of (eval 31)[SelfLoader.pm:12] sub SelfLoader::CORE:qr; # opcode