← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/darwin-2level/IO/Handle.pm
StatementsExecuted 23 statements in 1.91ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111216µs534µsIO::Handle::::BEGIN@269IO::Handle::BEGIN@269
111203µs279µsIO::Handle::::BEGIN@268IO::Handle::BEGIN@268
11170µs70µsIO::Handle::::_create_getline_subsIO::Handle::_create_getline_subs (xsub)
11114µs14µsIO::Handle::::BEGIN@263IO::Handle::BEGIN@263
11110µs40µsIO::Handle::::BEGIN@267IO::Handle::BEGIN@267
1118µs19µsIO::Handle::::BEGIN@631IO::Handle::BEGIN@631
1117µs36µsIO::Handle::::BEGIN@266IO::Handle::BEGIN@266
1116µs17µsIO::Handle::::BEGIN@264IO::Handle::BEGIN@264
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::::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
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
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 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<gbarr@pobox.com>E<gt>
260
261=cut
262
263235µs114µs
# spent 14µs within IO::Handle::BEGIN@263 which was called: # once (14µs+0s) by IO::Seekable::BEGIN@101 at line 263
use 5.006_001;
# spent 14µs making 1 call to IO::Handle::BEGIN@263
264230µs228µs
# spent 17µs (6+11) within IO::Handle::BEGIN@264 which was called: # once (6µs+11µs) by IO::Seekable::BEGIN@101 at line 264
use strict;
# spent 17µs making 1 call to IO::Handle::BEGIN@264 # spent 11µs making 1 call to strict::import
2651300nsour($VERSION, @EXPORT_OK, @ISA);
266222µs265µs
# spent 36µs (7+29) within IO::Handle::BEGIN@266 which was called: # once (7µs+29µs) by IO::Seekable::BEGIN@101 at line 266
use Carp;
# spent 36µs making 1 call to IO::Handle::BEGIN@266 # spent 29µs making 1 call to Exporter::import
267225µs270µs
# spent 40µs (10+30) within IO::Handle::BEGIN@267 which was called: # once (10µs+30µs) by IO::Seekable::BEGIN@101 at line 267
use Symbol;
# spent 40µs making 1 call to IO::Handle::BEGIN@267 # spent 30µs making 1 call to Exporter::import
2682110µs1279µs
# spent 279µs (203+76) within IO::Handle::BEGIN@268 which was called: # once (203µs+76µs) by IO::Seekable::BEGIN@101 at line 268
use SelectSaver;
# spent 279µs making 1 call to IO::Handle::BEGIN@268
26921.44ms1534µs
# spent 534µs (216+318) within IO::Handle::BEGIN@269 which was called: # once (216µs+318µs) by IO::Seekable::BEGIN@101 at line 269
use IO (); # Load the XS module
# spent 534µs making 1 call to IO::Handle::BEGIN@269
270
2711400nsrequire Exporter;
272115µs@ISA = qw(Exporter);
273
2741400ns$VERSION = "1.34";
275110µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
276
27714µs@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
313sub new {
314 my $class = ref($_[0]) || $_[0] || "IO::Handle";
315 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 }
327 my $io = gensym;
328 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
383sub close {
384 @_ == 1 or croak 'usage: $io->close()';
385 my($io) = @_;
386
387 close($io);
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
417sub print {
418 @_ or croak 'usage: $io->print(ARGS)';
419 my $this = shift;
420 print $this @_;
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.
437174µs170µs_create_getline_subs( <<'END' ) or die $@;
# spent 70µs making 1 call to IO::Handle::_create_getline_subs
# spent 2µs executing statements in string eval
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
45411µs*gets = \&getline; # deprecated
455
456sub truncate {
457 @_ == 2 or croak 'usage: $io->truncate(LEN)';
458 truncate($_[0], $_[1]);
459}
460
461sub read {
462 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
463 read($_[0], $_[1], $_[2], $_[3] || 0);
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
496sub autoflush {
497 my $old = new SelectSaver qualify($_[0], caller);
498 my $prev = $|;
499 $| = @_ > 1 ? $_[1] : 1;
500 $prev;
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 chech defined(&CONSTANT_NAME)
629
630sub constant {
6312136µs230µs
# spent 19µs (8+11) within IO::Handle::BEGIN@631 which was called: # once (8µs+11µs) by IO::Seekable::BEGIN@101 at line 631
no strict 'refs';
# spent 19µs making 1 call to IO::Handle::BEGIN@631 # spent 11µs making 1 call to strict::unimport
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
65317µs1;
 
# spent 70µs within IO::Handle::_create_getline_subs which was called: # once (70µs+0s) by IO::Seekable::BEGIN@101 at line 437
sub IO::Handle::_create_getline_subs; # xsub