← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:18 2017

Filename/usr/local/lib/perl5/5.24/base.pm
StatementsExecuted 987 statements in 11.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
25251356.7ms258msbase::::import base::import (recurses: max depth 2, inclusive time 206ms)
2411692µs958µsbase::::__ANON__[:77] base::__ANON__[:77]
2411443µs443µsbase::::has_fields base::has_fields
2411343µs343µsbase::::has_attr base::has_attr
2411168µs168µsbase::::CORE:subst base::CORE:subst (opcode)
21189µs89µsbase::::CORE:regcomp base::CORE:regcomp (opcode)
261186µs86µsbase::::CORE:match base::CORE:match (opcode)
11142µs42µsSocket6::::BEGIN@1 Socket6::BEGIN@1
11129µs123µsbase::::BEGIN@5 base::BEGIN@5
11121µs84µsbase::::BEGIN@4 base::BEGIN@4
0000s0sbase::::__ANON__[:134] base::__ANON__[:134]
0000s0sbase::::__ANON__[:135] base::__ANON__[:135]
0000s0sbase::::__ANON__[:54] base::__ANON__[:54]
0000s0sbase::::__ANON__[:61] base::__ANON__[:61]
0000s0sbase::::__ANON__[:69] base::__ANON__[:69]
0000s0sbase::__inc::scope_guard::::DESTROYbase::__inc::scope_guard::DESTROY
0000s0sbase::__inc::::unhook base::__inc::unhook
0000s0sbase::::get_attr base::get_attr
0000s0sbase::::inherit_fields base::inherit_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
12127µs142µs
# spent 42µs within Socket6::BEGIN@1 which was called: # once (42µs+0s) by Socket6::BEGIN@215 at line 1
use 5.008;
# spent 42µs making 1 call to Socket6::BEGIN@1
2package base;
3
4288µs2148µs
# spent 84µs (21+63) within base::BEGIN@4 which was called: # once (21µs+63µs) by Socket6::BEGIN@215 at line 4
use strict 'vars';
# spent 84µs making 1 call to base::BEGIN@4 # spent 63µs making 1 call to strict::import
522.63ms2216µs
# spent 123µs (29+94) within base::BEGIN@5 which was called: # once (29µs+94µs) by Socket6::BEGIN@215 at line 5
use vars qw($VERSION);
# spent 123µs making 1 call to base::BEGIN@5 # spent 94µs making 1 call to vars::import
613µs$VERSION = '2.23_01';
718µs$VERSION =~ tr/_//d;
8
9# simplest way to avoid indexing of the package: no package statement
10sub base::__inc::unhook { @INC = grep !(ref eq 'CODE' && $_ == $_[0]), @INC }
11# instance is blessed array of coderefs to be removed from @INC at scope exit
12sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} }
13
14# constant.pm is slow
15sub SUCCESS () { 1 }
16
17sub PUBLIC () { 2**0 }
18sub PRIVATE () { 2**1 }
19sub INHERITED () { 2**2 }
20sub PROTECTED () { 2**3 }
21
22
2312µsmy $Fattr = \%fields::attr;
24
25
# spent 443µs within base::has_fields which was called 24 times, avg 18µs/call: # 24 times (443µs+0s) by base::import at line 178, avg 18µs/call
sub has_fields {
262478µs my($base) = shift;
2748208µs my $fglob = ${"$base\::"}{FIELDS};
2824221µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
29}
30
31
# spent 343µs within base::has_attr which was called 24 times, avg 14µs/call: # 24 times (343µs+0s) by base::import at line 178, avg 14µs/call
sub has_attr {
322469µs my($proto) = shift;
332456µs my($class) = ref $proto || $proto;
3424271µs return exists $Fattr->{$class};
35}
36
37sub get_attr {
38 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
39 return $Fattr->{$_[0]};
40}
41
42111µsif ($] < 5.009) {
43 *get_fields = sub {
44 # Shut up a possible typo warning.
45 () = \%{$_[0].'::FIELDS'};
46 my $f = \%{$_[0].'::FIELDS'};
47
48 # should be centralized in fields? perhaps
49 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
50 # is used here anyway, it doesn't matter.
51 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
52
53 return $f;
54 }
55}
56else {
57 *get_fields = sub {
58 # Shut up a possible typo warning.
59 () = \%{$_[0].'::FIELDS'};
60 return \%{$_[0].'::FIELDS'};
61 }
6217µs}
63
6419µsif ($] < 5.008) {
65 *_module_to_filename = sub {
66 (my $fn = $_[0]) =~ s!::!/!g;
67 $fn .= '.pm';
68 return $fn;
69 }
70}
71else {
72
# spent 958µs (692+266) within base::__ANON__[/usr/local/lib/perl5/5.24/base.pm:77] which was called 24 times, avg 40µs/call: # 24 times (692µs+266µs) by base::import at line 104, avg 40µs/call
*_module_to_filename = sub {
7324382µs24168µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 168µs making 24 calls to base::CORE:subst, avg 7µs/call
742454µs $fn .= '.pm';
7524302µs2498µs utf8::encode($fn);
# spent 98µs making 24 calls to utf8::encode, avg 4µs/call
7624233µs return $fn;
77 }
7815µs}
79
80
81
# spent 258ms (56.7+201) within base::import which was called 25 times, avg 10.3ms/call: # once (1.31ms+144ms) by Net::DNS::Resolver::BEGIN@22 at line 22 of Net/DNS/Resolver.pm # once (25.1ms+71.8ms) by Razor2::Client::Agent::BEGIN@20 at line 20 of Razor2/Client/Agent.pm # once (7.75ms+5.34ms) by Razor2::Client::Agent::BEGIN@21 at line 21 of Razor2/Client/Agent.pm # once (348µs+174µs) by Net::DNS::RR::OPT::DHU::BEGIN@233 at line 233 of Net/DNS/RR/OPT.pm # once (333µs+177µs) by Socket6::BEGIN@215 at line 215 of Socket6.pm # once (286µs+110µs) by Net::DNS::RR::OPT::N3U::BEGIN@236 at line 236 of Net/DNS/RR/OPT.pm # once (178µs+71µs) by Net::DNS::RR::A::BEGIN@11 at line 11 of Net/DNS/RR/A.pm # once (170µs+72µs) by Net::DNS::BEGIN@38 at line 38 of Net/DNS.pm # once (162µs+80µs) by Net::DNS::Update::BEGIN@37 at line 37 of Net/DNS/Update.pm # once (161µs+78µs) by Net::DNS::RR::OPT::BEGIN@11 at line 11 of Net/DNS/RR/OPT.pm # once (169µs+64µs) by Net::DNS::RR::AAAA::BEGIN@11 at line 11 of Net/DNS/RR/AAAA.pm # once (66µs+4µs) by Razor2::Client::Agent::BEGIN@22 at line 22 of Razor2/Client/Agent.pm # once (51µs+3µs) by Razor2::Client::Agent::BEGIN@23 at line 23 of Razor2/Client/Agent.pm # once (1.44ms+-1.44ms) by Razor2::Client::Core::BEGIN@23 at line 23 of Razor2/Client/Core.pm # once (2.55ms+-2.55ms) by Razor2::Client::Core::BEGIN@22 at line 22 of Razor2/Client/Core.pm # once (175µs+-175µs) by Razor2::Client::Core::BEGIN@21 at line 21 of Razor2/Client/Core.pm # once (1.20ms+-1.20ms) by Razor2::Client::Core::BEGIN@24 at line 24 of Razor2/Client/Core.pm # once (151µs+-151µs) by Net::DNS::DomainName1035::BEGIN@158 at line 158 of Net/DNS/DomainName.pm # once (150µs+-150µs) by Net::DNS::DomainName::BEGIN@43 at line 43 of Net/DNS/DomainName.pm # once (168µs+-168µs) by Net::DNS::DomainName2535::BEGIN@220 at line 220 of Net/DNS/DomainName.pm # once (170µs+-170µs) by IO::Socket::IP::BEGIN@15 at line 15 of IO/Socket/IP.pm # once (171µs+-171µs) by IO::Socket::IP::_ForINET6::BEGIN@1172 at line 1172 of IO/Socket/IP.pm # once (165µs+-165µs) by IO::Socket::IP::_ForINET::BEGIN@1158 at line 1158 of IO/Socket/IP.pm # once (154µs+-154µs) by Net::DNS::Parameters::BEGIN@22 at line 22 of Net/DNS/Parameters.pm # once (14.2ms+-14.2ms) by Net::DNS::Resolver::UNIX::BEGIN@18 at line 18 of Net/DNS/Resolver/UNIX.pm
sub import {
822556µs my $class = shift;
83
842551µs return SUCCESS unless @_;
85
86 # List of base classes from which we will inherit %FIELDS.
872545µs my $fields_base;
88
892571µs my $inheritor = caller(0);
90
912542µs my @bases;
9225126µs foreach my $base (@_) {
932664µs if ( $inheritor eq $base ) {
94 warn "Class '$inheritor' tried to inherit from itself\n";
95 }
96
9726690µs27139µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 139µs making 27 calls to UNIVERSAL::isa, avg 5µs/call
98
99 # Following blocks help isolate $SIG{__DIE__} and @INC changes
100 {
10148139µs my $sigdie;
102 {
10348244µs local $SIG{__DIE__};
10424235µs24958µs my $fn = _module_to_filename($base);
# spent 958µs making 24 calls to base::__ANON__[base.pm:77], avg 40µs/call
1052439µs my $dot_hidden;
1062491µs eval {
1072460µs my $guard;
1082450µs if ($INC[-1] eq '.' && %{"$base\::"}) {
109 # So: the package already exists => this an optional load
110 # And: there is a dot at the end of @INC => we want to hide it
111 # However: we only want to hide it during our *own* require()
112 # (i.e. without affecting nested require()s).
113 # So we add a hook to @INC whose job is to hide the dot, but which
114 # first checks checks the callstack depth, because within nested
115 # require()s the callstack is deeper.
116 # Since CORE::GLOBAL::require makes it unknowable in advance what
117 # the exact relevant callstack depth will be, we have to record it
118 # inside a hook. So we put another hook just for that at the front
119 # of @INC, where it's guaranteed to run -- immediately.
120 # The dot-hiding hook does its job by sitting directly in front of
121 # the dot and removing itself from @INC when reached. This causes
122 # the dot to move up one index in @INC, causing the loop inside
123 # pp_require() to skip it.
124 # Loaded coded may disturb this precise arrangement, but that's OK
125 # because the hook is inert by that time. It is only active during
126 # the top-level require(), when @INC is in our control. The only
127 # possible gotcha is if other hooks already in @INC modify @INC in
128 # some way during that initial require().
129 # Note that this jiggery hookery works just fine recursively: if
130 # a module loaded via base.pm uses base.pm itself, there will be
131 # one pair of hooks in @INC per base::import call frame, but the
132 # pairs from different nestings do not interfere with each other.
133 my $lvl;
134 unshift @INC, sub { return if defined $lvl; 1 while defined caller ++$lvl; () };
135 splice @INC, -1, 0, sub { return if defined caller $lvl; ++$dot_hidden, &base::__inc::unhook; () };
136 $guard = bless [ @INC[0,-2] ], 'base::__inc::scope_guard';
137 }
138242.33ms require $fn
139 };
1402443µs if ($dot_hidden && (my @fn = grep -e && !( -d _ || -b _ ), $fn.'c', $fn)) {
141 require Carp;
142 Carp::croak(<<ERROR);
143Base class package "$base" is not empty but "$fn[0]" exists in the current directory.
144 To help avoid security issues, base.pm now refuses to load optional modules
145 from the current working directory when it is the last entry in \@INC.
146 If your software worked on previous versions of Perl, the best solution
147 is to use FindBin to detect the path properly and to add that path to
148 \@INC. As a last resort, you can re-enable looking in the current working
149 directory by adding "use lib '.'" to your code.
150ERROR
151 }
152 # Only ignore "Can't locate" errors from our eval require.
153 # Other fatal errors (syntax etc) must be reported.
154 #
155 # changing the check here is fragile - if the check
156 # here isn't catching every error you want, you should
157 # probably be using parent.pm, which doesn't try to
158 # guess whether require is needed or failed,
159 # see [perl #118561]
16024427µs28176µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 89µs making 2 calls to base::CORE:regcomp, avg 45µs/call # spent 86µs making 26 calls to base::CORE:match, avg 3µs/call
161 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
16248187µs unless (%{"$base\::"}) {
163 require Carp;
164 local $" = " ";
165 Carp::croak(<<ERROR);
166Base class package "$base" is empty.
167 (Perhaps you need to 'use' the module which defines that package first,
168 or make that module available in \@INC (\@INC contains: @INC).
169ERROR
170 }
17124246µs $sigdie = $SIG{__DIE__} || undef;
172 }
173 # Make sure a global $SIG{__DIE__} makes it out of the localization.
1742461µs $SIG{__DIE__} = $sigdie if defined $sigdie;
175 }
1762467µs push @bases, $base;
177
17824365µs48786µs if ( has_fields($base) || has_attr($base) ) {
# spent 443µs making 24 calls to base::has_fields, avg 18µs/call # spent 343µs making 24 calls to base::has_attr, avg 14µs/call
179 # No multiple fields inheritance *suck*
180 if ($fields_base) {
181 require Carp;
182 Carp::croak("Can't multiply inherit fields");
183 } else {
184 $fields_base = $base;
185 }
186 }
187 }
188 # Save this until the end so it's all or nothing if the above loop croaks.
18950700µs push @{"$inheritor\::ISA"}, @bases;
190
19125322µs if( defined $fields_base ) {
192 inherit_fields($inheritor, $fields_base);
193 }
194}
195
196
197sub inherit_fields {
198 my($derived, $base) = @_;
199
200 return SUCCESS unless $base;
201
202 my $battr = get_attr($base);
203 my $dattr = get_attr($derived);
204 my $dfields = get_fields($derived);
205 my $bfields = get_fields($base);
206
207 $dattr->[0] = @$battr;
208
209 if( keys %$dfields ) {
210 warn <<"END";
211$derived is inheriting from $base but already has its own fields!
212This will cause problems. Be sure you use base BEFORE declaring fields.
213END
214
215 }
216
217 # Iterate through the base's fields adding all the non-private
218 # ones to the derived class. Hang on to the original attribute
219 # (Public, Private, etc...) and add Inherited.
220 # This is all too complicated to do efficiently with add_fields().
221 while (my($k,$v) = each %$bfields) {
222 my $fno;
223 if ($fno = $dfields->{$k} and $fno != $v) {
224 require Carp;
225 Carp::croak ("Inherited fields can't override existing fields");
226 }
227
228 if( $battr->[$v] & PRIVATE ) {
229 $dattr->[$v] = PRIVATE | INHERITED;
230 }
231 else {
232 $dattr->[$v] = INHERITED | $battr->[$v];
233 $dfields->{$k} = $v;
234 }
235 }
236
237 foreach my $idx (1..$#{$battr}) {
238 next if defined $dattr->[$idx];
239 $dattr->[$idx] = $battr->[$idx] & INHERITED;
240 }
241}
242
243
244122µs1;
245
246__END__
 
# spent 86µs within base::CORE:match which was called 26 times, avg 3µs/call: # 26 times (86µs+0s) by base::import at line 160, avg 3µs/call
sub base::CORE:match; # opcode
# spent 89µs within base::CORE:regcomp which was called 2 times, avg 45µs/call: # 2 times (89µs+0s) by base::import at line 160, avg 45µs/call
sub base::CORE:regcomp; # opcode
# spent 168µs within base::CORE:subst which was called 24 times, avg 7µs/call: # 24 times (168µs+0s) by base::__ANON__[/usr/local/lib/perl5/5.24/base.pm:77] at line 73, avg 7µs/call
sub base::CORE:subst; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.