← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/share/perl/5.20/base.pm
StatementsExecuted 1202 statements in 23.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
36362843.0ms47.6msbase::::importbase::import (recurses: max depth 2, inclusive time 2.82ms)
3611235µs355µsbase::::__ANON__[:70]base::__ANON__[:70]
3611126µs126µsbase::::has_fieldsbase::has_fields
361191µs91µsbase::::has_attrbase::has_attr
361177µs77µsbase::::CORE:substbase::CORE:subst (opcode)
41169µs69µsbase::::CORE:regcompbase::CORE:regcomp (opcode)
401138µs38µsbase::::CORE:matchbase::CORE:match (opcode)
11117µs30µsbase::::BEGIN@3base::BEGIN@3
1117µs30µsbase::::BEGIN@4base::BEGIN@4
0000s0sbase::::__ANON__[:47]base::__ANON__[:47]
0000s0sbase::::__ANON__[:54]base::__ANON__[:54]
0000s0sbase::::__ANON__[:62]base::__ANON__[:62]
0000s0sbase::::get_attrbase::get_attr
0000s0sbase::::inherit_fieldsbase::inherit_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package base;
2
3230µs243µs
# spent 30µs (17+13) within base::BEGIN@3 which was called: # once (17µs+13µs) by C4::Boolean::BEGIN@28 at line 3
use strict 'vars';
# spent 30µs making 1 call to base::BEGIN@3 # spent 13µs making 1 call to strict::import
42975µs254µs
# spent 30µs (7+23) within base::BEGIN@4 which was called: # once (7µs+23µs) by C4::Boolean::BEGIN@28 at line 4
use vars qw($VERSION);
# spent 30µs making 1 call to base::BEGIN@4 # spent 23µs making 1 call to vars::import
51500ns$VERSION = '2.22';
6113µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
7
8# constant.pm is slow
9sub SUCCESS () { 1 }
10
11sub PUBLIC () { 2**0 }
12sub PRIVATE () { 2**1 }
13sub INHERITED () { 2**2 }
14sub PROTECTED () { 2**3 }
15
161700nsmy $Fattr = \%fields::attr;
17
18
# spent 126µs within base::has_fields which was called 36 times, avg 4µs/call: # 36 times (126µs+0s) by base::import at line 124, avg 4µs/call
sub has_fields {
193618µs my($base) = shift;
203640µs my $fglob = ${"$base\::"}{FIELDS};
213688µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
22}
23
24
# spent 91µs within base::has_attr which was called 36 times, avg 3µs/call: # 36 times (91µs+0s) by base::import at line 124, avg 3µs/call
sub has_attr {
253613µs my($proto) = shift;
263621µs my($class) = ref $proto || $proto;
273675µs return exists $Fattr->{$class};
28}
29
30sub get_attr {
31 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
32 return $Fattr->{$_[0]};
33}
34
351800nsif ($] < 5.009) {
36 *get_fields = sub {
37 # Shut up a possible typo warning.
38 () = \%{$_[0].'::FIELDS'};
39 my $f = \%{$_[0].'::FIELDS'};
40
41 # should be centralized in fields? perhaps
42 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
43 # is used here anyway, it doesn't matter.
44 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
45
46 return $f;
47 }
48}
49else {
50 *get_fields = sub {
51 # Shut up a possible typo warning.
52 () = \%{$_[0].'::FIELDS'};
53 return \%{$_[0].'::FIELDS'};
54 }
5513µs}
56
571300nsif ($] < 5.008) {
58 *_module_to_filename = sub {
59 (my $fn = $_[0]) =~ s!::!/!g;
60 $fn .= '.pm';
61 return $fn;
62 }
63}
64else {
65
# spent 355µs (235+120) within base::__ANON__[/usr/share/perl/5.20/base.pm:70] which was called 36 times, avg 10µs/call: # 36 times (235µs+120µs) by base::import at line 96, avg 10µs/call
*_module_to_filename = sub {
6636170µs3677µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 77µs making 36 calls to base::CORE:subst, avg 2µs/call
673616µs $fn .= '.pm';
6836107µs3643µs utf8::encode($fn);
# spent 43µs making 36 calls to utf8::encode, avg 1µs/call
693678µs return $fn;
70 }
7111µs}
72
73
# spent 47.6ms (43.0+4.62) within base::import which was called 36 times, avg 1.32ms/call: # once (12.9ms+3.37ms) by Template::BEGIN@25 at line 25 of Template.pm # once (13.0ms+52µs) by XML::SAX::Expat::BEGIN@9 at line 9 of XML/SAX/Expat.pm # once (4.89ms+336µs) by Set::Infinite::BEGIN@16 at line 16 of Set/Infinite.pm # once (1.99ms+2.83ms) by DateTime::Locale::en_US::BEGIN@25 at line 25 of DateTime/Locale/en_US.pm # once (1.74ms+91µs) by MARC::Charset::Code::BEGIN@5 at line 5 of MARC/Charset/Code.pm # once (1.72ms+20µs) by Authen::CAS::Client::Response::ProxySuccess::BEGIN@108 at line 108 of Authen/CAS/Client/Response.pm # once (1.02ms+60µs) by Authen::CAS::Client::Response::AuthFailure::BEGIN@68 at line 68 of Authen/CAS/Client/Response.pm # once (1.03ms+44µs) by Authen::CAS::Client::Response::AuthSuccess::BEGIN@94 at line 94 of Authen/CAS/Client/Response.pm # once (1.01ms+21µs) by Authen::CAS::Client::Response::ProxyFailure::BEGIN@76 at line 76 of Authen/CAS/Client/Response.pm # once (74µs+35µs) by CGI::Util::BEGIN@2 at line 2 of CGI/Util.pm # once (51µs+27µs) by Template::Provider::BEGIN@43 at line 43 of Template/Provider.pm # once (51µs+25µs) by C4::Boolean::BEGIN@28 at line 28 of C4/Boolean.pm # once (52µs+24µs) by Authen::CAS::Client::Response::Error::BEGIN@39 at line 39 of Authen/CAS/Client/Response.pm # once (49µs+22µs) by MIME::Types::BEGIN@218 at line 218 of MIME/Types.pm # once (47µs+23µs) by C4::Linker::BEGIN@50 at line 50 of C4/Linker.pm # once (44µs+23µs) by C4::Templates::BEGIN@32 at line 32 of C4/Templates.pm # once (42µs+25µs) by DateTime::Format::Builder::Parser::Quick::BEGIN@9 at line 9 of DateTime/Format/Builder/Parser/Quick.pm # once (46µs+19µs) by DateTime::Infinite::BEGIN@9 at line 9 of DateTime/Infinite.pm # once (45µs+19µs) by Koha::AuthUtils::BEGIN@24 at line 24 of Koha/AuthUtils.pm # once (43µs+21µs) by Class::Load::BEGIN@9 at line 9 of Class/Load.pm # once (43µs+20µs) by Koha::DateUtils::BEGIN@26 at line 26 of Koha/DateUtils.pm # once (42µs+20µs) by JSON::BEGIN@6 at line 6 of JSON.pm # once (40µs+21µs) by Template::Service::BEGIN@25 at line 25 of Template/Service.pm # once (40µs+18µs) by MARC::Charset::BEGIN@8 at line 8 of MARC/Charset.pm # once (40µs+17µs) by Variable::Magic::BEGIN@646 at line 646 of Variable/Magic.pm # once (39µs+17µs) by MARC::File::XML::BEGIN@6 at line 6 of MARC/File/XML.pm # once (40µs+16µs) by Template::Document::BEGIN@26 at line 26 of Template/Document.pm # once (38µs+18µs) by Template::Config::BEGIN@23 at line 23 of Template/Config.pm # once (37µs+17µs) by MARC::File::Encode::BEGIN@21 at line 21 of MARC/File/Encode.pm # once (35µs+15µs) by MARC::Charset::Constants::BEGIN@20 at line 20 of MARC/Charset/Constants.pm # once (31µs+14µs) by DateTime::Infinite::Future::BEGIN@41 at line 41 of DateTime/Infinite.pm # once (31µs+13µs) by Authen::CAS::Client::Response::Success::BEGIN@84 at line 84 of Authen/CAS/Client/Response.pm # once (28µs+12µs) by DateTime::Infinite::Past::BEGIN@66 at line 66 of DateTime/Infinite.pm # once (21µs+7µs) by Authen::CAS::Client::Response::Failure::BEGIN@53 at line 53 of Authen/CAS/Client/Response.pm # once (2.66ms+-2.66ms) by DateTime::Locale::en::BEGIN@25 at line 25 of DateTime/Locale/en.pm # once (36µs+-36µs) by DateTime::Locale::root::BEGIN@25 at line 25 of DateTime/Locale/root.pm
sub import {
743617µs my $class = shift;
75
763613µs return SUCCESS unless @_;
77
78 # List of base classes from which we will inherit %FIELDS.
79366µs my $fields_base;
80
813628µs my $inheritor = caller(0);
82
83369µs my @bases;
843632µs foreach my $base (@_) {
853713µs if ( $inheritor eq $base ) {
86 warn "Class '$inheritor' tried to inherit from itself\n";
87 }
88
8937399µs3882µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 82µs making 38 calls to UNIVERSAL::isa, avg 2µs/call
90
91 # Following blocks help isolate $SIG{__DIE__} changes
92 {
937220µs my $sigdie;
94 {
957274µs local $SIG{__DIE__};
963670µs36355µs my $fn = _module_to_filename($base);
# spent 355µs making 36 calls to base::__ANON__[base.pm:70], avg 10µs/call
977220.3ms eval { require $fn };
98 # Only ignore "Can't locate" errors from our eval require.
99 # Other fatal errors (syntax etc) must be reported.
100 #
101 # changing the check here is fragile - if the check
102 # here isn't catching every error you want, you should
103 # probably be using parent.pm, which doesn't try to
104 # guess whether require is needed or failed,
105 # see [perl #118561]
10636208µs44107µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 69µs making 4 calls to base::CORE:regcomp, avg 17µs/call # spent 38µs making 40 calls to base::CORE:match, avg 948ns/call
107 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
1083688µs unless (%{"$base\::"}) {
109 require Carp;
110 local $" = " ";
111 Carp::croak(<<ERROR);
112Base class package "$base" is empty.
113 (Perhaps you need to 'use' the module which defines that package first,
114 or make that module available in \@INC (\@INC contains: @INC).
115ERROR
116 }
11736105µs $sigdie = $SIG{__DIE__} || undef;
118 }
119 # Make sure a global $SIG{__DIE__} makes it out of the localization.
1203614µs $SIG{__DIE__} = $sigdie if defined $sigdie;
121 }
1223620µs push @bases, $base;
123
12436124µs72218µs if ( has_fields($base) || has_attr($base) ) {
# spent 126µs making 36 calls to base::has_fields, avg 4µs/call # spent 91µs making 36 calls to base::has_attr, avg 3µs/call
125 # No multiple fields inheritance *suck*
126 if ($fields_base) {
127 require Carp;
128 Carp::croak("Can't multiply inherit fields");
129 } else {
130 $fields_base = $base;
131 }
132 }
133 }
134 # Save this until the end so it's all or nothing if the above loop croaks.
13536300µs push @{"$inheritor\::ISA"}, @bases;
136
13736156µs if( defined $fields_base ) {
138 inherit_fields($inheritor, $fields_base);
139 }
140}
141
142sub inherit_fields {
143 my($derived, $base) = @_;
144
145 return SUCCESS unless $base;
146
147 my $battr = get_attr($base);
148 my $dattr = get_attr($derived);
149 my $dfields = get_fields($derived);
150 my $bfields = get_fields($base);
151
152 $dattr->[0] = @$battr;
153
154 if( keys %$dfields ) {
155 warn <<"END";
156$derived is inheriting from $base but already has its own fields!
157This will cause problems. Be sure you use base BEFORE declaring fields.
158END
159
160 }
161
162 # Iterate through the base's fields adding all the non-private
163 # ones to the derived class. Hang on to the original attribute
164 # (Public, Private, etc...) and add Inherited.
165 # This is all too complicated to do efficiently with add_fields().
166 while (my($k,$v) = each %$bfields) {
167 my $fno;
168 if ($fno = $dfields->{$k} and $fno != $v) {
169 require Carp;
170 Carp::croak ("Inherited fields can't override existing fields");
171 }
172
173 if( $battr->[$v] & PRIVATE ) {
174 $dattr->[$v] = PRIVATE | INHERITED;
175 }
176 else {
177 $dattr->[$v] = INHERITED | $battr->[$v];
178 $dfields->{$k} = $v;
179 }
180 }
181
182 foreach my $idx (1..$#{$battr}) {
183 next if defined $dattr->[$idx];
184 $dattr->[$idx] = $battr->[$idx] & INHERITED;
185 }
186}
187
18814µs1;
189
190__END__
 
# spent 38µs within base::CORE:match which was called 40 times, avg 948ns/call: # 40 times (38µs+0s) by base::import at line 106, avg 948ns/call
sub base::CORE:match; # opcode
# spent 69µs within base::CORE:regcomp which was called 4 times, avg 17µs/call: # 4 times (69µs+0s) by base::import at line 106, avg 17µs/call
sub base::CORE:regcomp; # opcode
# spent 77µs within base::CORE:subst which was called 36 times, avg 2µs/call: # 36 times (77µs+0s) by base::__ANON__[/usr/share/perl/5.20/base.pm:70] at line 66, avg 2µs/call
sub base::CORE:subst; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.