← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:27:04 2011

Filename/usr/lib/perl/5.14/IO/Handle.pm
StatementsExecuted 22 statements in 3.72ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111409µs885µsIO::Handle::::BEGIN@9IO::Handle::BEGIN@9
11128µs28µsIO::Handle::::BEGIN@3IO::Handle::BEGIN@3
11118µs54µsIO::Handle::::BEGIN@366IO::Handle::BEGIN@366
11116µs23µsIO::Handle::::BEGIN@4IO::Handle::BEGIN@4
11116µs117µsIO::Handle::::BEGIN@6IO::Handle::BEGIN@6
11115µs120µsIO::Handle::::BEGIN@7IO::Handle::BEGIN@7
1119µs9µ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::::closeIO::Handle::close
0000s0sIO::Handle::::constantIO::Handle::constant
0000s0sIO::Handle::::eofIO::Handle::eof
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::::newIO::Handle::new
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
3268µs128µs
# spent 28µs within IO::Handle::BEGIN@3 which was called: # once (28µs+0s) by IO::Seekable::BEGIN@9 at line 3
use 5.006_001;
# spent 28µs making 1 call to IO::Handle::BEGIN@3
4264µs230µs
# spent 23µs (16+7) within IO::Handle::BEGIN@4 which was called: # once (16µs+7µs) by IO::Seekable::BEGIN@9 at line 4
use strict;
# spent 23µs making 1 call to IO::Handle::BEGIN@4 # spent 7µs making 1 call to strict::import
512µsour($VERSION, @EXPORT_OK, @ISA);
6244µs2218µs
# spent 117µs (16+101) within IO::Handle::BEGIN@6 which was called: # once (16µs+101µs) by IO::Seekable::BEGIN@9 at line 6
use Carp;
# spent 117µs making 1 call to IO::Handle::BEGIN@6 # spent 101µs making 1 call to Exporter::import
7242µs2224µs
# spent 120µs (15+104) within IO::Handle::BEGIN@7 which was called: # once (15µs+104µs) by IO::Seekable::BEGIN@9 at line 7
use Symbol;
# spent 120µs making 1 call to IO::Handle::BEGIN@7 # spent 104µs making 1 call to Exporter::import
8238µs19µs
# spent 9µs within IO::Handle::BEGIN@8 which was called: # once (9µs+0s) by IO::Seekable::BEGIN@9 at line 8
use SelectSaver;
# spent 9µs making 1 call to IO::Handle::BEGIN@8
923.14ms1885µs
# spent 885µs (409+476) within IO::Handle::BEGIN@9 which was called: # once (409µs+476µs) by IO::Seekable::BEGIN@9 at line 9
use IO (); # Load the XS module
# spent 885µs making 1 call to IO::Handle::BEGIN@9
10
1112µsrequire Exporter;
12118µs@ISA = qw(Exporter);
13
1412µs$VERSION = "1.31";
15124µs$VERSION = eval $VERSION;
# spent 4µs executing statements in string eval
16
1718µ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
53sub new {
54 my $class = ref($_[0]) || $_[0] || "IO::Handle";
55 if (@_ != 1) {
56 # Since perl will automatically require IO::File if needed, but
57 # also initialises IO::File's @ISA as part of the core we must
58 # ensure IO::File is loaded if IO::Handle is. This avoids effect-
59 # ively "half-loading" IO::File.
60 if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) {
61 require IO::File;
62 shift;
63 return IO::File::->new(@_);
64 }
65 croak "usage: $class->new()";
66 }
67 my $io = gensym;
68 bless $io, $class;
69}
70
71sub new_from_fd {
72 my $class = ref($_[0]) || $_[0] || "IO::Handle";
73 @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)";
74 my $io = gensym;
75 shift;
76 IO::Handle::fdopen($io, @_)
77 or return undef;
78 bless $io, $class;
79}
80
81#
82# There is no need for DESTROY to do anything, because when the
83# last reference to an IO object is gone, Perl automatically
84# closes its associated files (if any). However, to avoid any
85# attempts to autoload DESTROY, we here define it to do nothing.
86#
87sub DESTROY {}
88
89################################################
90## Open and close.
91##
92
93sub _open_mode_string {
94 my ($mode) = @_;
95 $mode =~ /^\+?(<|>>?)$/
96 or $mode =~ s/^r(\+?)$/$1</
97 or $mode =~ s/^w(\+?)$/$1>/
98 or $mode =~ s/^a(\+?)$/$1>>/
99 or croak "IO::Handle: bad open mode: $mode";
100 $mode;
101}
102
103sub fdopen {
104 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
105 my ($io, $fd, $mode) = @_;
106 local(*GLOB);
107
108 if (ref($fd) && "".$fd =~ /GLOB\(/o) {
109 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
110 my $n = qualify(*GLOB);
111 *GLOB = *{*$fd};
112 $fd = $n;
113 } elsif ($fd =~ m#^\d+$#) {
114 # It's an FD number; prefix with "=".
115 $fd = "=$fd";
116 }
117
118 open($io, _open_mode_string($mode) . '&' . $fd)
119 ? $io : undef;
120}
121
122sub close {
123 @_ == 1 or croak 'usage: $io->close()';
124 my($io) = @_;
125
126 close($io);
127}
128
129################################################
130## Normal I/O functions.
131##
132
133# flock
134# select
135
136sub opened {
137 @_ == 1 or croak 'usage: $io->opened()';
138 defined fileno($_[0]);
139}
140
141sub fileno {
142 @_ == 1 or croak 'usage: $io->fileno()';
143 fileno($_[0]);
144}
145
146sub getc {
147 @_ == 1 or croak 'usage: $io->getc()';
148 getc($_[0]);
149}
150
151sub eof {
152 @_ == 1 or croak 'usage: $io->eof()';
153 eof($_[0]);
154}
155
156sub print {
157 @_ or croak 'usage: $io->print(ARGS)';
158 my $this = shift;
159 print $this @_;
160}
161
162sub printf {
163 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
164 my $this = shift;
165 printf $this @_;
166}
167
168sub say {
169 @_ or croak 'usage: $io->say(ARGS)';
170 my $this = shift;
171 local $\ = "\n";
172 print $this @_;
173}
174
175sub getline {
176 @_ == 1 or croak 'usage: $io->getline()';
177 my $this = shift;
178 return scalar <$this>;
179}
180
18114µs*gets = \&getline; # deprecated
182
183sub getlines {
184 @_ == 1 or croak 'usage: $io->getlines()';
185 wantarray or
186 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
187 my $this = shift;
188 return <$this>;
189}
190
191sub truncate {
192 @_ == 2 or croak 'usage: $io->truncate(LEN)';
193 truncate($_[0], $_[1]);
194}
195
196sub read {
197 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
198 read($_[0], $_[1], $_[2], $_[3] || 0);
199}
200
201sub sysread {
202 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
203 sysread($_[0], $_[1], $_[2], $_[3] || 0);
204}
205
206sub write {
207 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
208 local($\) = "";
209 $_[2] = length($_[1]) unless defined $_[2];
210 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
211}
212
213sub syswrite {
214 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
215 if (defined($_[2])) {
216 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
217 } else {
218 syswrite($_[0], $_[1]);
219 }
220}
221
222sub stat {
223 @_ == 1 or croak 'usage: $io->stat()';
224 stat($_[0]);
225}
226
227################################################
228## State modification functions.
229##
230
231sub autoflush {
232 my $old = new SelectSaver qualify($_[0], caller);
233 my $prev = $|;
234 $| = @_ > 1 ? $_[1] : 1;
235 $prev;
236}
237
238sub output_field_separator {
239 carp "output_field_separator is not supported on a per-handle basis"
240 if ref($_[0]);
241 my $prev = $,;
242 $, = $_[1] if @_ > 1;
243 $prev;
244}
245
246sub output_record_separator {
247 carp "output_record_separator is not supported on a per-handle basis"
248 if ref($_[0]);
249 my $prev = $\;
250 $\ = $_[1] if @_ > 1;
251 $prev;
252}
253
254sub input_record_separator {
255 carp "input_record_separator is not supported on a per-handle basis"
256 if ref($_[0]);
257 my $prev = $/;
258 $/ = $_[1] if @_ > 1;
259 $prev;
260}
261
262sub input_line_number {
263 local $.;
264 () = tell qualify($_[0], caller) if ref($_[0]);
265 my $prev = $.;
266 $. = $_[1] if @_ > 1;
267 $prev;
268}
269
270sub format_page_number {
271 my $old;
272 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
273 my $prev = $%;
274 $% = $_[1] if @_ > 1;
275 $prev;
276}
277
278sub format_lines_per_page {
279 my $old;
280 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
281 my $prev = $=;
282 $= = $_[1] if @_ > 1;
283 $prev;
284}
285
286sub format_lines_left {
287 my $old;
288 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
289 my $prev = $-;
290 $- = $_[1] if @_ > 1;
291 $prev;
292}
293
294sub format_name {
295 my $old;
296 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
297 my $prev = $~;
298 $~ = qualify($_[1], caller) if @_ > 1;
299 $prev;
300}
301
302sub format_top_name {
303 my $old;
304 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
305 my $prev = $^;
306 $^ = qualify($_[1], caller) if @_ > 1;
307 $prev;
308}
309
310sub format_line_break_characters {
311 carp "format_line_break_characters is not supported on a per-handle basis"
312 if ref($_[0]);
313 my $prev = $:;
314 $: = $_[1] if @_ > 1;
315 $prev;
316}
317
318sub format_formfeed {
319 carp "format_formfeed is not supported on a per-handle basis"
320 if ref($_[0]);
321 my $prev = $^L;
322 $^L = $_[1] if @_ > 1;
323 $prev;
324}
325
326sub formline {
327 my $io = shift;
328 my $picture = shift;
329 local($^A) = $^A;
330 local($\) = "";
331 formline($picture, @_);
332 print $io $^A;
333}
334
335sub format_write {
336 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
337 if (@_ == 2) {
338 my ($io, $fmt) = @_;
339 my $oldfmt = $io->format_name(qualify($fmt,caller));
340 CORE::write($io);
341 $io->format_name($oldfmt);
342 } else {
343 CORE::write($_[0]);
344 }
345}
346
347sub fcntl {
348 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
349 my ($io, $op) = @_;
350 return fcntl($io, $op, $_[2]);
351}
352
353sub ioctl {
354 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
355 my ($io, $op) = @_;
356 return ioctl($io, $op, $_[2]);
357}
358
359# this sub is for compatibility with older releases of IO that used
360# a sub called constant to determine if a constant existed -- GMB
361#
362# The SEEK_* and _IO?BF constants were the only constants at that time
363# any new code should just chech defined(&CONSTANT_NAME)
364
365sub constant {
3662244µs291µs
# spent 54µs (18+37) within IO::Handle::BEGIN@366 which was called: # once (18µs+37µs) by IO::Seekable::BEGIN@9 at line 366
no strict 'refs';
# spent 54µs making 1 call to IO::Handle::BEGIN@366 # spent 37µs making 1 call to strict::unimport
367 my $name = shift;
368 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
369 ? &{$name}() : undef;
370}
371
372# so that flush.pl can be deprecated
373
374sub printflush {
375 my $io = shift;
376 my $old;
377 $old = new SelectSaver qualify($io, caller) if ref($io);
378 local $| = 1;
379 if(ref($io)) {
380 print $io @_;
381 }
382 else {
383 print @_;
384 }
385}
386
387112µs1;