← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:23 2010

File/opt/wise/lib/perl5/5.10.0/x86_64-linux-thread-multi/IO/Handle.pm
Statements Executed32
Total Time0.003319 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2125.3e-55.3e-5IO::Handle::flush (xsub)
00000IO::Handle::BEGIN
00000IO::Handle::DESTROY
00000IO::Handle::_open_mode_string
00000IO::Handle::autoflush
00000IO::Handle::close
00000IO::Handle::constant
00000IO::Handle::eof
00000IO::Handle::fcntl
00000IO::Handle::fdopen
00000IO::Handle::fileno
00000IO::Handle::format_formfeed
00000IO::Handle::format_line_break_characters
00000IO::Handle::format_lines_left
00000IO::Handle::format_lines_per_page
00000IO::Handle::format_name
00000IO::Handle::format_page_number
00000IO::Handle::format_top_name
00000IO::Handle::format_write
00000IO::Handle::formline
00000IO::Handle::getc
00000IO::Handle::getline
00000IO::Handle::getlines
00000IO::Handle::input_line_number
00000IO::Handle::input_record_separator
00000IO::Handle::ioctl
00000IO::Handle::new
00000IO::Handle::new_from_fd
00000IO::Handle::opened
00000IO::Handle::output_field_separator
00000IO::Handle::output_record_separator
00000IO::Handle::print
00000IO::Handle::printf
00000IO::Handle::printflush
00000IO::Handle::read
00000IO::Handle::say
00000IO::Handle::stat
00000IO::Handle::sysread
00000IO::Handle::syswrite
00000IO::Handle::truncate
00000IO::Handle::write

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

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.