← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/lib/perl/5.10/IO/Handle.pm
Statements Executed 30
Total Time 0.0029709 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sIO::Handle::::BEGINIO::Handle::BEGIN
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
LineStmts.Exclusive
Time
Avg.Code
1package IO::Handle;
2
3331µs10µsuse 5.006_001;
4380µs27µsuse strict;
# spent 41µs making 1 call to strict::import
51600ns600nsour($VERSION, @EXPORT_OK, @ISA);
6327µs9µsuse Carp;
# spent 53µs making 1 call to Exporter::import
7329µs10µsuse Symbol;
# spent 52µs making 1 call to Exporter::import
8326µs8µsuse SelectSaver;
# spent 5µs making 1 call to import
932.52ms839µsuse IO (); # Load the XS module
10
1111µs1µsrequire Exporter;
1219µs9µs@ISA = qw(Exporter);
13
141600ns600ns$VERSION = "1.27";
15125µs25µs$VERSION = eval $VERSION;
16
1716µs6µ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 @_ == 1 or croak "usage: new $class";
56 my $io = gensym;
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#
761400ns400nssub 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
111sub close {
112 @_ == 1 or croak 'usage: $io->close()';
113 my($io) = @_;
114
115 close($io);
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
140sub eof {
141 @_ == 1 or croak 'usage: $io->eof()';
142 eof($_[0]);
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 print $this @_, "\n";
161}
162
163sub getline {
164 @_ == 1 or croak 'usage: $io->getline()';
165 my $this = shift;
166 return scalar <$this>;
167}
168
16916µs6µs*gets = \&getline; # deprecated
170
171sub getlines {
172 @_ == 1 or croak 'usage: $io->getlines()';
173 wantarray or
174 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
175 my $this = shift;
176 return <$this>;
177}
178
179sub truncate {
180 @_ == 2 or croak 'usage: $io->truncate(LEN)';
181 truncate($_[0], $_[1]);
182}
183
184sub read {
185 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
186 read($_[0], $_[1], $_[2], $_[3] || 0);
187}
188
189sub sysread {
190 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
191 sysread($_[0], $_[1], $_[2], $_[3] || 0);
192}
193
194sub write {
195 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
196 local($\) = "";
197 $_[2] = length($_[1]) unless defined $_[2];
198 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
199}
200
201sub syswrite {
202 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
203 if (defined($_[2])) {
204 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
205 } else {
206 syswrite($_[0], $_[1]);
207 }
208}
209
210sub stat {
211 @_ == 1 or croak 'usage: $io->stat()';
212 stat($_[0]);
213}
214
215################################################
216## State modification functions.
217##
218
219sub autoflush {
220 my $old = new SelectSaver qualify($_[0], caller);
221 my $prev = $|;
222 $| = @_ > 1 ? $_[1] : 1;
223 $prev;
224}
225
226sub output_field_separator {
227 carp "output_field_separator is not supported on a per-handle basis"
228 if ref($_[0]);
229 my $prev = $,;
230 $, = $_[1] if @_ > 1;
231 $prev;
232}
233
234sub output_record_separator {
235 carp "output_record_separator is not supported on a per-handle basis"
236 if ref($_[0]);
237 my $prev = $\;
238 $\ = $_[1] if @_ > 1;
239 $prev;
240}
241
242sub input_record_separator {
243 carp "input_record_separator is not supported on a per-handle basis"
244 if ref($_[0]);
245 my $prev = $/;
246 $/ = $_[1] if @_ > 1;
247 $prev;
248}
249
250sub input_line_number {
251 local $.;
252 () = tell qualify($_[0], caller) if ref($_[0]);
253 my $prev = $.;
254 $. = $_[1] if @_ > 1;
255 $prev;
256}
257
258sub format_page_number {
259 my $old;
260 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
261 my $prev = $%;
262 $% = $_[1] if @_ > 1;
263 $prev;
264}
265
266sub format_lines_per_page {
267 my $old;
268 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
269 my $prev = $=;
270 $= = $_[1] if @_ > 1;
271 $prev;
272}
273
274sub format_lines_left {
275 my $old;
276 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
277 my $prev = $-;
278 $- = $_[1] if @_ > 1;
279 $prev;
280}
281
282sub format_name {
283 my $old;
284 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
285 my $prev = $~;
286 $~ = qualify($_[1], caller) if @_ > 1;
287 $prev;
288}
289
290sub format_top_name {
291 my $old;
292 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
293 my $prev = $^;
294 $^ = qualify($_[1], caller) if @_ > 1;
295 $prev;
296}
297
298sub format_line_break_characters {
299 carp "format_line_break_characters is not supported on a per-handle basis"
300 if ref($_[0]);
301 my $prev = $:;
302 $: = $_[1] if @_ > 1;
303 $prev;
304}
305
306sub format_formfeed {
307 carp "format_formfeed is not supported on a per-handle basis"
308 if ref($_[0]);
309 my $prev = $^L;
310 $^L = $_[1] if @_ > 1;
311 $prev;
312}
313
314sub formline {
315 my $io = shift;
316 my $picture = shift;
317 local($^A) = $^A;
318 local($\) = "";
319 formline($picture, @_);
320 print $io $^A;
321}
322
323sub format_write {
324 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
325 if (@_ == 2) {
326 my ($io, $fmt) = @_;
327 my $oldfmt = $io->format_name(qualify($fmt,caller));
328 CORE::write($io);
329 $io->format_name($oldfmt);
330 } else {
331 CORE::write($_[0]);
332 }
333}
334
335# XXX undocumented
336sub fcntl {
337 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
338 my ($io, $op) = @_;
339 return fcntl($io, $op, $_[2]);
340}
341
342# XXX undocumented
343sub ioctl {
344 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
345 my ($io, $op) = @_;
346 return ioctl($io, $op, $_[2]);
347}
348
349# this sub is for compatability with older releases of IO that used
350# a sub called constant to detemine if a constant existed -- GMB
351#
352# The SEEK_* and _IO?BF constants were the only constants at that time
353# any new code should just chech defined(&CONSTANT_NAME)
354
355sub constant {
3563197µs66µs no strict 'refs';
# spent 27µs making 1 call to strict::unimport
357 my $name = shift;
358 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
359 ? &{$name}() : undef;
360}
361
362# so that flush.pl can be deprecated
363
364sub printflush {
365 my $io = shift;
366 my $old;
367 $old = new SelectSaver qualify($io, caller) if ref($io);
368 local $| = 1;
369 if(ref($io)) {
370 print $io @_;
371 }
372 else {
373 print @_;
374 }
375}
376
377116µs16µs1;