← 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:02 2013

Filename/usr/lib/perl/5.10/IO/Handle.pm
StatementsExecuted 52 statements in 3.08ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111492µs999µsIO::Handle::::BEGIN@9IO::Handle::BEGIN@9
31189µs141µsIO::Handle::::newIO::Handle::new
41173µs73µsIO::Handle::::CORE:eofIO::Handle::CORE:eof (opcode)
11148µs48µsIO::Handle::::BEGIN@3IO::Handle::BEGIN@3
42137µs110µsIO::Handle::::eofIO::Handle::eof
11117µs27µsIO::Handle::::closeIO::Handle::close
11116µs48µsIO::Handle::::BEGIN@355IO::Handle::BEGIN@355
11114µs78µsIO::Handle::::BEGIN@7IO::Handle::BEGIN@7
11113µs83µsIO::Handle::::BEGIN@6IO::Handle::BEGIN@6
11113µs18µsIO::Handle::::BEGIN@4IO::Handle::BEGIN@4
11111µs11µsIO::Handle::::CORE:closeIO::Handle::CORE:close (opcode)
1118µs8µsIO::Handle::::BEGIN@8IO::Handle::BEGIN@8
0000s0sIO::Handle::::DESTROYIO::Handle::DESTROY
0000s0sIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
0000s0sIO::Handle::::autoflushIO::Handle::autoflush
0000s0sIO::Handle::::constantIO::Handle::constant
0000s0sIO::Handle::::fcntlIO::Handle::fcntl
0000s0sIO::Handle::::fdopenIO::Handle::fdopen
0000s0sIO::Handle::::filenoIO::Handle::fileno
0000s0sIO::Handle::::format_formfeedIO::Handle::format_formfeed
0000s0sIO::Handle::::format_line_break_charactersIO::Handle::format_line_break_characters
0000s0sIO::Handle::::format_lines_leftIO::Handle::format_lines_left
0000s0sIO::Handle::::format_lines_per_pageIO::Handle::format_lines_per_page
0000s0sIO::Handle::::format_nameIO::Handle::format_name
0000s0sIO::Handle::::format_page_numberIO::Handle::format_page_number
0000s0sIO::Handle::::format_top_nameIO::Handle::format_top_name
0000s0sIO::Handle::::format_writeIO::Handle::format_write
0000s0sIO::Handle::::formlineIO::Handle::formline
0000s0sIO::Handle::::getcIO::Handle::getc
0000s0sIO::Handle::::getlineIO::Handle::getline
0000s0sIO::Handle::::getlinesIO::Handle::getlines
0000s0sIO::Handle::::input_line_numberIO::Handle::input_line_number
0000s0sIO::Handle::::input_record_separatorIO::Handle::input_record_separator
0000s0sIO::Handle::::ioctlIO::Handle::ioctl
0000s0sIO::Handle::::new_from_fdIO::Handle::new_from_fd
0000s0sIO::Handle::::openedIO::Handle::opened
0000s0sIO::Handle::::output_field_separatorIO::Handle::output_field_separator
0000s0sIO::Handle::::output_record_separatorIO::Handle::output_record_separator
0000s0sIO::Handle::::printIO::Handle::print
0000s0sIO::Handle::::printfIO::Handle::printf
0000s0sIO::Handle::::printflushIO::Handle::printflush
0000s0sIO::Handle::::readIO::Handle::read
0000s0sIO::Handle::::sayIO::Handle::say
0000s0sIO::Handle::::statIO::Handle::stat
0000s0sIO::Handle::::sysreadIO::Handle::sysread
0000s0sIO::Handle::::syswriteIO::Handle::syswrite
0000s0sIO::Handle::::truncateIO::Handle::truncate
0000s0sIO::Handle::::writeIO::Handle::write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package IO::Handle;
2
3371µs148µs
# spent 48µs within IO::Handle::BEGIN@3 which was called: # once (48µs+0s) by IO::Seekable::BEGIN@9 at line 3
use 5.006_001;
# spent 48µs making 1 call to IO::Handle::BEGIN@3
4361µs223µs
# spent 18µs (13+5) within IO::Handle::BEGIN@4 which was called: # once (13µs+5µs) by IO::Seekable::BEGIN@9 at line 4
use strict;
# spent 18µs making 1 call to IO::Handle::BEGIN@4 # spent 5µs making 1 call to strict::import
511µsour($VERSION, @EXPORT_OK, @ISA);
6340µs2153µs
# spent 83µs (13+70) within IO::Handle::BEGIN@6 which was called: # once (13µs+70µs) by IO::Seekable::BEGIN@9 at line 6
use Carp;
# spent 83µs making 1 call to IO::Handle::BEGIN@6 # spent 70µs making 1 call to Exporter::import
7338µs2143µs
# spent 78µs (14+65) within IO::Handle::BEGIN@7 which was called: # once (14µs+65µs) by IO::Seekable::BEGIN@9 at line 7
use Symbol;
# spent 78µs making 1 call to IO::Handle::BEGIN@7 # spent 65µs making 1 call to Exporter::import
8332µs18µs
# spent 8µs within IO::Handle::BEGIN@8 which was called: # once (8µs+0s) by IO::Seekable::BEGIN@9 at line 8
use SelectSaver;
# spent 8µs making 1 call to IO::Handle::BEGIN@8
932.37ms1999µs
# spent 999µs (492+506) within IO::Handle::BEGIN@9 which was called: # once (492µs+506µs) by IO::Seekable::BEGIN@9 at line 9
use IO (); # Load the XS module
# spent 999µs making 1 call to IO::Handle::BEGIN@9
10
1111µsrequire Exporter;
12114µs@ISA = qw(Exporter);
13
141500ns$VERSION = "1.28";
15123µs$VERSION = eval $VERSION;
# spent 3µs executing statements in string eval
16
1716µs@EXPORT_OK = qw(
18 autoflush
19 output_field_separator
20 output_record_separator
21 input_record_separator
22 input_line_number
23 format_page_number
24 format_lines_per_page
25 format_lines_left
26 format_name
27 format_top_name
28 format_line_break_characters
29 format_formfeed
30 format_write
31
32 print
33 printf
34 say
35 getline
36 getlines
37
38 printflush
39 flush
40
41 SEEK_SET
42 SEEK_CUR
43 SEEK_END
44 _IOFBF
45 _IOLBF
46 _IONBF
47);
48
49################################################
50## Constructors, destructors.
51##
52
53
# spent 141µs (89+52) within IO::Handle::new which was called 3 times, avg 47µs/call: # 3 times (89µs+52µs) by IO::File::new at line 39 of IO/File.pm, avg 47µs/call
sub new {
541288µs my $class = ref($_[0]) || $_[0] || "IO::Handle";
55 @_ == 1 or croak "usage: new $class";
56352µs my $io = gensym;
# spent 52µs making 3 calls to Symbol::gensym, avg 17µs/call
57 bless $io, $class;
58}
59
60sub new_from_fd {
61 my $class = ref($_[0]) || $_[0] || "IO::Handle";
62 @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
63 my $io = gensym;
64 shift;
65 IO::Handle::fdopen($io, @_)
66 or return undef;
67 bless $io, $class;
68}
69
70#
71# There is no need for DESTROY to do anything, because when the
72# last reference to an IO object is gone, Perl automatically
73# closes its associated files (if any). However, to avoid any
74# attempts to autoload DESTROY, we here define it to do nothing.
75#
76sub DESTROY {}
77
78################################################
79## Open and close.
80##
81
82sub _open_mode_string {
83 my ($mode) = @_;
84 $mode =~ /^\+?(<|>>?)$/
85 or $mode =~ s/^r(\+?)$/$1</
86 or $mode =~ s/^w(\+?)$/$1>/
87 or $mode =~ s/^a(\+?)$/$1>>/
88 or croak "IO::Handle: bad open mode: $mode";
89 $mode;
90}
91
92sub fdopen {
93 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
94 my ($io, $fd, $mode) = @_;
95 local(*GLOB);
96
97 if (ref($fd) && "".$fd =~ /GLOB\(/o) {
98 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
99 my $n = qualify(*GLOB);
100 *GLOB = *{*$fd};
101 $fd = $n;
102 } elsif ($fd =~ m#^\d+$#) {
103 # It's an FD number; prefix with "=".
104 $fd = "=$fd";
105 }
106
107 open($io, _open_mode_string($mode) . '&' . $fd)
108 ? $io : undef;
109}
110
111
# spent 27µs (17+11) within IO::Handle::close which was called: # once (17µs+11µs) by ZOOM::Query::CCL2RPN::new at line 646 of ZOOM.pm
sub close {
112329µs @_ == 1 or croak 'usage: $io->close()';
113 my($io) = @_;
114
115111µs close($io);
# spent 11µs making 1 call to IO::Handle::CORE:close
116}
117
118################################################
119## Normal I/O functions.
120##
121
122# flock
123# select
124
125sub opened {
126 @_ == 1 or croak 'usage: $io->opened()';
127 defined fileno($_[0]);
128}
129
130sub fileno {
131 @_ == 1 or croak 'usage: $io->fileno()';
132 fileno($_[0]);
133}
134
135sub getc {
136 @_ == 1 or croak 'usage: $io->getc()';
137 getc($_[0]);
138}
139
140
# spent 110µs (37+73) within IO::Handle::eof which was called 4 times, avg 27µs/call: # 2 times (23µs+63µs) by Date::Manip::TZ::_get_curr_zone at line 418 of Date/Manip/TZ.pm, avg 43µs/call # 2 times (15µs+9µs) by Date::Manip::TZ::_get_curr_zone at line 428 of Date/Manip/TZ.pm, avg 12µs/call
sub eof {
1418120µs @_ == 1 or croak 'usage: $io->eof()';
142473µs eof($_[0]);
# spent 73µs making 4 calls to IO::Handle::CORE:eof, avg 18µs/call
143}
144
145sub print {
146 @_ or croak 'usage: $io->print(ARGS)';
147 my $this = shift;
148 print $this @_;
149}
150
151sub printf {
152 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
153 my $this = shift;
154 printf $this @_;
155}
156
157sub say {
158 @_ or croak 'usage: $io->say(ARGS)';
159 my $this = shift;
160 local $\ = "\n";
161 print $this @_;
162}
163
164sub getline {
165 @_ == 1 or croak 'usage: $io->getline()';
166 my $this = shift;
167 return scalar <$this>;
168}
169
17012µs*gets = \&getline; # deprecated
171
172sub getlines {
173 @_ == 1 or croak 'usage: $io->getlines()';
174 wantarray or
175 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
176 my $this = shift;
177 return <$this>;
178}
179
180sub truncate {
181 @_ == 2 or croak 'usage: $io->truncate(LEN)';
182 truncate($_[0], $_[1]);
183}
184
185sub read {
186 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
187 read($_[0], $_[1], $_[2], $_[3] || 0);
188}
189
190sub sysread {
191 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
192 sysread($_[0], $_[1], $_[2], $_[3] || 0);
193}
194
195sub write {
196 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
197 local($\) = "";
198 $_[2] = length($_[1]) unless defined $_[2];
199 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
200}
201
202sub syswrite {
203 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
204 if (defined($_[2])) {
205 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
206 } else {
207 syswrite($_[0], $_[1]);
208 }
209}
210
211sub stat {
212 @_ == 1 or croak 'usage: $io->stat()';
213 stat($_[0]);
214}
215
216################################################
217## State modification functions.
218##
219
220sub autoflush {
221 my $old = new SelectSaver qualify($_[0], caller);
222 my $prev = $|;
223 $| = @_ > 1 ? $_[1] : 1;
224 $prev;
225}
226
227sub output_field_separator {
228 carp "output_field_separator is not supported on a per-handle basis"
229 if ref($_[0]);
230 my $prev = $,;
231 $, = $_[1] if @_ > 1;
232 $prev;
233}
234
235sub output_record_separator {
236 carp "output_record_separator is not supported on a per-handle basis"
237 if ref($_[0]);
238 my $prev = $\;
239 $\ = $_[1] if @_ > 1;
240 $prev;
241}
242
243sub input_record_separator {
244 carp "input_record_separator is not supported on a per-handle basis"
245 if ref($_[0]);
246 my $prev = $/;
247 $/ = $_[1] if @_ > 1;
248 $prev;
249}
250
251sub input_line_number {
252 local $.;
253 () = tell qualify($_[0], caller) if ref($_[0]);
254 my $prev = $.;
255 $. = $_[1] if @_ > 1;
256 $prev;
257}
258
259sub format_page_number {
260 my $old;
261 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
262 my $prev = $%;
263 $% = $_[1] if @_ > 1;
264 $prev;
265}
266
267sub format_lines_per_page {
268 my $old;
269 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
270 my $prev = $=;
271 $= = $_[1] if @_ > 1;
272 $prev;
273}
274
275sub format_lines_left {
276 my $old;
277 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
278 my $prev = $-;
279 $- = $_[1] if @_ > 1;
280 $prev;
281}
282
283sub format_name {
284 my $old;
285 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
286 my $prev = $~;
287 $~ = qualify($_[1], caller) if @_ > 1;
288 $prev;
289}
290
291sub format_top_name {
292 my $old;
293 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
294 my $prev = $^;
295 $^ = qualify($_[1], caller) if @_ > 1;
296 $prev;
297}
298
299sub format_line_break_characters {
300 carp "format_line_break_characters is not supported on a per-handle basis"
301 if ref($_[0]);
302 my $prev = $:;
303 $: = $_[1] if @_ > 1;
304 $prev;
305}
306
307sub format_formfeed {
308 carp "format_formfeed is not supported on a per-handle basis"
309 if ref($_[0]);
310 my $prev = $^L;
311 $^L = $_[1] if @_ > 1;
312 $prev;
313}
314
315sub formline {
316 my $io = shift;
317 my $picture = shift;
318 local($^A) = $^A;
319 local($\) = "";
320 formline($picture, @_);
321 print $io $^A;
322}
323
324sub format_write {
325 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
326 if (@_ == 2) {
327 my ($io, $fmt) = @_;
328 my $oldfmt = $io->format_name(qualify($fmt,caller));
329 CORE::write($io);
330 $io->format_name($oldfmt);
331 } else {
332 CORE::write($_[0]);
333 }
334}
335
336sub fcntl {
337 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
338 my ($io, $op) = @_;
339 return fcntl($io, $op, $_[2]);
340}
341
342sub ioctl {
343 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
344 my ($io, $op) = @_;
345 return ioctl($io, $op, $_[2]);
346}
347
348# this sub is for compatability with older releases of IO that used
349# a sub called constant to detemine if a constant existed -- GMB
350#
351# The SEEK_* and _IO?BF constants were the only constants at that time
352# any new code should just chech defined(&CONSTANT_NAME)
353
354sub constant {
3553182µs280µs
# spent 48µs (16+32) within IO::Handle::BEGIN@355 which was called: # once (16µs+32µs) by IO::Seekable::BEGIN@9 at line 355
no strict 'refs';
# spent 48µs making 1 call to IO::Handle::BEGIN@355 # spent 32µs making 1 call to strict::unimport
356 my $name = shift;
357 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
358 ? &{$name}() : undef;
359}
360
361# so that flush.pl can be deprecated
362
363sub printflush {
364 my $io = shift;
365 my $old;
366 $old = new SelectSaver qualify($io, caller) if ref($io);
367 local $| = 1;
368 if(ref($io)) {
369 print $io @_;
370 }
371 else {
372 print @_;
373 }
374}
375
37618µs1;
 
# spent 11µs within IO::Handle::CORE:close which was called: # once (11µs+0s) by IO::Handle::close at line 115
sub IO::Handle::CORE:close; # opcode
# spent 73µs within IO::Handle::CORE:eof which was called 4 times, avg 18µs/call: # 4 times (73µs+0s) by IO::Handle::eof at line 142, avg 18µs/call
sub IO::Handle::CORE:eof; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.