← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:04 2013

Filename/usr/lib/perl/5.10/B.pm
StatementsExecuted 56 statements in 3.58ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
41176µs76µsB::::svref_2object B::svref_2object (xsub)
44161µs61µsB::::opnumber B::opnumber (xsub)
11115µs43µsB::::BEGIN@237 B::BEGIN@237
11114µs19µsB::::BEGIN@30 B::BEGIN@30
11113µs13µsB::::BEGIN@12 B::BEGIN@12
0000s0sB::GV::::SAFENAME B::GV::SAFENAME
0000s0sB::IV::::as_string B::IV::as_string
0000s0sB::IV::::int_value B::IV::int_value
0000s0sB::PV::::as_string B::PV::as_string
0000s0sB::Section::::addB::Section::add
0000s0sB::Section::::defaultB::Section::default
0000s0sB::Section::::getB::Section::get
0000s0sB::Section::::indexB::Section::index
0000s0sB::Section::::nameB::Section::name
0000s0sB::Section::::newB::Section::new
0000s0sB::Section::::outputB::Section::output
0000s0sB::Section::::symtableB::Section::symtable
0000s0sB::::class B::class
0000s0sB::::clearsym B::clearsym
0000s0sB::::compile_stats B::compile_stats
0000s0sB::::debug B::debug
0000s0sB::::objsym B::objsym
0000s0sB::::parents B::parents
0000s0sB::::peekop B::peekop
0000s0sB::::savesym B::savesym
0000s0sB::::timing_info B::timing_info
0000s0sB::::walkoptree_exec B::walkoptree_exec
0000s0sB::::walkoptree_slow B::walkoptree_slow
0000s0sB::::walksymtable B::walksymtable
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# B.pm
2#
3# Copyright (c) 1996, 1997, 1998 Malcolm Beattie
4#
5# You may distribute under the terms of either the GNU General Public
6# License or the Artistic License, as specified in the README file.
7#
8package B;
9
101900nsour $VERSION = '1.22';
11
123103µs113µs
# spent 13µs within B::BEGIN@12 which was called: # once (13µs+0s) by JSON::PP::BEGIN@11 at line 12
use XSLoader ();
# spent 13µs making 1 call to B::BEGIN@12
1311µsrequire Exporter;
14113µs@ISA = qw(Exporter);
15
16# walkoptree_slow comes from B.pm (you are there),
17# walkoptree comes from B.xs
1817µs@EXPORT_OK = qw(minus_c ppname save_BEGINs
19 class peekop cast_I32 cstring cchar hash threadsv_names
20 main_root main_start main_cv svref_2object opnumber
21 sub_generation amagic_generation perlstring
22 walkoptree_slow walkoptree walkoptree_exec walksymtable
23 parents comppadlist sv_undef compile_stats timing_info
24 begin_av init_av check_av end_av regex_padav dowarn defstash
25 curstash warnhook diehook inc_gv @optype @specialsv_name
26 );
2714µspush @EXPORT_OK, qw(unitcheck_av) if $] > 5.009;
28
29sub OPf_KIDS ();
3031.39ms224µs
# spent 19µs (14+5) within B::BEGIN@30 which was called: # once (14µs+5µs) by JSON::PP::BEGIN@11 at line 30
use strict;
# spent 19µs making 1 call to B::BEGIN@30 # spent 4µs making 1 call to strict::import
3116µs@B::SV::ISA = 'B::OBJECT';
3215µs@B::NULL::ISA = 'B::SV';
3314µs@B::PV::ISA = 'B::SV';
3419µs@B::IV::ISA = 'B::SV';
3516µs@B::NV::ISA = 'B::SV';
36# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
3715µs@B::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV';
38110µs@B::PVIV::ISA = qw(B::PV B::IV);
39119µs@B::PVNV::ISA = qw(B::PVIV B::NV);
40112µs@B::PVMG::ISA = 'B::PVNV';
411400ns@B::REGEXP::ISA = 'B::PVMG' if $] >= 5.011;
42# Change in the inheritance hierarchy post 5.9.0
4316µs@B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG';
44# BM is eliminated post 5.9.5, but effectively is a specialisation of GV now.
4515µs@B::BM::ISA = $] > 5.009005 ? 'B::GV' : 'B::PVMG';
46112µs@B::AV::ISA = 'B::PVMG';
47113µs@B::GV::ISA = 'B::PVMG';
4818µs@B::HV::ISA = 'B::PVMG';
4917µs@B::CV::ISA = 'B::PVMG';
5019µs@B::IO::ISA = 'B::PVMG';
5118µs@B::FM::ISA = 'B::CV';
52
5314µs@B::OP::ISA = 'B::OBJECT';
5415µs@B::UNOP::ISA = 'B::OP';
5517µs@B::BINOP::ISA = 'B::UNOP';
5615µs@B::LOGOP::ISA = 'B::UNOP';
5718µs@B::LISTOP::ISA = 'B::BINOP';
5814µs@B::SVOP::ISA = 'B::OP';
5914µs@B::PADOP::ISA = 'B::OP';
6014µs@B::PVOP::ISA = 'B::OP';
6115µs@B::LOOP::ISA = 'B::LISTOP';
6216µs@B::PMOP::ISA = 'B::LISTOP';
6314µs@B::COP::ISA = 'B::OP';
64
6515µs@B::SPECIAL::ISA = 'B::OBJECT';
66
6712µs@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
68# bytecode.pl contained the following comment:
69# Nullsv *must* come first in the following so that the condition
70# ($$sv == 0) can continue to be used to test (sv == Nullsv).
7114µs@B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
72 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD);
73
74{
75 # Stop "-w" from complaining about the lack of a real B::OBJECT class
7612µs package B::OBJECT;
77}
78
79sub B::GV::SAFENAME {
80 my $name = (shift())->NAME;
81
82 # The regex below corresponds to the isCONTROLVAR macro
83 # from toke.c
84
85 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
86 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
87
88 # When we say unicode_to_native we really mean ascii_to_native,
89 # which matters iff this is a non-ASCII platform (EBCDIC).
90
91 return $name;
92}
93
94sub B::IV::int_value {
95 my ($self) = @_;
96 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
97}
98
99sub B::NULL::as_string() {""}
100sub B::IV::as_string() {goto &B::IV::int_value}
101sub B::PV::as_string() {goto &B::PV::PV}
102
1031300nsmy $debug;
1041500nsmy $op_count = 0;
1051600nsmy @parents = ();
106
107sub debug {
108 my ($class, $value) = @_;
109 $debug = $value;
110 walkoptree_debug($value);
111}
112
113sub class {
114 my $obj = shift;
115 my $name = ref $obj;
116 $name =~ s/^.*:://;
117 return $name;
118}
119
120sub parents { \@parents }
121
122# For debugging
123sub peekop {
124 my $op = shift;
125 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
126}
127
128sub walkoptree_slow {
129 my($op, $method, $level) = @_;
130 $op_count++; # just for statistics
131 $level ||= 0;
132 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
133 $op->$method($level) if $op->can($method);
134 if ($$op && ($op->flags & OPf_KIDS)) {
135 my $kid;
136 unshift(@parents, $op);
137 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
138 walkoptree_slow($kid, $method, $level + 1);
139 }
140 shift @parents;
141 }
142 if (class($op) eq 'PMOP'
143 && ref($op->pmreplroot)
144 && ${$op->pmreplroot}
145 && $op->pmreplroot->isa( 'B::OP' ))
146 {
147 unshift(@parents, $op);
148 walkoptree_slow($op->pmreplroot, $method, $level + 1);
149 shift @parents;
150 }
151}
152
153sub compile_stats {
154 return "Total number of OPs processed: $op_count\n";
155}
156
157sub timing_info {
158 my ($sec, $min, $hr) = localtime;
159 my ($user, $sys) = times;
160 sprintf("%02d:%02d:%02d user=$user sys=$sys",
161 $hr, $min, $sec, $user, $sys);
162}
163
1641200nsmy %symtable;
165
166sub clearsym {
167 %symtable = ();
168}
169
170sub savesym {
171 my ($obj, $value) = @_;
172# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
173 $symtable{sprintf("sym_%x", $$obj)} = $value;
174}
175
176sub objsym {
177 my $obj = shift;
178 return $symtable{sprintf("sym_%x", $$obj)};
179}
180
181sub walkoptree_exec {
182 my ($op, $method, $level) = @_;
183 $level ||= 0;
184 my ($sym, $ppname);
185 my $prefix = " " x $level;
186 for (; $$op; $op = $op->next) {
187 $sym = objsym($op);
188 if (defined($sym)) {
189 print $prefix, "goto $sym\n";
190 return;
191 }
192 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
193 $op->$method($level);
194 $ppname = $op->name;
195 if ($ppname =~
196 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
197 {
198 print $prefix, uc($1), " => {\n";
199 walkoptree_exec($op->other, $method, $level + 1);
200 print $prefix, "}\n";
201 } elsif ($ppname eq "match" || $ppname eq "subst") {
202 my $pmreplstart = $op->pmreplstart;
203 if ($$pmreplstart) {
204 print $prefix, "PMREPLSTART => {\n";
205 walkoptree_exec($pmreplstart, $method, $level + 1);
206 print $prefix, "}\n";
207 }
208 } elsif ($ppname eq "substcont") {
209 print $prefix, "SUBSTCONT => {\n";
210 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
211 print $prefix, "}\n";
212 $op = $op->other;
213 } elsif ($ppname eq "enterloop") {
214 print $prefix, "REDO => {\n";
215 walkoptree_exec($op->redoop, $method, $level + 1);
216 print $prefix, "}\n", $prefix, "NEXT => {\n";
217 walkoptree_exec($op->nextop, $method, $level + 1);
218 print $prefix, "}\n", $prefix, "LAST => {\n";
219 walkoptree_exec($op->lastop, $method, $level + 1);
220 print $prefix, "}\n";
221 } elsif ($ppname eq "subst") {
222 my $replstart = $op->pmreplstart;
223 if ($$replstart) {
224 print $prefix, "SUBST => {\n";
225 walkoptree_exec($replstart, $method, $level + 1);
226 print $prefix, "}\n";
227 }
228 }
229 }
230}
231
232sub walksymtable {
233 my ($symref, $method, $recurse, $prefix) = @_;
234 my $sym;
235 my $ref;
236 my $fullname;
2373522µs270µs
# spent 43µs (15+28) within B::BEGIN@237 which was called: # once (15µs+28µs) by JSON::PP::BEGIN@11 at line 237
no strict 'refs';
# spent 43µs making 1 call to B::BEGIN@237 # spent 28µs making 1 call to strict::unimport
238 $prefix = '' unless defined $prefix;
239 while (($sym, $ref) = each %$symref) {
240 $fullname = "*main::".$prefix.$sym;
241 if ($sym =~ /::$/) {
242 $sym = $prefix . $sym;
243 if (svref_2object(\*$sym)->NAME ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
244 walksymtable(\%$fullname, $method, $recurse, $sym);
245 }
246 } else {
247 svref_2object(\*$fullname)->$method();
248 }
249 }
250}
251
252{
2531400ns package B::Section;
2541200ns my $output_fh;
2551600ns my %sections;
256
257 sub new {
258 my ($class, $section, $symtable, $default) = @_;
259 $output_fh ||= FileHandle->new_tmpfile;
260 my $obj = bless [-1, $section, $symtable, $default], $class;
261 $sections{$section} = $obj;
262 return $obj;
263 }
264
265 sub get {
266 my ($class, $section) = @_;
267 return $sections{$section};
268 }
269
270 sub add {
271 my $section = shift;
272 while (defined($_ = shift)) {
273 print $output_fh "$section->[1]\t$_\n";
274 $section->[0]++;
275 }
276 }
277
278 sub index {
279 my $section = shift;
280 return $section->[0];
281 }
282
283 sub name {
284 my $section = shift;
285 return $section->[1];
286 }
287
288 sub symtable {
289 my $section = shift;
290 return $section->[2];
291 }
292
293 sub default {
294 my $section = shift;
295 return $section->[3];
296 }
297
298 sub output {
299 my ($section, $fh, $format) = @_;
300 my $name = $section->name;
301 my $sym = $section->symtable || {};
302 my $default = $section->default;
303
304 seek($output_fh, 0, 0);
305 while (<$output_fh>) {
306 chomp;
307 s/^(.*?)\t//;
308 if ($1 eq $name) {
309 s{(s\\_[0-9a-f]+)} {
310 exists($sym->{$1}) ? $sym->{$1} : $default;
311 }ge;
312 printf $fh $format, $_;
313 }
314 }
315 }
316}
317
31811.28ms11.26msXSLoader::load 'B';
# spent 1.26ms making 1 call to XSLoader::load
319
320146µs1;
321
322__END__
 
# spent 61µs within B::opnumber which was called 4 times, avg 15µs/call: # once (39µs+0s) by B::Deparse::BEGIN@2750 at line 2750 of B/Deparse.pm # once (10µs+0s) by B::Deparse::BEGIN@2751 at line 2751 of B/Deparse.pm # once (8µs+0s) by B::Deparse::BEGIN@2753 at line 2753 of B/Deparse.pm # once (5µs+0s) by B::Deparse::BEGIN@2752 at line 2752 of B/Deparse.pm
sub B::opnumber; # xsub
# spent 76µs within B::svref_2object which was called 4 times, avg 19µs/call: # 4 times (76µs+0s) by JSON::PP::value_to_json at line 431 of JSON/PP.pm, avg 19µs/call
sub B::svref_2object; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.