← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:06 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/base.pm
StatementsExecuted 641 statements in 1.70ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1919173.52ms4.07msbase::::import base::import (recurses: max depth 1, inclusive time 1.25ms)
191198µs131µsbase::::__ANON__[:72] base::__ANON__[:72]
191149µs49µsbase::::has_fields base::has_fields
191132µs32µsbase::::has_attr base::has_attr
1119µs9µsClass::Load::::BEGIN@1Class::Load::BEGIN@1
1115µs16µsbase::::BEGIN@4 base::BEGIN@4
1114µs23µsbase::::BEGIN@5 base::BEGIN@5
0000s0sbase::::__ANON__[:49] base::__ANON__[:49]
0000s0sbase::::__ANON__[:56] base::__ANON__[:56]
0000s0sbase::::__ANON__[:64] base::__ANON__[:64]
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
1230µs19µs
# spent 9µs within Class::Load::BEGIN@1 which was called: # once (9µs+0s) by Class::Load::BEGIN@9 at line 1
use 5.008;
# spent 9µs making 1 call to Class::Load::BEGIN@1
2package base;
3
4217µs226µs
# spent 16µs (5+11) within base::BEGIN@4 which was called: # once (5µs+11µs) by Class::Load::BEGIN@9 at line 4
use strict 'vars';
# spent 16µs making 1 call to base::BEGIN@4 # spent 11µs making 1 call to strict::import
52571µs242µs
# spent 23µs (4+19) within base::BEGIN@5 which was called: # once (4µs+19µs) by Class::Load::BEGIN@9 at line 5
use vars qw($VERSION);
# spent 23µs making 1 call to base::BEGIN@5 # spent 19µs making 1 call to vars::import
61400ns$VERSION = '2.23';
713µs$VERSION =~ tr/_//d;
8
9# constant.pm is slow
10sub SUCCESS () { 1 }
11
12sub PUBLIC () { 2**0 }
13sub PRIVATE () { 2**1 }
14sub INHERITED () { 2**2 }
15sub PROTECTED () { 2**3 }
16
17
181500nsmy $Fattr = \%fields::attr;
19
20
# spent 49µs within base::has_fields which was called 19 times, avg 3µs/call: # 19 times (49µs+0s) by base::import at line 127, avg 3µs/call
sub has_fields {
21199µs my($base) = shift;
221915µs my $fglob = ${"$base\::"}{FIELDS};
231927µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
24}
25
26
# spent 32µs within base::has_attr which was called 19 times, avg 2µs/call: # 19 times (32µs+0s) by base::import at line 127, avg 2µs/call
sub has_attr {
27195µs my($proto) = shift;
28197µs my($class) = ref $proto || $proto;
291928µs return exists $Fattr->{$class};
30}
31
32sub get_attr {
33 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
34 return $Fattr->{$_[0]};
35}
36
371700nsif ($] < 5.009) {
38 *get_fields = sub {
39 # Shut up a possible typo warning.
40 () = \%{$_[0].'::FIELDS'};
41 my $f = \%{$_[0].'::FIELDS'};
42
43 # should be centralized in fields? perhaps
44 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
45 # is used here anyway, it doesn't matter.
46 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
47
48 return $f;
49 }
50}
51else {
52 *get_fields = sub {
53 # Shut up a possible typo warning.
54 () = \%{$_[0].'::FIELDS'};
55 return \%{$_[0].'::FIELDS'};
56 }
5712µs}
58
591300nsif ($] < 5.008) {
60 *_module_to_filename = sub {
61 (my $fn = $_[0]) =~ s!::!/!g;
62 $fn .= '.pm';
63 return $fn;
64 }
65}
66else {
67
# spent 131µs (98+32) within base::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/base.pm:72] which was called 19 times, avg 7µs/call: # 19 times (98µs+32µs) by base::import at line 99, avg 7µs/call
*_module_to_filename = sub {
681957µs1920µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 20µs making 19 calls to base::CORE:subst, avg 1µs/call
69196µs $fn .= '.pm';
701945µs1912µs utf8::encode($fn);
# spent 12µs making 19 calls to utf8::encode, avg 658ns/call
711931µs return $fn;
72 }
731700ns}
74
75
76
# spent 4.07ms (3.52+556µs) within base::import which was called 19 times, avg 214µs/call: # once (1.45ms+586µs) by BenchmarkAnything::Storage::Backend::SQL::Query::mysql::BEGIN@7 at line 7 of BenchmarkAnything/Storage/Backend/SQL/Query/mysql.pm # once (228µs+872µs) by SQL::SplitStatement::BEGIN@11 at line 11 of SQL/SplitStatement.pm # once (266µs+63µs) by Log::Any::Adapter::Null::BEGIN@10 at line 10 of Log/Any/Adapter/Null.pm # once (44µs+16µs) by JSON::MaybeXS::BEGIN@5 at line 5 of JSON/MaybeXS.pm # once (37µs+17µs) by IO::Socket::IP::BEGIN@15 at line 15 of IO/Socket/IP.pm # once (38µs+15µs) by Variable::Magic::BEGIN@688 at line 688 of Variable/Magic.pm # once (36µs+17µs) by YAML::XS::BEGIN@6 at line 6 of YAML/XS.pm # once (36µs+15µs) by Class::Load::BEGIN@9 at line 9 of Class/Load.pm # once (34µs+15µs) by Any::URI::Escape::BEGIN@14 at line 14 of Any/URI/Escape.pm # once (32µs+15µs) by Class::Method::Modifiers::BEGIN@14 at line 14 of Class/Method/Modifiers.pm # once (32µs+15µs) by Moose::Meta::TypeConstraint::BEGIN@18 at line 18 of Moose/Meta/TypeConstraint.pm # once (30µs+12µs) by IO::Socket::IP::_ForINET::BEGIN@1122 at line 1122 of IO/Socket/IP.pm # once (25µs+8µs) by namespace::clean::_Util::BEGIN@15 at line 15 of namespace/clean/_Util.pm # once (23µs+8µs) by Log::Any::Adapter::Util::BEGIN@11 at line 11 of Log/Any/Adapter/Util.pm # once (21µs+9µs) by CHI::Util::BEGIN@14 at line 14 of CHI/Util.pm # once (23µs+7µs) by YAML::XS::LibYAML::BEGIN@8 at line 8 of YAML/XS/LibYAML.pm # once (21µs+8µs) by IO::Socket::IP::_ForINET6::BEGIN@1136 at line 1136 of IO/Socket/IP.pm # once (789µs+-789µs) by Class::Accessor::Fast::BEGIN@2 at line 2 of Class/Accessor/Fast.pm # once (353µs+-353µs) by BenchmarkAnything::Storage::Backend::SQL::Query::common::BEGIN@7 at line 7 of BenchmarkAnything/Storage/Backend/SQL/Query/common.pm
sub import {
77198µs my $class = shift;
78
79196µs return SUCCESS unless @_;
80
81 # List of base classes from which we will inherit %FIELDS.
82193µs my $fields_base;
83
84199µs my $inheritor = caller(0);
85
86194µs my @bases;
871914µs foreach my $base (@_) {
88196µs if ( $inheritor eq $base ) {
89 warn "Class '$inheritor' tried to inherit from itself\n";
90 }
91
9219139µs1928µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 28µs making 19 calls to UNIVERSAL::isa, avg 1µs/call
93
94 # Following blocks help isolate $SIG{__DIE__} changes
95 {
96387µs my $sigdie;
97 {
983837µs local $SIG{__DIE__};
991927µs19131µs my $fn = _module_to_filename($base);
# spent 131µs making 19 calls to base::__ANON__[base.pm:72], avg 7µs/call
10038234µs eval { require $fn };
101 # Only ignore "Can't locate" errors from our eval require.
102 # Other fatal errors (syntax etc) must be reported.
103 #
104 # changing the check here is fragile - if the check
105 # here isn't catching every error you want, you should
106 # probably be using parent.pm, which doesn't try to
107 # guess whether require is needed or failed,
108 # see [perl #118561]
1091937µs194µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 4µs making 19 calls to base::CORE:match, avg 237ns/call
110 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
1111934µs unless (%{"$base\::"}) {
112 require Carp;
113 local $" = " ";
114 Carp::croak(<<ERROR);
115Base class package "$base" is empty.
116 (Perhaps you need to 'use' the module which defines that package first,
117 or make that module available in \@INC (\@INC contains: @INC).
118ERROR
119 }
1201943µs $sigdie = $SIG{__DIE__} || undef;
121 }
122 # Make sure a global $SIG{__DIE__} makes it out of the localization.
123195µs $SIG{__DIE__} = $sigdie if defined $sigdie;
124 }
125197µs push @bases, $base;
126
1271948µs3881µs if ( has_fields($base) || has_attr($base) ) {
# spent 49µs making 19 calls to base::has_fields, avg 3µs/call # spent 32µs making 19 calls to base::has_attr, avg 2µs/call
128 # No multiple fields inheritance *suck*
129 if ($fields_base) {
130 require Carp;
131 Carp::croak("Can't multiply inherit fields");
132 } else {
133 $fields_base = $base;
134 }
135 }
136 }
137 # Save this until the end so it's all or nothing if the above loop croaks.
13819116µs push @{"$inheritor\::ISA"}, @bases;
139
1401952µs if( defined $fields_base ) {
141 inherit_fields($inheritor, $fields_base);
142 }
143}
144
145
146sub inherit_fields {
147 my($derived, $base) = @_;
148
149 return SUCCESS unless $base;
150
151 my $battr = get_attr($base);
152 my $dattr = get_attr($derived);
153 my $dfields = get_fields($derived);
154 my $bfields = get_fields($base);
155
156 $dattr->[0] = @$battr;
157
158 if( keys %$dfields ) {
159 warn <<"END";
160$derived is inheriting from $base but already has its own fields!
161This will cause problems. Be sure you use base BEFORE declaring fields.
162END
163
164 }
165
166 # Iterate through the base's fields adding all the non-private
167 # ones to the derived class. Hang on to the original attribute
168 # (Public, Private, etc...) and add Inherited.
169 # This is all too complicated to do efficiently with add_fields().
170 while (my($k,$v) = each %$bfields) {
171 my $fno;
172 if ($fno = $dfields->{$k} and $fno != $v) {
173 require Carp;
174 Carp::croak ("Inherited fields can't override existing fields");
175 }
176
177 if( $battr->[$v] & PRIVATE ) {
178 $dattr->[$v] = PRIVATE | INHERITED;
179 }
180 else {
181 $dattr->[$v] = INHERITED | $battr->[$v];
182 $dfields->{$k} = $v;
183 }
184 }
185
186 foreach my $idx (1..$#{$battr}) {
187 next if defined $dattr->[$idx];
188 $dattr->[$idx] = $battr->[$idx] & INHERITED;
189 }
190}
191
192
19314µs1;
194
195__END__