← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 20:36:06 2020
Reported on Wed Feb 12 21:42:25 2020

Filename/usr/share/perl/5.28/base.pm
StatementsExecuted 493 statements in 2.34ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1313131.22ms4.11msbase::::import base::import
1311104µs151µsbase::::__ANON__[:75] base::__ANON__[:75]
1311104µs104µsbase::::has_attr base::has_attr
131150µs50µsbase::::has_fields base::has_fields
131131µs31µsbase::::CORE:subst base::CORE:subst (opcode)
11113µs13µsYAML::XS::::BEGIN@1 YAML::XS::BEGIN@1
1118µs16µsbase::::BEGIN@4 base::BEGIN@4
13115µs5µsbase::::CORE:match base::CORE:match (opcode)
0000s0sbase::::__ANON__[:131] base::__ANON__[:131]
0000s0sbase::::__ANON__[:132] base::__ANON__[:132]
0000s0sbase::::__ANON__[:52] base::__ANON__[:52]
0000s0sbase::::__ANON__[:59] base::__ANON__[:59]
0000s0sbase::::__ANON__[:67] base::__ANON__[:67]
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
1258µs113µs
# spent 13µs within YAML::XS::BEGIN@1 which was called: # once (13µs+0s) by YAML::XS::BEGIN@6 at line 1
use 5.008;
# spent 13µs making 1 call to YAML::XS::BEGIN@1
2package base;
3
421.21ms225µs
# spent 16µs (8+8) within base::BEGIN@4 which was called: # once (8µs+8µs) by YAML::XS::BEGIN@6 at line 4
use strict 'vars';
# spent 16µs making 1 call to base::BEGIN@4 # spent 8µs making 1 call to strict::import
51400nsour $VERSION = '2.27';
611µs$VERSION =~ tr/_//d;
7
8# simplest way to avoid indexing of the package: no package statement
9sub base::__inc::unhook { @INC = grep !(ref eq 'CODE' && $_ == $_[0]), @INC }
10# instance is blessed array of coderefs to be removed from @INC at scope exit
11sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} }
12
13# constant.pm is slow
14sub SUCCESS () { 1 }
15
16sub PUBLIC () { 2**0 }
17sub PRIVATE () { 2**1 }
18sub INHERITED () { 2**2 }
19sub PROTECTED () { 2**3 }
20
211700nsmy $Fattr = \%fields::attr;
22
23
# spent 50µs within base::has_fields which was called 13 times, avg 4µs/call: # 13 times (50µs+0s) by base::import at line 175, avg 4µs/call
sub has_fields {
241311µs my($base) = shift;
251316µs my $fglob = ${"$base\::"}{FIELDS};
261327µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
27}
28
29
# spent 104µs within base::has_attr which was called 13 times, avg 8µs/call: # 13 times (104µs+0s) by base::import at line 175, avg 8µs/call
sub has_attr {
301311µs my($proto) = shift;
31139µs my($class) = ref $proto || $proto;
321330µs return exists $Fattr->{$class};
33}
34
35sub get_attr {
36 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
37 return $Fattr->{$_[0]};
38}
39
401900nsif ($] < 5.009) {
41 *get_fields = sub {
42 # Shut up a possible typo warning.
43 () = \%{$_[0].'::FIELDS'};
44 my $f = \%{$_[0].'::FIELDS'};
45
46 # should be centralized in fields? perhaps
47 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
48 # is used here anyway, it doesn't matter.
49 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
50
51 return $f;
52 }
53}
54else {
55 *get_fields = sub {
56 # Shut up a possible typo warning.
57 () = \%{$_[0].'::FIELDS'};
58 return \%{$_[0].'::FIELDS'};
59 }
6013µs}
61
621300nsif ($] < 5.008) {
63 *_module_to_filename = sub {
64 (my $fn = $_[0]) =~ s!::!/!g;
65 $fn .= '.pm';
66 return $fn;
67 }
68}
69else {
70
# spent 151µs (104+46) within base::__ANON__[/usr/share/perl/5.28/base.pm:75] which was called 13 times, avg 12µs/call: # 13 times (104µs+46µs) by base::import at line 101, avg 12µs/call
*_module_to_filename = sub {
711366µs1331µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 31µs making 13 calls to base::CORE:subst, avg 2µs/call
72137µs $fn .= '.pm';
731350µs1315µs utf8::encode($fn);
# spent 15µs making 13 calls to utf8::encode, avg 1µs/call
741327µs return $fn;
75 }
7611µs}
77
78
# spent 4.11ms (1.22+2.90) within base::import which was called 13 times, avg 316µs/call: # once (657µs+2.59ms) by Template::BEGIN@25 at line 25 of Template.pm # once (40µs+81µs) by Template::Service::BEGIN@25 at line 25 of Template/Service.pm # once (104µs+13µs) by Template::Config::BEGIN@23 at line 23 of Template/Config.pm # once (67µs+42µs) by Template::Iterator::BEGIN@26 at line 26 of Template/Iterator.pm # once (61µs+33µs) by Template::Parser::BEGIN@37 at line 37 of Template/Parser.pm # once (56µs+34µs) by Template::Context::BEGIN@25 at line 25 of Template/Context.pm # once (46µs+27µs) by Template::Plugins::BEGIN@28 at line 28 of Template/Plugins.pm # once (42µs+18µs) by YAML::XS::BEGIN@6 at line 6 of YAML/XS.pm # once (30µs+16µs) by Template::Filters::BEGIN@25 at line 25 of Template/Filters.pm # once (32µs+12µs) by Template::Provider::BEGIN@43 at line 43 of Template/Provider.pm # once (29µs+12µs) by Template::Directive::BEGIN@31 at line 31 of Template/Directive.pm # once (29µs+10µs) by YAML::XS::LibYAML::BEGIN@8 at line 8 of YAML/XS/LibYAML.pm # once (24µs+11µs) by Template::Document::BEGIN@26 at line 26 of Template/Document.pm
sub import {
79137µs my $class = shift;
80
81136µs return SUCCESS unless @_;
82
83 # List of base classes from which we will inherit %FIELDS.
84132µs my $fields_base;
85
86139µs my $inheritor = caller(0);
87
88133µs my @bases;
891310µs foreach my $base (@_) {
90135µs if ( $inheritor eq $base ) {
91 warn "Class '$inheritor' tried to inherit from itself\n";
92 }
93
9413119µs1321µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 21µs making 13 calls to UNIVERSAL::isa, avg 2µs/call
95
96 # Following blocks help isolate $SIG{__DIE__} and @INC changes
97 {
98265µs my $sigdie;
99 {
1002631µs local $SIG{__DIE__};
1011331µs13151µs my $fn = _module_to_filename($base);
# spent 151µs making 13 calls to base::__ANON__[base.pm:75], avg 12µs/call
102133µs my $dot_hidden;
103137µs eval {
104132µs my $guard;
1051382µs if ($INC[-1] eq '.' && %{"$base\::"}) {
106 # So: the package already exists => this an optional load
107 # And: there is a dot at the end of @INC => we want to hide it
108 # However: we only want to hide it during our *own* require()
109 # (i.e. without affecting nested require()s).
110 # So we add a hook to @INC whose job is to hide the dot, but which
111 # first checks checks the callstack depth, because within nested
112 # require()s the callstack is deeper.
113 # Since CORE::GLOBAL::require makes it unknowable in advance what
114 # the exact relevant callstack depth will be, we have to record it
115 # inside a hook. So we put another hook just for that at the front
116 # of @INC, where it's guaranteed to run -- immediately.
117 # The dot-hiding hook does its job by sitting directly in front of
118 # the dot and removing itself from @INC when reached. This causes
119 # the dot to move up one index in @INC, causing the loop inside
120 # pp_require() to skip it.
121 # Loaded coded may disturb this precise arrangement, but that's OK
122 # because the hook is inert by that time. It is only active during
123 # the top-level require(), when @INC is in our control. The only
124 # possible gotcha is if other hooks already in @INC modify @INC in
125 # some way during that initial require().
126 # Note that this jiggery hookery works just fine recursively: if
127 # a module loaded via base.pm uses base.pm itself, there will be
128 # one pair of hooks in @INC per base::import call frame, but the
129 # pairs from different nestings do not interfere with each other.
130 my $lvl;
131 unshift @INC, sub { return if defined $lvl; 1 while defined caller ++$lvl; () };
132 splice @INC, -1, 0, sub { return if defined caller $lvl; ++$dot_hidden, &base::__inc::unhook; () };
133 $guard = bless [ @INC[0,-2] ], 'base::__inc::scope_guard';
134 }
13513126µs require $fn
136 };
137134µs if ($dot_hidden && (my @fn = grep -e && !( -d _ || -b _ ), $fn.'c', $fn)) {
138 require Carp;
139 Carp::croak(<<ERROR);
140Base class package "$base" is not empty but "$fn[0]" exists in the current directory.
141 To help avoid security issues, base.pm now refuses to load optional modules
142 from the current working directory when it is the last entry in \@INC.
143 If your software worked on previous versions of Perl, the best solution
144 is to use FindBin to detect the path properly and to add that path to
145 \@INC. As a last resort, you can re-enable looking in the current working
146 directory by adding "use lib '.'" to your code.
147ERROR
148 }
149 # Only ignore "Can't locate" errors from our eval require.
150 # Other fatal errors (syntax etc) must be reported.
151 #
152 # changing the check here is fragile - if the check
153 # here isn't catching every error you want, you should
154 # probably be using parent.pm, which doesn't try to
155 # guess whether require is needed or failed,
156 # see [perl #118561]
1571341µs135µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 5µs making 13 calls to base::CORE:match, avg 385ns/call
158 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
1591317µs unless (%{"$base\::"}) {
160 require Carp;
161 local $" = " ";
162 Carp::croak(<<ERROR);
163Base class package "$base" is empty.
164 (Perhaps you need to 'use' the module which defines that package first,
165 or make that module available in \@INC (\@INC contains: @INC).
166ERROR
167 }
1681343µs $sigdie = $SIG{__DIE__} || undef;
169 }
170 # Make sure a global $SIG{__DIE__} makes it out of the localization.
171134µs $SIG{__DIE__} = $sigdie if defined $sigdie;
172 }
173135µs push @bases, $base;
174
17513101µs26154µs if ( has_fields($base) || has_attr($base) ) {
# spent 104µs making 13 calls to base::has_attr, avg 8µs/call # spent 50µs making 13 calls to base::has_fields, avg 4µs/call
176 # No multiple fields inheritance *suck*
177 if ($fields_base) {
178 require Carp;
179 Carp::croak("Can't multiply inherit fields");
180 } else {
181 $fields_base = $base;
182 }
183 }
184 }
185 # Save this until the end so it's all or nothing if the above loop croaks.
18613104µs push @{"$inheritor\::ISA"}, @bases;
187
1881339µs if( defined $fields_base ) {
189 inherit_fields($inheritor, $fields_base);
190 }
191}
192
193sub inherit_fields {
194 my($derived, $base) = @_;
195
196 return SUCCESS unless $base;
197
198 my $battr = get_attr($base);
199 my $dattr = get_attr($derived);
200 my $dfields = get_fields($derived);
201 my $bfields = get_fields($base);
202
203 $dattr->[0] = @$battr;
204
205 if( keys %$dfields ) {
206 warn <<"END";
207$derived is inheriting from $base but already has its own fields!
208This will cause problems. Be sure you use base BEFORE declaring fields.
209END
210
211 }
212
213 # Iterate through the base's fields adding all the non-private
214 # ones to the derived class. Hang on to the original attribute
215 # (Public, Private, etc...) and add Inherited.
216 # This is all too complicated to do efficiently with add_fields().
217 while (my($k,$v) = each %$bfields) {
218 my $fno;
219 if ($fno = $dfields->{$k} and $fno != $v) {
220 require Carp;
221 Carp::croak ("Inherited fields can't override existing fields");
222 }
223
224 if( $battr->[$v] & PRIVATE ) {
225 $dattr->[$v] = PRIVATE | INHERITED;
226 }
227 else {
228 $dattr->[$v] = INHERITED | $battr->[$v];
229 $dfields->{$k} = $v;
230 }
231 }
232
233 foreach my $idx (1..$#{$battr}) {
234 next if defined $dattr->[$idx];
235 $dattr->[$idx] = $battr->[$idx] & INHERITED;
236 }
237}
238
23916µs1;
240
241__END__
 
# spent 5µs within base::CORE:match which was called 13 times, avg 385ns/call: # 13 times (5µs+0s) by base::import at line 157, avg 385ns/call
sub base::CORE:match; # opcode
# spent 31µs within base::CORE:subst which was called 13 times, avg 2µs/call: # 13 times (31µs+0s) by base::__ANON__[/usr/share/perl/5.28/base.pm:75] at line 71, avg 2µs/call
sub base::CORE:subst; # opcode
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.