← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:14 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/darwin-2level/IO/Handle.pm
StatementsExecuted 2754 statements in 8.91ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1354214.42ms7.66msIO::Handle::::readIO::Handle::read
1354113.24ms3.24msIO::Handle::::CORE:readIO::Handle::CORE:read (opcode)
61182µs164µsIO::Handle::::newIO::Handle::new
21166µs66µsIO::Handle::::CORE:printIO::Handle::CORE:print (opcode)
42252µs103µsIO::Handle::::closeIO::Handle::close
41151µs51µsIO::Handle::::CORE:closeIO::Handle::CORE:close (opcode)
11150µs95µsIO::Handle::::autoflushIO::Handle::autoflush
22119µs85µsIO::Handle::::printIO::Handle::print
0000s0sIO::Handle::::BEGINIO::Handle::BEGIN
0000s0sIO::Handle::::DESTROYIO::Handle::DESTROY
0000s0sIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
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::::openedIO::Handle::opened
0000s0sIO::Handle::::output_field_separatorIO::Handle::output_field_separator
0000s0sIO::Handle::::output_record_separatorIO::Handle::output_record_separator
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 $io = IO::Handle->new();
12 if ($io->fdopen(fileno(STDIN),"r")) {
13 print $io->getline;
14 $io->close;
15 }
16
17 $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($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=back
195
196
197If the C functions setbuf() and/or setvbuf() are available, then
198C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
199policy for an IO::Handle. The calling sequences for the Perl functions
200are the same as their C counterparts--including the constants C<_IOFBF>,
201C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
202specifies a scalar variable to use as a buffer. You should only
203change the buffer before any I/O, or immediately after calling flush.
204
205WARNING: The IO::Handle::setvbuf() is not available by default on
206Perls 5.8.0 and later because setvbuf() is rather specific to using
207the stdio library, while Perl prefers the new perlio subsystem instead.
208
209WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
210be modified> in any way until the IO::Handle is closed or C<setbuf> or
211C<setvbuf> is called again, or memory corruption may result! Remember that
212the order of global destruction is undefined, so even if your buffer
213variable remains in scope until program termination, it may be undefined
214before the file IO::Handle is closed. Note that you need to import the
215constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
216returns nothing. setvbuf returns "0 but true", on success, C<undef> on
217failure.
218
219Lastly, there is a special method for working under B<-T> and setuid/gid
220scripts:
221
222=over 4
223
224=item $io->untaint
225
226Marks the object as taint-clean, and as such data read from it will also
227be considered taint-clean. Note that this is a very trusting action to
228take, and appropriate consideration for the data source and potential
229vulnerability should be kept in mind. Returns 0 on success, -1 if setting
230the taint-clean flag failed. (eg invalid handle)
231
232=back
233
234=head1 NOTE
235
236An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
237the C<Symbol> package). Some modules that
238inherit from C<IO::Handle> may want to keep object related variables
239in the hash table part of the GLOB. In an attempt to prevent modules
240trampling on each other I propose the that any such module should prefix
241its variables with its own name separated by _'s. For example the IO::Socket
242module keeps a C<timeout> variable in 'io_socket_timeout'.
243
244=head1 SEE ALSO
245
246L<perlfunc>,
247L<perlop/"I/O Operators">,
248L<IO::File>
249
250=head1 BUGS
251
252Due to backwards compatibility, all filehandles resemble objects
253of class C<IO::Handle>, or actually classes derived from that class.
254They actually aren't. Which means you can't derive your own
255class from C<IO::Handle> and inherit those methods.
256
257=head1 HISTORY
258
259Derived from FileHandle.pm by Graham Barr E<lt>F<[email protected]>E<gt>
260
261=cut
262
263use 5.006_001;
264use strict;
265our($VERSION, @EXPORT_OK, @ISA);
266use Carp;
267use Symbol;
268use SelectSaver;
269use IO (); # Load the XS module
270
271require Exporter;
272@ISA = qw(Exporter);
273
274$VERSION = "1.36";
275$VERSION = eval $VERSION;
276
277@EXPORT_OK = qw(
278 autoflush
279 output_field_separator
280 output_record_separator
281 input_record_separator
282 input_line_number
283 format_page_number
284 format_lines_per_page
285 format_lines_left
286 format_name
287 format_top_name
288 format_line_break_characters
289 format_formfeed
290 format_write
291
292 print
293 printf
294 say
295 getline
296 getlines
297
298 printflush
299 flush
300
301 SEEK_SET
302 SEEK_CUR
303 SEEK_END
304 _IOFBF
305 _IOLBF
306 _IONBF
307);
308
309################################################
310## Constructors, destructors.
311##
312
313
# spent 164µs (82+82) within IO::Handle::new which was called 6 times, avg 27µs/call: # 6 times (82µs+82µs) by IO::File::new at line 160 of IO/File.pm, avg 27µs/call
sub new {
31464µs my $class = ref($_[0]) || $_[0] || "IO::Handle";
31566µs if (@_ != 1) {
316 # Since perl will automatically require IO::File if needed, but
317 # also initialises IO::File's @ISA as part of the core we must
318 # ensure IO::File is loaded if IO::Handle is. This avoids effect-
319 # ively "half-loading" IO::File.
320 if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) {
321 require IO::File;
322 shift;
323 return IO::File::->new(@_);
324 }
325 croak "usage: $class->new()";
326 }
327630µs682µs my $io = gensym;
# spent 82µs making 6 calls to Symbol::gensym, avg 14µs/call
328626µs bless $io, $class;
329}
330
331sub new_from_fd {
332 my $class = ref($_[0]) || $_[0] || "IO::Handle";
333 @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)";
334 my $io = gensym;
335 shift;
336 IO::Handle::fdopen($io, @_)
337 or return undef;
338 bless $io, $class;
339}
340
341#
342# There is no need for DESTROY to do anything, because when the
343# last reference to an IO object is gone, Perl automatically
344# closes its associated files (if any). However, to avoid any
345# attempts to autoload DESTROY, we here define it to do nothing.
346#
347sub DESTROY {}
348
349
350################################################
351## Open and close.
352##
353
354sub _open_mode_string {
355 my ($mode) = @_;
356 $mode =~ /^\+?(<|>>?)$/
357 or $mode =~ s/^r(\+?)$/$1</
358 or $mode =~ s/^w(\+?)$/$1>/
359 or $mode =~ s/^a(\+?)$/$1>>/
360 or croak "IO::Handle: bad open mode: $mode";
361 $mode;
362}
363
364sub fdopen {
365 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
366 my ($io, $fd, $mode) = @_;
367 local(*GLOB);
368
369 if (ref($fd) && "".$fd =~ /GLOB\(/o) {
370 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
371 my $n = qualify(*GLOB);
372 *GLOB = *{*$fd};
373 $fd = $n;
374 } elsif ($fd =~ m#^\d+$#) {
375 # It's an FD number; prefix with "=".
376 $fd = "=$fd";
377 }
378
379 open($io, _open_mode_string($mode) . '&' . $fd)
380 ? $io : undef;
381}
382
383
# spent 103µs (52+51) within IO::Handle::close which was called 4 times, avg 26µs/call: # 3 times (33µs+39µs) by IO::Uncompress::Base::close at line 1369 of IO/Uncompress/Base.pm, avg 24µs/call # once (19µs+12µs) by CPAN::Distribution::CHECKSUM_check_file at line 1526 of CPAN/Distribution.pm
sub close {
38445µs @_ == 1 or croak 'usage: $io->close()';
38544µs my($io) = @_;
386
387492µs451µs close($io);
# spent 51µs making 4 calls to IO::Handle::CORE:close, avg 13µs/call
388}
389
390################################################
391## Normal I/O functions.
392##
393
394# flock
395# select
396
397sub opened {
398 @_ == 1 or croak 'usage: $io->opened()';
399 defined fileno($_[0]);
400}
401
402sub fileno {
403 @_ == 1 or croak 'usage: $io->fileno()';
404 fileno($_[0]);
405}
406
407sub getc {
408 @_ == 1 or croak 'usage: $io->getc()';
409 getc($_[0]);
410}
411
412sub eof {
413 @_ == 1 or croak 'usage: $io->eof()';
414 eof($_[0]);
415}
416
417
# spent 85µs (19+66) within IO::Handle::print which was called 2 times, avg 42µs/call: # once (15µs+48µs) by CPAN::checklock at line 869 of CPAN.pm # once (4µs+18µs) by CPAN::checklock at line 870 of CPAN.pm
sub print {
41821µs @_ or croak 'usage: $io->print(ARGS)';
41920s my $this = shift;
420287µs266µs print $this @_;
# spent 66µs making 2 calls to IO::Handle::CORE:print, avg 33µs/call
421}
422
423sub printf {
424 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
425 my $this = shift;
426 printf $this @_;
427}
428
429sub say {
430 @_ or croak 'usage: $io->say(ARGS)';
431 my $this = shift;
432 local $\ = "\n";
433 print $this @_;
434}
435
436# Special XS wrapper to make them inherit lexical hints from the caller.
437_create_getline_subs( <<'END' ) or die $@;
438sub getline {
439 @_ == 1 or croak 'usage: $io->getline()';
440 my $this = shift;
441 return scalar <$this>;
442}
443
444sub getlines {
445 @_ == 1 or croak 'usage: $io->getlines()';
446 wantarray or
447 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
448 my $this = shift;
449 return <$this>;
450}
4511; # return true for error checking
452END
453
454*gets = \&getline; # deprecated
455
456sub truncate {
457 @_ == 2 or croak 'usage: $io->truncate(LEN)';
458 truncate($_[0], $_[1]);
459}
460
461
# spent 7.66ms (4.42+3.24) within IO::Handle::read which was called 1354 times, avg 6µs/call: # 726 times (2.17ms+1.50ms) by IO::Uncompress::Base::smartRead at line 73 of IO/Uncompress/Base.pm, avg 5µs/call # 628 times (2.25ms+1.74ms) by IO::Uncompress::Base::smartRead at line 68 of IO/Uncompress/Base.pm, avg 6µs/call
sub read {
4621354429µs @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
46313548.20ms13543.24ms read($_[0], $_[1], $_[2], $_[3] || 0);
# spent 3.24ms making 1354 calls to IO::Handle::CORE:read, avg 2µs/call
464}
465
466sub sysread {
467 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
468 sysread($_[0], $_[1], $_[2], $_[3] || 0);
469}
470
471sub write {
472 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
473 local($\) = "";
474 $_[2] = length($_[1]) unless defined $_[2];
475 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
476}
477
478sub syswrite {
479 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
480 if (defined($_[2])) {
481 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
482 } else {
483 syswrite($_[0], $_[1]);
484 }
485}
486
487sub stat {
488 @_ == 1 or croak 'usage: $io->stat()';
489 stat($_[0]);
490}
491
492################################################
493## State modification functions.
494##
495
496
# spent 95µs (50+45) within IO::Handle::autoflush which was called: # once (50µs+45µs) by CPAN::checklock at line 868 of CPAN.pm
sub autoflush {
497115µs235µs my $old = new SelectSaver qualify($_[0], caller);
# spent 27µs making 1 call to SelectSaver::new # spent 8µs making 1 call to Symbol::qualify
49812µs my $prev = $|;
49911µs $| = @_ > 1 ? $_[1] : 1;
50019µs110µs $prev;
# spent 10µs making 1 call to SelectSaver::DESTROY
501}
502
503sub output_field_separator {
504 carp "output_field_separator is not supported on a per-handle basis"
505 if ref($_[0]);
506 my $prev = $,;
507 $, = $_[1] if @_ > 1;
508 $prev;
509}
510
511sub output_record_separator {
512 carp "output_record_separator is not supported on a per-handle basis"
513 if ref($_[0]);
514 my $prev = $\;
515 $\ = $_[1] if @_ > 1;
516 $prev;
517}
518
519sub input_record_separator {
520 carp "input_record_separator is not supported on a per-handle basis"
521 if ref($_[0]);
522 my $prev = $/;
523 $/ = $_[1] if @_ > 1;
524 $prev;
525}
526
527sub input_line_number {
528 local $.;
529 () = tell qualify($_[0], caller) if ref($_[0]);
530 my $prev = $.;
531 $. = $_[1] if @_ > 1;
532 $prev;
533}
534
535sub format_page_number {
536 my $old;
537 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
538 my $prev = $%;
539 $% = $_[1] if @_ > 1;
540 $prev;
541}
542
543sub format_lines_per_page {
544 my $old;
545 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
546 my $prev = $=;
547 $= = $_[1] if @_ > 1;
548 $prev;
549}
550
551sub format_lines_left {
552 my $old;
553 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
554 my $prev = $-;
555 $- = $_[1] if @_ > 1;
556 $prev;
557}
558
559sub format_name {
560 my $old;
561 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
562 my $prev = $~;
563 $~ = qualify($_[1], caller) if @_ > 1;
564 $prev;
565}
566
567sub format_top_name {
568 my $old;
569 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
570 my $prev = $^;
571 $^ = qualify($_[1], caller) if @_ > 1;
572 $prev;
573}
574
575sub format_line_break_characters {
576 carp "format_line_break_characters is not supported on a per-handle basis"
577 if ref($_[0]);
578 my $prev = $:;
579 $: = $_[1] if @_ > 1;
580 $prev;
581}
582
583sub format_formfeed {
584 carp "format_formfeed is not supported on a per-handle basis"
585 if ref($_[0]);
586 my $prev = $^L;
587 $^L = $_[1] if @_ > 1;
588 $prev;
589}
590
591sub formline {
592 my $io = shift;
593 my $picture = shift;
594 local($^A) = $^A;
595 local($\) = "";
596 formline($picture, @_);
597 print $io $^A;
598}
599
600sub format_write {
601 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
602 if (@_ == 2) {
603 my ($io, $fmt) = @_;
604 my $oldfmt = $io->format_name(qualify($fmt,caller));
605 CORE::write($io);
606 $io->format_name($oldfmt);
607 } else {
608 CORE::write($_[0]);
609 }
610}
611
612sub fcntl {
613 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
614 my ($io, $op) = @_;
615 return fcntl($io, $op, $_[2]);
616}
617
618sub ioctl {
619 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
620 my ($io, $op) = @_;
621 return ioctl($io, $op, $_[2]);
622}
623
624# this sub is for compatibility with older releases of IO that used
625# a sub called constant to determine if a constant existed -- GMB
626#
627# The SEEK_* and _IO?BF constants were the only constants at that time
628# any new code should just check defined(&CONSTANT_NAME)
629
630sub constant {
631 no strict 'refs';
632 my $name = shift;
633 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
634 ? &{$name}() : undef;
635}
636
637
638# so that flush.pl can be deprecated
639
640sub printflush {
641 my $io = shift;
642 my $old;
643 $old = new SelectSaver qualify($io, caller) if ref($io);
644 local $| = 1;
645 if(ref($io)) {
646 print $io @_;
647 }
648 else {
649 print @_;
650 }
651}
652
6531;
 
# spent 51µs within IO::Handle::CORE:close which was called 4 times, avg 13µs/call: # 4 times (51µs+0s) by IO::Handle::close at line 387, avg 13µs/call
sub IO::Handle::CORE:close; # opcode
# spent 66µs within IO::Handle::CORE:print which was called 2 times, avg 33µs/call: # 2 times (66µs+0s) by IO::Handle::print at line 420, avg 33µs/call
sub IO::Handle::CORE:print; # opcode
# spent 3.24ms within IO::Handle::CORE:read which was called 1354 times, avg 2µs/call: # 1354 times (3.24ms+0s) by IO::Handle::read at line 463, avg 2µs/call
sub IO::Handle::CORE:read; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.