← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:18 2017

Filename/usr/local/lib/perl5/5.24/mach/IO/Handle.pm
StatementsExecuted 116 statements in 14.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
16117.31ms7.31msIO::Handle::::CORE:printIO::Handle::CORE:print (opcode)
1111.66ms1.91msIO::Handle::::BEGIN@267IO::Handle::BEGIN@267
16111.12ms1.12msIO::Handle::::flushIO::Handle::flush (xsub)
1611827µs8.13msIO::Handle::::printIO::Handle::print
111753µs1.57msIO::Handle::::BEGIN@269IO::Handle::BEGIN@269
111661µs1.12msIO::Handle::::BEGIN@268IO::Handle::BEGIN@268
732361µs1.05msIO::Handle::::autoflushIO::Handle::autoflush
111190µs190µsIO::Handle::::_create_getline_subsIO::Handle::_create_getline_subs (xsub)
31174µs166µsIO::Handle::::newIO::Handle::new
11148µs48µsIO::Handle::::BEGIN@263IO::Handle::BEGIN@263
11132µs254µsIO::Handle::::BEGIN@266IO::Handle::BEGIN@266
11131µs40µsIO::Handle::::BEGIN@264IO::Handle::BEGIN@264
31128µs28µsIO::Handle::::filenoIO::Handle::fileno
11125µs88µsIO::Handle::::BEGIN@631IO::Handle::BEGIN@631
0000s0sIO::Handle::::DESTROYIO::Handle::DESTROY
0000s0sIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
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::::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::::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
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<gbarr@pobox.com>E<gt>
260
261=cut
262
2632114µs148µs
# spent 48µs within IO::Handle::BEGIN@263 which was called: # once (48µs+0s) by Mail::SpamAssassin::Util::BEGIN@71 at line 263
use 5.006_001;
# spent 48µs making 1 call to IO::Handle::BEGIN@263
2642106µs248µs
# spent 40µs (31+8) within IO::Handle::BEGIN@264 which was called: # once (31µs+8µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 264
use strict;
# spent 40µs making 1 call to IO::Handle::BEGIN@264 # spent 8µs making 1 call to strict::import
265our($VERSION, @EXPORT_OK, @ISA);
266263µs2477µs
# spent 254µs (32+223) within IO::Handle::BEGIN@266 which was called: # once (32µs+223µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 266
use Carp;
# spent 254µs making 1 call to IO::Handle::BEGIN@266 # spent 223µs making 1 call to Exporter::import
2672433µs22.12ms
# spent 1.91ms (1.66+253µs) within IO::Handle::BEGIN@267 which was called: # once (1.66ms+253µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 267
use Symbol;
# spent 1.91ms making 1 call to IO::Handle::BEGIN@267 # spent 212µs making 1 call to Exporter::import
2682410µs11.12ms
# spent 1.12ms (661µs+460µs) within IO::Handle::BEGIN@268 which was called: # once (661µs+460µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 268
use SelectSaver;
# spent 1.12ms making 1 call to IO::Handle::BEGIN@268
26924.22ms11.57ms
# spent 1.57ms (753µs+814µs) within IO::Handle::BEGIN@269 which was called: # once (753µs+814µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 269
use IO (); # Load the XS module
# spent 1.57ms making 1 call to IO::Handle::BEGIN@269
270
27112µsrequire Exporter;
272128µs@ISA = qw(Exporter);
273
27412µs$VERSION = "1.36";
275136µs$VERSION = eval $VERSION;
# spent 6µs executing statements in string eval
276
27717µ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
313
# spent 166µs (74+92) within IO::Handle::new which was called 3 times, avg 55µs/call: # 3 times (74µs+92µs) by IO::Socket::new at line 43 of IO/Socket.pm, avg 55µs/call
sub new {
314311µs my $class = ref($_[0]) || $_[0] || "IO::Handle";
31539µ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 }
327328µs392µs my $io = gensym;
# spent 92µs making 3 calls to Symbol::gensym, avg 30µs/call
328328µ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
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
402
# spent 28µs within IO::Handle::fileno which was called 3 times, avg 9µs/call: # 3 times (28µs+0s) by IO::Socket::IP::socket at line 947 of IO/Socket/IP.pm, avg 9µs/call
sub fileno {
40338µs @_ == 1 or croak 'usage: $io->fileno()';
404328µs 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 8.13ms (827µs+7.31) within IO::Handle::print which was called 16 times, avg 508µs/call: # 16 times (827µs+7.31ms) by Mail::SpamAssassin::Message::_parse_normal at line 1070 of Mail/SpamAssassin/Message.pm, avg 508µs/call
sub print {
4181637µs @_ or croak 'usage: $io->print(ARGS)';
4191642µs my $this = shift;
420167.97ms167.31ms print $this @_;
# spent 7.31ms making 16 calls to IO::Handle::CORE:print, avg 457µ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.
4371200µs1190µs_create_getline_subs( <<'END' ) or die $@;
# spent 190µs making 1 call to IO::Handle::_create_getline_subs
# spent 5µ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
45415µ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
496
# spent 1.05ms (361µs+688µs) within IO::Handle::autoflush which was called 7 times, avg 150µs/call: # 3 times (147µs+298µs) by IO::Socket::new at line 45 of IO/Socket.pm, avg 148µs/call # 2 times (122µs+204µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_unlock at line 156 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 163µs/call # 2 times (93µs+187µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock at line 83 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 140µs/call
sub autoflush {
4977170µs14562µs my $old = new SelectSaver qualify($_[0], caller);
# spent 464µs making 7 calls to SelectSaver::new, avg 66µs/call # spent 98µs making 7 calls to Symbol::qualify, avg 14µs/call
498734µs my $prev = $|;
499727µs $| = @_ > 1 ? $_[1] : 1;
5007128µs7127µs $prev;
# spent 127µs making 7 calls to SelectSaver::DESTROY, avg 18µs/call
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 {
6312415µs2152µs
# spent 88µs (25+63) within IO::Handle::BEGIN@631 which was called: # once (25µs+63µs) by Mail::SpamAssassin::Util::BEGIN@71 at line 631
no strict 'refs';
# spent 88µs making 1 call to IO::Handle::BEGIN@631 # spent 63µ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
653127µs1;
 
# spent 7.31ms within IO::Handle::CORE:print which was called 16 times, avg 457µs/call: # 16 times (7.31ms+0s) by IO::Handle::print at line 420, avg 457µs/call
sub IO::Handle::CORE:print; # opcode
# spent 190µs within IO::Handle::_create_getline_subs which was called: # once (190µs+0s) by Mail::SpamAssassin::Util::BEGIN@71 at line 437
sub IO::Handle::_create_getline_subs; # xsub
# spent 1.12ms within IO::Handle::flush which was called 16 times, avg 70µs/call: # 16 times (1.12ms+0s) by Mail::SpamAssassin::Message::_parse_normal at line 1071 of Mail/SpamAssassin/Message.pm, avg 70µs/call
sub IO::Handle::flush; # xsub
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.