← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/x86_64-linux/IO/Handle.pm
StatementsExecuted 368 statements in 2.32ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111222µs408µsIO::Handle::::BEGIN@276IO::Handle::BEGIN@276
5910472µs688µsIO::Handle::::readIO::Handle::read
91154µs83µsIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
692230µs30µsIO::Handle::::openedIO::Handle::opened
91124µs56µsIO::Handle::::newIO::Handle::new
81118µs22µsIO::Handle::::binmodeIO::Handle::binmode
11110µs10µsIO::Handle::::BEGIN@271IO::Handle::BEGIN@271
1117µs11µsIO::Handle::::BEGIN@617IO::Handle::BEGIN@617
7117µs7µsIO::Handle::::clearerrIO::Handle::clearerr (xsub)
1116µs6µsIO::Handle::::BEGIN@275IO::Handle::BEGIN@275
2225µs13µsIO::Handle::::closeIO::Handle::close
1114µs6µsIO::Handle::::BEGIN@272IO::Handle::BEGIN@272
1113µs25µsIO::Handle::::BEGIN@273IO::Handle::BEGIN@273
1113µs20µsIO::Handle::::BEGIN@274IO::Handle::BEGIN@274
111300ns300nsIO::Handle::::__ANON__IO::Handle::__ANON__ (xsub)
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::::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::::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::::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 my $io = IO::Handle->new();
12 if ($io->fdopen(fileno(STDIN),"r")) {
13 print $io->getline;
14 $io->close;
15 }
16
17 my $io = IO::Handle->new();
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(my $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
125within a C<while> or C-style C<for> loop, however, you will need to
126emulate 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 somewhat like C<write> found in C, in that it is the
143opposite of read. The wrapper for the perl C<write> function is
144called C<format_write>. However, whilst the C C<write> function returns
145the number of bytes written, this C<write> function simply returns true
146if successful (like C<print>). A more C-like C<write> is C<syswrite>
147(see above).
148
149=item $io->error
150
151Returns a true value if the given handle has experienced any errors
152since it was opened or since the last call to C<clearerr>, or if the
153handle is invalid. It only returns false for a valid handle with no
154outstanding errors.
155
156=item $io->clearerr
157
158Clear the given handle's error indicator. Returns -1 if the handle is
159invalid, 0 otherwise.
160
161=item $io->sync
162
163C<sync> synchronizes a file's in-memory state with that on the
164physical medium. C<sync> does not operate at the perlio api level, but
165operates on the file descriptor (similar to sysread, sysseek and
166systell). This means that any data held at the perlio api level will not
167be synchronized. To synchronize data that is buffered at the perlio api
168level you must use the flush method. C<sync> is not implemented on all
169platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
170for an invalid handle. See L<fsync(3c)>.
171
172=item $io->flush
173
174C<flush> causes perl to flush any buffered data at the perlio api level.
175Any unread data in the buffer will be discarded, and any unwritten data
176will be written to the underlying file descriptor. Returns "0 but true"
177on success, C<undef> on error.
178
179=item $io->printflush ( ARGS )
180
181Turns on autoflush, print ARGS and then restores the autoflush status of the
182C<IO::Handle> object. Returns the return value from print.
183
184=item $io->blocking ( [ BOOL ] )
185
186If called with an argument C<blocking> will turn on non-blocking IO if
187C<BOOL> is false, and turn it off if C<BOOL> is true.
188
189C<blocking> will return the value of the previous setting, or the
190current setting if C<BOOL> is not given.
191
192If an error occurs C<blocking> will return undef and C<$!> will be set.
193
194=item binmode( [LAYER] )
195
196C<binmode> sets C<binmode> on the underlying C<IO> object, as documented
197in C<perldoc -f binmode>.
198
199C<binmode> accepts one optional parameter, which is the layer to be
200passed on to the C<binmode> call.
201
202=back
203
204
205If the C functions setbuf() and/or setvbuf() are available, then
206C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
207policy for an IO::Handle. The calling sequences for the Perl functions
208are the same as their C counterparts--including the constants C<_IOFBF>,
209C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
210specifies a scalar variable to use as a buffer. You should only
211change the buffer before any I/O, or immediately after calling flush.
212
213WARNING: The IO::Handle::setvbuf() is not available by default on
214Perls 5.8.0 and later because setvbuf() is rather specific to using
215the stdio library, while Perl prefers the new perlio subsystem instead.
216
217WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
218be modified> in any way until the IO::Handle is closed or C<setbuf> or
219C<setvbuf> is called again, or memory corruption may result! Remember that
220the order of global destruction is undefined, so even if your buffer
221variable remains in scope until program termination, it may be undefined
222before the file IO::Handle is closed. Note that you need to import the
223constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
224returns nothing. setvbuf returns "0 but true", on success, C<undef> on
225failure.
226
227Lastly, there is a special method for working under B<-T> and setuid/gid
228scripts:
229
230=over 4
231
232=item $io->untaint
233
234Marks the object as taint-clean, and as such data read from it will also
235be considered taint-clean. Note that this is a very trusting action to
236take, and appropriate consideration for the data source and potential
237vulnerability should be kept in mind. Returns 0 on success, -1 if setting
238the taint-clean flag failed. (eg invalid handle)
239
240=back
241
242=head1 NOTE
243
244An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
245the L<Symbol> package). Some modules that
246inherit from C<IO::Handle> may want to keep object related variables
247in the hash table part of the GLOB. In an attempt to prevent modules
248trampling on each other I propose the that any such module should prefix
249its variables with its own name separated by _'s. For example the IO::Socket
250module keeps a C<timeout> variable in 'io_socket_timeout'.
251
252=head1 SEE ALSO
253
254L<perlfunc>,
255L<perlop/"I/O Operators">,
256L<IO::File>
257
258=head1 BUGS
259
260Due to backwards compatibility, all filehandles resemble objects
261of class C<IO::Handle>, or actually classes derived from that class.
262They actually aren't. Which means you can't derive your own
263class from C<IO::Handle> and inherit those methods.
264
265=head1 HISTORY
266
267Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
268
269=cut
270
271242µs110µs
# spent 10µs within IO::Handle::BEGIN@271 which was called: # once (10µs+0s) by IO::Seekable::BEGIN@100 at line 271
use 5.008_001;
# spent 10µs making 1 call to IO::Handle::BEGIN@271
272214µs27µs
# spent 6µs (4+1) within IO::Handle::BEGIN@272 which was called: # once (4µs+1µs) by IO::Seekable::BEGIN@100 at line 272
use strict;
# spent 6µs making 1 call to IO::Handle::BEGIN@272 # spent 1µs making 1 call to strict::import
273213µs248µs
# spent 25µs (3+22) within IO::Handle::BEGIN@273 which was called: # once (3µs+22µs) by IO::Seekable::BEGIN@100 at line 273
use Carp;
# spent 25µs making 1 call to IO::Handle::BEGIN@273 # spent 22µs making 1 call to Exporter::import
274215µs236µs
# spent 20µs (3+17) within IO::Handle::BEGIN@274 which was called: # once (3µs+17µs) by IO::Seekable::BEGIN@100 at line 274
use Symbol;
# spent 20µs making 1 call to IO::Handle::BEGIN@274 # spent 17µs making 1 call to Exporter::import
275214µs26µs
# spent 6µs (6+300ns) within IO::Handle::BEGIN@275 which was called: # once (6µs+300ns) by IO::Seekable::BEGIN@100 at line 275
use SelectSaver;
# spent 6µs making 1 call to IO::Handle::BEGIN@275 # spent 300ns making 1 call to IO::Handle::__ANON__
27621.13ms1408µs
# spent 408µs (222+186) within IO::Handle::BEGIN@276 which was called: # once (222µs+186µs) by IO::Seekable::BEGIN@100 at line 276
use IO (); # Load the XS module
# spent 408µs making 1 call to IO::Handle::BEGIN@276
277
2781500nsrequire Exporter;
27919µsour @ISA = qw(Exporter);
280
2811300nsour $VERSION = "1.55";
282
28311µsour @EXPORT_OK = qw(
284 autoflush
285 output_field_separator
286 output_record_separator
287 input_record_separator
288 input_line_number
289 format_page_number
290 format_lines_per_page
291 format_lines_left
292 format_name
293 format_top_name
294 format_line_break_characters
295 format_formfeed
296 format_write
297
298 print
299 printf
300 say
301 getline
302 getlines
303
304 printflush
305 flush
306
307 SEEK_SET
308 SEEK_CUR
309 SEEK_END
310 _IOFBF
311 _IOLBF
312 _IONBF
313);
314
315################################################
316## Constructors, destructors.
317##
318
319
# spent 56µs (24+32) within IO::Handle::new which was called 9 times, avg 6µs/call: # 9 times (24µs+32µs) by IO::File::new at line 151 of IO/File.pm, avg 6µs/call
sub new {
32093µs my $class = ref($_[0]) || $_[0] || "IO::Handle";
32192µs if (@_ != 1) {
322 # Since perl will automatically require IO::File if needed, but
323 # also initialises IO::File's @ISA as part of the core we must
324 # ensure IO::File is loaded if IO::Handle is. This avoids effect-
325 # ively "half-loading" IO::File.
326 if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) {
327 require IO::File;
328 shift;
329 return IO::File::->new(@_);
330 }
331 croak "usage: $class->new()";
332 }
33397µs932µs my $io = gensym;
# spent 32µs making 9 calls to Symbol::gensym, avg 4µs/call
334912µs bless $io, $class;
335}
336
337sub new_from_fd {
338 my $class = ref($_[0]) || $_[0] || "IO::Handle";
339 @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)";
340 my $io = gensym;
341 shift;
342 IO::Handle::fdopen($io, @_)
343 or return undef;
344 bless $io, $class;
345}
346
347#
348# There is no need for DESTROY to do anything, because when the
349# last reference to an IO object is gone, Perl automatically
350# closes its associated files (if any). However, to avoid any
351# attempts to autoload DESTROY, we here define it to do nothing.
352#
353sub DESTROY {}
354
355
356################################################
357## Open and close.
358##
359
360
# spent 83µs (54+30) within IO::Handle::_open_mode_string which was called 9 times, avg 9µs/call: # 9 times (54µs+30µs) by IO::File::open at line 175 of IO/File.pm, avg 9µs/call
sub _open_mode_string {
36193µs my ($mode) = @_;
362972µs3630µs $mode =~ /^\+?(<|>>?)$/
# spent 10µs making 9 calls to CORE::subst, avg 1µs/call # spent 10µs making 18 calls to CORE::substcont, avg 544ns/call # spent 10µs making 9 calls to CORE::match, avg 1µs/call
363 or $mode =~ s/^r(\+?)$/$1</
364 or $mode =~ s/^w(\+?)$/$1>/
365 or $mode =~ s/^a(\+?)$/$1>>/
366 or croak "IO::Handle: bad open mode: $mode";
367912µs $mode;
368}
369
370sub fdopen {
371 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
372 my ($io, $fd, $mode) = @_;
373 local(*GLOB);
374
375 if (ref($fd) && "$fd" =~ /GLOB\(/o) {
376 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
377 my $n = qualify(*GLOB);
378 *GLOB = *{*$fd};
379 $fd = $n;
380 } elsif ($fd =~ m#^\d+$#) {
381 # It's an FD number; prefix with "=".
382 $fd = "=$fd";
383 }
384
385 open($io, _open_mode_string($mode) . '&' . $fd)
386 ? $io : undef;
387}
388
389
# spent 13µs (5+8) within IO::Handle::close which was called 2 times, avg 7µs/call: # once (4µs+4µs) by Spreadsheet::ParseXLSX::_check_signature at line 124 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (2µs+4µs) by Archive::Zip::Archive::read at line 732 of Archive/Zip/Archive.pm
sub close {
3902600ns @_ == 1 or croak 'usage: $io->close()';
3912600ns my($io) = @_;
392
393213µs28µs close($io);
# spent 8µs making 2 calls to CORE::close, avg 4µs/call
394}
395
396################################################
397## Normal I/O functions.
398##
399
400# flock
401# select
402
403
# spent 30µs within IO::Handle::opened which was called 69 times, avg 430ns/call: # 68 times (28µs+0s) by Archive::Zip::FileMember::fh at line 31 of Archive/Zip/FileMember.pm, avg 412ns/call # once (2µs+0s) by Archive::Zip::Archive::readFromFileHandle at line 750 of Archive/Zip/Archive.pm
sub opened {
404696µs @_ == 1 or croak 'usage: $io->opened()';
4056954µs defined fileno($_[0]);
406}
407
408sub fileno {
409 @_ == 1 or croak 'usage: $io->fileno()';
410 fileno($_[0]);
411}
412
413sub getc {
414 @_ == 1 or croak 'usage: $io->getc()';
415 getc($_[0]);
416}
417
418sub eof {
419 @_ == 1 or croak 'usage: $io->eof()';
420 eof($_[0]);
421}
422
423sub print {
424 @_ or croak 'usage: $io->print(ARGS)';
425 my $this = shift;
426 print $this @_;
427}
428
429sub printf {
430 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
431 my $this = shift;
432 printf $this @_;
433}
434
435sub say {
436 @_ or croak 'usage: $io->say(ARGS)';
437 my $this = shift;
438 local $\ = "\n";
439 print $this @_;
440}
441
442sub truncate {
443 @_ == 2 or croak 'usage: $io->truncate(LEN)';
444 truncate($_[0], $_[1]);
445}
446
447
# spent 688µs (72+617) within IO::Handle::read which was called 59 times, avg 12µs/call: # 19 times (27µs+43µs) by Archive::Zip::_readSignature at line 516 of Archive/Zip.pm, avg 4µs/call # 10 times (9µs+4µs) by Archive::Zip::ZipFileMember::_readCentralDirectoryFileHeader at line 371 of Archive/Zip/ZipFileMember.pm, avg 1µs/call # 10 times (9µs+2µs) by Archive::Zip::ZipFileMember::_readCentralDirectoryFileHeader at line 398 of Archive/Zip/ZipFileMember.pm, avg 1µs/call # 7 times (10µs+548µs) by Archive::Zip::ZipFileMember::_readRawChunk at line 470 of Archive/Zip/ZipFileMember.pm, avg 80µs/call # 7 times (7µs+2µs) by Archive::Zip::ZipFileMember::_skipLocalFileHeader at line 138 of Archive/Zip/ZipFileMember.pm, avg 1µs/call # 2 times (2µs+4µs) by Archive::Zip::ZipFileMember::_skipLocalFileHeader at line 165 of Archive/Zip/ZipFileMember.pm, avg 3µs/call # once (4µs+9µs) by Spreadsheet::ParseXLSX::_check_signature at line 123 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (2µs+3µs) by Archive::Zip::Archive::_findEndOfCentralDirectory at line 1041 of Archive/Zip/Archive.pm # once (1µs+1µs) by Archive::Zip::Archive::_readEndOfCentralDirectory at line 953 of Archive/Zip/Archive.pm # once (1µs+400ns) by Archive::Zip::Archive::_readEndOfCentralDirectory at line 884 of Archive/Zip/Archive.pm
sub read {
448596µs @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
44959710µs59617µs read($_[0], $_[1], $_[2], $_[3] || 0);
# spent 617µs making 59 calls to CORE::read, avg 10µs/call
450}
451
452sub sysread {
453 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
454 sysread($_[0], $_[1], $_[2], $_[3] || 0);
455}
456
457sub write {
458 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
459 local($\) = "";
460 $_[2] = length($_[1]) unless defined $_[2];
461 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
462}
463
464sub syswrite {
465 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
466 if (defined($_[2])) {
467 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
468 } else {
469 syswrite($_[0], $_[1]);
470 }
471}
472
473sub stat {
474 @_ == 1 or croak 'usage: $io->stat()';
475 stat($_[0]);
476}
477
478################################################
479## State modification functions.
480##
481
482sub autoflush {
483 my $old = SelectSaver->new(qualify($_[0], caller));
484 my $prev = $|;
485 $| = @_ > 1 ? $_[1] : 1;
486 $prev;
487}
488
489sub output_field_separator {
490 carp "output_field_separator is not supported on a per-handle basis"
491 if ref($_[0]);
492 my $prev = $,;
493 $, = $_[1] if @_ > 1;
494 $prev;
495}
496
497sub output_record_separator {
498 carp "output_record_separator is not supported on a per-handle basis"
499 if ref($_[0]);
500 my $prev = $\;
501 $\ = $_[1] if @_ > 1;
502 $prev;
503}
504
505sub input_record_separator {
506 carp "input_record_separator is not supported on a per-handle basis"
507 if ref($_[0]);
508 my $prev = $/;
509 $/ = $_[1] if @_ > 1;
510 $prev;
511}
512
513sub input_line_number {
514 local $.;
515 () = tell qualify($_[0], caller) if ref($_[0]);
516 my $prev = $.;
517 $. = $_[1] if @_ > 1;
518 $prev;
519}
520
521sub format_page_number {
522 my $old;
523 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
524 my $prev = $%;
525 $% = $_[1] if @_ > 1;
526 $prev;
527}
528
529sub format_lines_per_page {
530 my $old;
531 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
532 my $prev = $=;
533 $= = $_[1] if @_ > 1;
534 $prev;
535}
536
537sub format_lines_left {
538 my $old;
539 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
540 my $prev = $-;
541 $- = $_[1] if @_ > 1;
542 $prev;
543}
544
545sub format_name {
546 my $old;
547 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
548 my $prev = $~;
549 $~ = qualify($_[1], caller) if @_ > 1;
550 $prev;
551}
552
553sub format_top_name {
554 my $old;
555 $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
556 my $prev = $^;
557 $^ = qualify($_[1], caller) if @_ > 1;
558 $prev;
559}
560
561sub format_line_break_characters {
562 carp "format_line_break_characters is not supported on a per-handle basis"
563 if ref($_[0]);
564 my $prev = $:;
565 $: = $_[1] if @_ > 1;
566 $prev;
567}
568
569sub format_formfeed {
570 carp "format_formfeed is not supported on a per-handle basis"
571 if ref($_[0]);
572 my $prev = $^L;
573 $^L = $_[1] if @_ > 1;
574 $prev;
575}
576
577sub formline {
578 my $io = shift;
579 my $picture = shift;
580 local($^A) = $^A;
581 local($\) = "";
582 formline($picture, @_);
583 print $io $^A;
584}
585
586sub format_write {
587 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
588 if (@_ == 2) {
589 my ($io, $fmt) = @_;
590 my $oldfmt = $io->format_name(qualify($fmt,caller));
591 CORE::write($io);
592 $io->format_name($oldfmt);
593 } else {
594 CORE::write($_[0]);
595 }
596}
597
598sub fcntl {
599 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
600 my ($io, $op) = @_;
601 return fcntl($io, $op, $_[2]);
602}
603
604sub ioctl {
605 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
606 my ($io, $op) = @_;
607 return ioctl($io, $op, $_[2]);
608}
609
610# this sub is for compatibility with older releases of IO that used
611# a sub called constant to determine if a constant existed -- GMB
612#
613# The SEEK_* and _IO?BF constants were the only constants at that time
614# any new code should just check defined(&CONSTANT_NAME)
615
616sub constant {
6172158µs216µs
# spent 11µs (7+4) within IO::Handle::BEGIN@617 which was called: # once (7µs+4µs) by IO::Seekable::BEGIN@100 at line 617
no strict 'refs';
# spent 11µs making 1 call to IO::Handle::BEGIN@617 # spent 4µs making 1 call to strict::unimport
618 my $name = shift;
619 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
620 ? &{$name}() : undef;
621}
622
623
624# so that flush.pl can be deprecated
625
626sub printflush {
627 my $io = shift;
628 my $old;
629 $old = SelectSaver->new(qualify($io, caller)) if ref($io);
630 local $| = 1;
631 if(ref($io)) {
632 print $io @_;
633 }
634 else {
635 print @_;
636 }
637}
638
639################################################
640## Binmode
641##
642
643
# spent 22µs (18+4) within IO::Handle::binmode which was called 8 times, avg 3µs/call: # 8 times (18µs+4µs) by Archive::Zip::_binmode at line 432 of Archive/Zip.pm, avg 3µs/call
sub binmode {
64482µs ( @_ == 1 or @_ == 2 ) or croak 'usage $fh->binmode([LAYER])';
645
64682µs my($fh, $layer) = @_;
647
648822µs84µs return binmode $$fh unless $layer;
# spent 4µs making 8 calls to CORE::binmode, avg 562ns/call
649 return binmode $$fh, $layer;
650}
651
65214µs1;
 
# spent 300ns within IO::Handle::__ANON__ which was called: # once (300ns+0s) by IO::Handle::BEGIN@275 at line 275
sub IO::Handle::__ANON__; # xsub
# spent 7µs within IO::Handle::clearerr which was called 7 times, avg 957ns/call: # 7 times (7µs+0s) by Archive::Zip::ZipFileMember::rewindData at line 445 of Archive/Zip/ZipFileMember.pm, avg 957ns/call
sub IO::Handle::clearerr; # xsub