← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:21 2013

Filename/usr/lib64/perl5/vendor_perl/5.16.0/x86_64-linux/IO/Handle.pm
StatementsExecuted 412 statements in 23.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
39113.20ms4.60msIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
39112.54ms2.54msIO::Handle::::CORE:closeIO::Handle::CORE:close (opcode)
39111.80ms3.90msIO::Handle::::newIO::Handle::new
1111.62ms12.4msIO::Handle::::BEGIN@266IO::Handle::BEGIN@266
39111.20ms3.74msIO::Handle::::closeIO::Handle::close
7811638µs638µsIO::Handle::::CORE:substIO::Handle::CORE:subst (opcode)
7811394µs394µsIO::Handle::::CORE:substcontIO::Handle::CORE:substcont (opcode)
3911363µs363µsIO::Handle::::CORE:matchIO::Handle::CORE:match (opcode)
111103µs103µsIO::Handle::::BEGIN@260IO::Handle::BEGIN@260
11159µs151µsIO::Handle::::BEGIN@613IO::Handle::BEGIN@613
11155µs314µsIO::Handle::::BEGIN@263IO::Handle::BEGIN@263
11152µs144µsIO::Handle::::BEGIN@261IO::Handle::BEGIN@261
11151µs284µsIO::Handle::::BEGIN@264IO::Handle::BEGIN@264
11131µs31µsIO::Handle::::BEGIN@265IO::Handle::BEGIN@265
0000s0sIO::Handle::::DESTROYIO::Handle::DESTROY
0000s0sIO::Handle::::autoflushIO::Handle::autoflush
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::::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
3=head1 NAME
4
5IO::Handle - supply object methods for I/O handles
6
7=head1 SYNOPSIS
8
9 use IO::Handle;
10
11 $io = new IO::Handle;
12 if ($io->fdopen(fileno(STDIN),"r")) {
13 print $io->getline;
14 $io->close;
15 }
16
17 $io = new IO::Handle;
18 if ($io->fdopen(fileno(STDOUT),"w")) {
19 $io->print("Some text\n");
20 }
21
22 # setvbuf is not available by default on Perls 5.8.0 and later.
23 use IO::Handle '_IOLBF';
24 $io->setvbuf($buffer_var, _IOLBF, 1024);
25
26 undef $io; # automatically closes the file if it's open
27
28 autoflush STDOUT 1;
29
30=head1 DESCRIPTION
31
32C<IO::Handle> is the base class for all other IO handle classes. It is
33not intended that objects of C<IO::Handle> would be created directly,
34but instead C<IO::Handle> is inherited from by several other classes
35in the IO hierarchy.
36
37If you are reading this documentation, looking for a replacement for
38the C<FileHandle> package, then I suggest you read the documentation
39for C<IO::File> too.
40
41=head1 CONSTRUCTOR
42
43=over 4
44
45=item new ()
46
47Creates a new C<IO::Handle> object.
48
49=item new_from_fd ( FD, MODE )
50
51Creates an C<IO::Handle> like C<new> does.
52It requires two parameters, which are passed to the method C<fdopen>;
53if the fdopen fails, the object is destroyed. Otherwise, it is returned
54to the caller.
55
56=back
57
58=head1 METHODS
59
60See L<perlfunc> for complete descriptions of each of the following
61supported C<IO::Handle> methods, which are just front ends for the
62corresponding built-in functions:
63
64 $io->close
65 $io->eof
66 $io->fcntl( FUNCTION, SCALAR )
67 $io->fileno
68 $io->format_write( [FORMAT_NAME] )
69 $io->getc
70 $io->ioctl( FUNCTION, SCALAR )
71 $io->read ( BUF, LEN, [OFFSET] )
72 $io->print ( ARGS )
73 $io->printf ( FMT, [ARGS] )
74 $io->say ( ARGS )
75 $io->stat
76 $io->sysread ( BUF, LEN, [OFFSET] )
77 $io->syswrite ( BUF, [LEN, [OFFSET]] )
78 $io->truncate ( LEN )
79
80See L<perlvar> for complete descriptions of each of the following
81supported C<IO::Handle> methods. All of them return the previous
82value of the attribute and takes an optional single argument that when
83given will set the value. If no argument is given the previous value
84is unchanged (except for $io->autoflush will actually turn ON
85autoflush by default).
86
87 $io->autoflush ( [BOOL] ) $|
88 $io->format_page_number( [NUM] ) $%
89 $io->format_lines_per_page( [NUM] ) $=
90 $io->format_lines_left( [NUM] ) $-
91 $io->format_name( [STR] ) $~
92 $io->format_top_name( [STR] ) $^
93 $io->input_line_number( [NUM]) $.
94
95The following methods are not supported on a per-filehandle basis.
96
97 IO::Handle->format_line_break_characters( [STR] ) $:
98 IO::Handle->format_formfeed( [STR]) $^L
99 IO::Handle->output_field_separator( [STR] ) $,
100 IO::Handle->output_record_separator( [STR] ) $\
101
102 IO::Handle->input_record_separator( [STR] ) $/
103
104Furthermore, for doing normal I/O you might need these:
105
106=over 4
107
108=item $io->fdopen ( FD, MODE )
109
110C<fdopen> is like an ordinary C<open> except that its first parameter
111is not a filename but rather a file handle name, an IO::Handle object,
112or a file descriptor number. (For the documentation of the C<open>
113method, see L<IO::File>.)
114
115=item $io->opened
116
117Returns true if the object is currently a valid file descriptor, false
118otherwise.
119
120=item $io->getline
121
122This works like <$io> described in L<perlop/"I/O Operators">
123except that it's more readable and can be safely called in a
124list context but still returns just one line. If used as the conditional
125+within a C<while> or C-style C<for> loop, however, you will need to
126+emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
127
128=item $io->getlines
129
130This works like <$io> when called in a list context to read all
131the remaining lines in a file, except that it's more readable.
132It will also croak() if accidentally called in a scalar context.
133
134=item $io->ungetc ( ORD )
135
136Pushes a character with the given ordinal value back onto the given
137handle's input stream. Only one character of pushback per handle is
138guaranteed.
139
140=item $io->write ( BUF, LEN [, OFFSET ] )
141
142This C<write> is like C<write> found in C, that is it is the
143opposite of read. The wrapper for the perl C<write> function is
144called C<format_write>.
145
146=item $io->error
147
148Returns a true value if the given handle has experienced any errors
149since it was opened or since the last call to C<clearerr>, or if the
150handle is invalid. It only returns false for a valid handle with no
151outstanding errors.
152
153=item $io->clearerr
154
155Clear the given handle's error indicator. Returns -1 if the handle is
156invalid, 0 otherwise.
157
158=item $io->sync
159
160C<sync> synchronizes a file's in-memory state with that on the
161physical medium. C<sync> does not operate at the perlio api level, but
162operates on the file descriptor (similar to sysread, sysseek and
163systell). This means that any data held at the perlio api level will not
164be synchronized. To synchronize data that is buffered at the perlio api
165level you must use the flush method. C<sync> is not implemented on all
166platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
167for an invalid handle. See L<fsync(3c)>.
168
169=item $io->flush
170
171C<flush> causes perl to flush any buffered data at the perlio api level.
172Any unread data in the buffer will be discarded, and any unwritten data
173will be written to the underlying file descriptor. Returns "0 but true"
174on success, C<undef> on error.
175
176=item $io->printflush ( ARGS )
177
178Turns on autoflush, print ARGS and then restores the autoflush status of the
179C<IO::Handle> object. Returns the return value from print.
180
181=item $io->blocking ( [ BOOL ] )
182
183If called with an argument C<blocking> will turn on non-blocking IO if
184C<BOOL> is false, and turn it off if C<BOOL> is true.
185
186C<blocking> will return the value of the previous setting, or the
187current setting if C<BOOL> is not given.
188
189If an error occurs C<blocking> will return undef and C<$!> will be set.
190
191=back
192
193
194If the C functions setbuf() and/or setvbuf() are available, then
195C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
196policy for an IO::Handle. The calling sequences for the Perl functions
197are the same as their C counterparts--including the constants C<_IOFBF>,
198C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
199specifies a scalar variable to use as a buffer. You should only
200change the buffer before any I/O, or immediately after calling flush.
201
202WARNING: The IO::Handle::setvbuf() is not available by default on
203Perls 5.8.0 and later because setvbuf() is rather specific to using
204the stdio library, while Perl prefers the new perlio subsystem instead.
205
206WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
207be modified> in any way until the IO::Handle is closed or C<setbuf> or
208C<setvbuf> is called again, or memory corruption may result! Remember that
209the order of global destruction is undefined, so even if your buffer
210variable remains in scope until program termination, it may be undefined
211before the file IO::Handle is closed. Note that you need to import the
212constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
213returns nothing. setvbuf returns "0 but true", on success, C<undef> on
214failure.
215
216Lastly, there is a special method for working under B<-T> and setuid/gid
217scripts:
218
219=over 4
220
221=item $io->untaint
222
223Marks the object as taint-clean, and as such data read from it will also
224be considered taint-clean. Note that this is a very trusting action to
225take, and appropriate consideration for the data source and potential
226vulnerability should be kept in mind. Returns 0 on success, -1 if setting
227the taint-clean flag failed. (eg invalid handle)
228
229=back
230
231=head1 NOTE
232
233An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
234the C<Symbol> package). Some modules that
235inherit from C<IO::Handle> may want to keep object related variables
236in the hash table part of the GLOB. In an attempt to prevent modules
237trampling on each other I propose the that any such module should prefix
238its variables with its own name separated by _'s. For example the IO::Socket
239module keeps a C<timeout> variable in 'io_socket_timeout'.
240
241=head1 SEE ALSO
242
243L<perlfunc>,
244L<perlop/"I/O Operators">,
245L<IO::File>
246
247=head1 BUGS
248
249Due to backwards compatibility, all filehandles resemble objects
250of class C<IO::Handle>, or actually classes derived from that class.
251They actually aren't. Which means you can't derive your own
252class from C<IO::Handle> and inherit those methods.
253
254=head1 HISTORY
255
256Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
257
258=cut
259
2602350µs1103µs
# spent 103µs within IO::Handle::BEGIN@260 which was called: # once (103µs+0s) by IO::Seekable::BEGIN@101 at line 260
use 5.006_001;
# spent 103µs making 1 call to IO::Handle::BEGIN@260
2612249µs2237µs
# spent 144µs (52+93) within IO::Handle::BEGIN@261 which was called: # once (52µs+93µs) by IO::Seekable::BEGIN@101 at line 261
use strict;
# spent 144µs making 1 call to IO::Handle::BEGIN@261 # spent 93µs making 1 call to strict::import
26215µsour($VERSION, @EXPORT_OK, @ISA);
2632151µs2574µs
# spent 314µs (55+260) within IO::Handle::BEGIN@263 which was called: # once (55µs+260µs) by IO::Seekable::BEGIN@101 at line 263
use Carp;
# spent 314µs making 1 call to IO::Handle::BEGIN@263 # spent 260µs making 1 call to Exporter::import
2642146µs2518µs
# spent 284µs (51+233) within IO::Handle::BEGIN@264 which was called: # once (51µs+233µs) by IO::Seekable::BEGIN@101 at line 264
use Symbol;
# spent 284µs making 1 call to IO::Handle::BEGIN@264 # spent 233µs making 1 call to Exporter::import
2652156µs131µs
# spent 31µs within IO::Handle::BEGIN@265 which was called: # once (31µs+0s) by IO::Seekable::BEGIN@101 at line 265
use SelectSaver;
# spent 31µs making 1 call to IO::Handle::BEGIN@265
266211.1ms112.4ms
# spent 12.4ms (1.62+10.8) within IO::Handle::BEGIN@266 which was called: # once (1.62ms+10.8ms) by IO::Seekable::BEGIN@101 at line 266
use IO (); # Load the XS module
# spent 12.4ms making 1 call to IO::Handle::BEGIN@266
267
26813µsrequire Exporter;
269166µs@ISA = qw(Exporter);
270
27113µs$VERSION = "1.28";
272179µs$VERSION = eval $VERSION;
# spent 11µs executing statements in string eval
273
274127µs@EXPORT_OK = qw(
275 autoflush
276 output_field_separator
277 output_record_separator
278 input_record_separator
279 input_line_number
280 format_page_number
281 format_lines_per_page
282 format_lines_left
283 format_name
284 format_top_name
285 format_line_break_characters
286 format_formfeed
287 format_write
288
289 print
290 printf
291 say
292 getline
293 getlines
294
295 printflush
296 flush
297
298 SEEK_SET
299 SEEK_CUR
300 SEEK_END
301 _IOFBF
302 _IOLBF
303 _IONBF
304);
305
306################################################
307## Constructors, destructors.
308##
309
310
# spent 3.90ms (1.80+2.10) within IO::Handle::new which was called 39 times, avg 100µs/call: # 39 times (1.80ms+2.10ms) by IO::File::new at line 161 of IO/File.pm, avg 100µs/call
sub new {
31139178µs my $class = ref($_[0]) || $_[0] || "IO::Handle";
3123982µs @_ == 1 or croak "usage: new $class";
31339509µs392.10ms my $io = gensym;
# spent 2.10ms making 39 calls to Symbol::gensym, avg 54µs/call
31439878µs bless $io, $class;
315}
316
317sub new_from_fd {
318 my $class = ref($_[0]) || $_[0] || "IO::Handle";
319 @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
320 my $io = gensym;
321 shift;
322 IO::Handle::fdopen($io, @_)
323 or return undef;
324 bless $io, $class;
325}
326
327#
328# There is no need for DESTROY to do anything, because when the
329# last reference to an IO object is gone, Perl automatically
330# closes its associated files (if any). However, to avoid any
331# attempts to autoload DESTROY, we here define it to do nothing.
332#
333sub DESTROY {}
334
335
336################################################
337## Open and close.
338##
339
340
# spent 4.60ms (3.20+1.40) within IO::Handle::_open_mode_string which was called 39 times, avg 118µs/call: # 39 times (3.20ms+1.40ms) by IO::File::open at line 185 of IO/File.pm, avg 118µs/call
sub _open_mode_string {
34139156µs my ($mode) = @_;
342393.80ms1951.40ms $mode =~ /^\+?(<|>>?)$/
# spent 638µs making 78 calls to IO::Handle::CORE:subst, avg 8µs/call # spent 394µs making 78 calls to IO::Handle::CORE:substcont, avg 5µs/call # spent 363µs making 39 calls to IO::Handle::CORE:match, avg 9µs/call
343 or $mode =~ s/^r(\+?)$/$1</
344 or $mode =~ s/^w(\+?)$/$1>/
345 or $mode =~ s/^a(\+?)$/$1>>/
346 or croak "IO::Handle: bad open mode: $mode";
34739758µs $mode;
348}
349
350sub fdopen {
351 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
352 my ($io, $fd, $mode) = @_;
353 local(*GLOB);
354
355 if (ref($fd) && "".$fd =~ /GLOB\(/o) {
356 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
357 my $n = qualify(*GLOB);
358 *GLOB = *{*$fd};
359 $fd = $n;
360 } elsif ($fd =~ m#^\d+$#) {
361 # It's an FD number; prefix with "=".
362 $fd = "=$fd";
363 }
364
365 open($io, _open_mode_string($mode) . '&' . $fd)
366 ? $io : undef;
367}
368
369
# spent 3.74ms (1.20+2.54) within IO::Handle::close which was called 39 times, avg 96µs/call: # 39 times (1.20ms+2.54ms) by IO::AtomicFile::close at line 89 of IO/AtomicFile.pm, avg 96µs/call
sub close {
37039111µs @_ == 1 or croak 'usage: $io->close()';
37139102µs my($io) = @_;
372
373393.68ms392.54ms close($io);
# spent 2.54ms making 39 calls to IO::Handle::CORE:close, avg 65µs/call
374}
375
376################################################
377## Normal I/O functions.
378##
379
380# flock
381# select
382
383sub opened {
384 @_ == 1 or croak 'usage: $io->opened()';
385 defined fileno($_[0]);
386}
387
388sub fileno {
389 @_ == 1 or croak 'usage: $io->fileno()';
390 fileno($_[0]);
391}
392
393sub getc {
394 @_ == 1 or croak 'usage: $io->getc()';
395 getc($_[0]);
396}
397
398sub eof {
399 @_ == 1 or croak 'usage: $io->eof()';
400 eof($_[0]);
401}
402
403sub print {
404 @_ or croak 'usage: $io->print(ARGS)';
405 my $this = shift;
406 print $this @_;
407}
408
409sub printf {
410 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
411 my $this = shift;
412 printf $this @_;
413}
414
415sub say {
416 @_ or croak 'usage: $io->say(ARGS)';
417 my $this = shift;
418 local $\ = "\n";
419 print $this @_;
420}
421
422sub getline {
423 @_ == 1 or croak 'usage: $io->getline()';
424 my $this = shift;
425 return scalar <$this>;
426}
427
428114µs*gets = \&getline; # deprecated
429
430sub getlines {
431 @_ == 1 or croak 'usage: $io->getlines()';
432 wantarray or
433 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
434 my $this = shift;
435 return <$this>;
436}
437
438sub truncate {
439 @_ == 2 or croak 'usage: $io->truncate(LEN)';
440 truncate($_[0], $_[1]);
441}
442
443sub read {
444 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
445 read($_[0], $_[1], $_[2], $_[3] || 0);
446}
447
448sub sysread {
449 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
450 sysread($_[0], $_[1], $_[2], $_[3] || 0);
451}
452
453sub write {
454 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
455 local($\) = "";
456 $_[2] = length($_[1]) unless defined $_[2];
457 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
458}
459
460sub syswrite {
461 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
462 if (defined($_[2])) {
463 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
464 } else {
465 syswrite($_[0], $_[1]);
466 }
467}
468
469sub stat {
470 @_ == 1 or croak 'usage: $io->stat()';
471 stat($_[0]);
472}
473
474################################################
475## State modification functions.
476##
477
478sub autoflush {
479 my $old = new SelectSaver qualify($_[0], caller);
480 my $prev = $|;
481 $| = @_ > 1 ? $_[1] : 1;
482 $prev;
483}
484
485sub output_field_separator {
486 carp "output_field_separator is not supported on a per-handle basis"
487 if ref($_[0]);
488 my $prev = $,;
489 $, = $_[1] if @_ > 1;
490 $prev;
491}
492
493sub output_record_separator {
494 carp "output_record_separator is not supported on a per-handle basis"
495 if ref($_[0]);
496 my $prev = $\;
497 $\ = $_[1] if @_ > 1;
498 $prev;
499}
500
501sub input_record_separator {
502 carp "input_record_separator is not supported on a per-handle basis"
503 if ref($_[0]);
504 my $prev = $/;
505 $/ = $_[1] if @_ > 1;
506 $prev;
507}
508
509sub input_line_number {
510 local $.;
511 () = tell qualify($_[0], caller) if ref($_[0]);
512 my $prev = $.;
513 $. = $_[1] if @_ > 1;
514 $prev;
515}
516
517sub format_page_number {
518 my $old;
519 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
520 my $prev = $%;
521 $% = $_[1] if @_ > 1;
522 $prev;
523}
524
525sub format_lines_per_page {
526 my $old;
527 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
528 my $prev = $=;
529 $= = $_[1] if @_ > 1;
530 $prev;
531}
532
533sub format_lines_left {
534 my $old;
535 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
536 my $prev = $-;
537 $- = $_[1] if @_ > 1;
538 $prev;
539}
540
541sub format_name {
542 my $old;
543 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
544 my $prev = $~;
545 $~ = qualify($_[1], caller) if @_ > 1;
546 $prev;
547}
548
549sub format_top_name {
550 my $old;
551 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
552 my $prev = $^;
553 $^ = qualify($_[1], caller) if @_ > 1;
554 $prev;
555}
556
557sub format_line_break_characters {
558 carp "format_line_break_characters is not supported on a per-handle basis"
559 if ref($_[0]);
560 my $prev = $:;
561 $: = $_[1] if @_ > 1;
562 $prev;
563}
564
565sub format_formfeed {
566 carp "format_formfeed is not supported on a per-handle basis"
567 if ref($_[0]);
568 my $prev = $^L;
569 $^L = $_[1] if @_ > 1;
570 $prev;
571}
572
573sub formline {
574 my $io = shift;
575 my $picture = shift;
576 local($^A) = $^A;
577 local($\) = "";
578 formline($picture, @_);
579 print $io $^A;
580}
581
582sub format_write {
583 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
584 if (@_ == 2) {
585 my ($io, $fmt) = @_;
586 my $oldfmt = $io->format_name(qualify($fmt,caller));
587 CORE::write($io);
588 $io->format_name($oldfmt);
589 } else {
590 CORE::write($_[0]);
591 }
592}
593
594sub fcntl {
595 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
596 my ($io, $op) = @_;
597 return fcntl($io, $op, $_[2]);
598}
599
600sub ioctl {
601 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
602 my ($io, $op) = @_;
603 return ioctl($io, $op, $_[2]);
604}
605
606# this sub is for compatability with older releases of IO that used
607# a sub called constant to detemine if a constant existed -- GMB
608#
609# The SEEK_* and _IO?BF constants were the only constants at that time
610# any new code should just chech defined(&CONSTANT_NAME)
611
612sub constant {
6132937µs2242µs
# spent 151µs (59+92) within IO::Handle::BEGIN@613 which was called: # once (59µs+92µs) by IO::Seekable::BEGIN@101 at line 613
no strict 'refs';
# spent 151µs making 1 call to IO::Handle::BEGIN@613 # spent 92µs making 1 call to strict::unimport
614 my $name = shift;
615 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
616 ? &{$name}() : undef;
617}
618
619
620# so that flush.pl can be deprecated
621
622sub printflush {
623 my $io = shift;
624 my $old;
625 $old = new SelectSaver qualify($io, caller) if ref($io);
626 local $| = 1;
627 if(ref($io)) {
628 print $io @_;
629 }
630 else {
631 print @_;
632 }
633}
634
635134µs1;
 
# spent 2.54ms within IO::Handle::CORE:close which was called 39 times, avg 65µs/call: # 39 times (2.54ms+0s) by IO::Handle::close at line 373, avg 65µs/call
sub IO::Handle::CORE:close; # opcode
# spent 363µs within IO::Handle::CORE:match which was called 39 times, avg 9µs/call: # 39 times (363µs+0s) by IO::Handle::_open_mode_string at line 342, avg 9µs/call
sub IO::Handle::CORE:match; # opcode
# spent 638µs within IO::Handle::CORE:subst which was called 78 times, avg 8µs/call: # 78 times (638µs+0s) by IO::Handle::_open_mode_string at line 342, avg 8µs/call
sub IO::Handle::CORE:subst; # opcode
# spent 394µs within IO::Handle::CORE:substcont which was called 78 times, avg 5µs/call: # 78 times (394µs+0s) by IO::Handle::_open_mode_string at line 342, avg 5µs/call
sub IO::Handle::CORE:substcont; # opcode
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.