This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Attempt at making IO::Handle backwards compatible again
[perl5.git] / ext / IO / lib / IO / Handle.pm
CommitLineData
8add82fc
PP
1package IO::Handle;
2
3=head1 NAME
4
27d4819a 5IO::Handle - supply object methods for I/O handles
8add82fc
PP
6
7=head1 SYNOPSIS
8
9 use IO::Handle;
10
cf7fe8a2
GS
11 $io = new IO::Handle;
12 if ($io->fdopen(fileno(STDIN),"r")) {
13 print $io->getline;
14 $io->close;
8add82fc
PP
15 }
16
cf7fe8a2
GS
17 $io = new IO::Handle;
18 if ($io->fdopen(fileno(STDOUT),"w")) {
19 $io->print("Some text\n");
8add82fc
PP
20 }
21
284196a3 22 # setvbuf is not available by default on Perls 5.8.0 and later.
3370baa8 23 use IO::Handle '_IOLBF';
cf7fe8a2 24 $io->setvbuf($buffer_var, _IOLBF, 1024);
8add82fc 25
cf7fe8a2 26 undef $io; # automatically closes the file if it's open
774d564b 27
8add82fc
PP
28 autoflush STDOUT 1;
29
30=head1 DESCRIPTION
31
774d564b
PP
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
cf7fe8a2 39for C<IO::File> too.
8add82fc 40
27d4819a
JM
41=head1 CONSTRUCTOR
42
43=over 4
44
45=item new ()
8add82fc 46
27d4819a 47Creates a new C<IO::Handle> object.
8add82fc 48
27d4819a
JM
49=item new_from_fd ( FD, MODE )
50
d1be9408 51Creates an C<IO::Handle> like C<new> does.
27d4819a
JM
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
8add82fc 59
8add82fc
PP
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:
a6006777 63
cf7fe8a2
GS
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] )
0d863452 72 $io->say ( ARGS )
cf7fe8a2
GS
73 $io->stat
74 $io->sysread ( BUF, LEN, [OFFSET] )
2ecf2f18 75 $io->syswrite ( BUF, [LEN, [OFFSET]] )
cf7fe8a2 76 $io->truncate ( LEN )
8add82fc
PP
77
78See L<perlvar> for complete descriptions of each of the following
cf7fe8a2
GS
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).
8add82fc 84
cf7fe8a2
GS
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] ) $/
8add82fc
PP
101
102Furthermore, for doing normal I/O you might need these:
103
bbc7dcd2 104=over 4
8add82fc 105
cf7fe8a2 106=item $io->fdopen ( FD, MODE )
948ecc40
CS
107
108C<fdopen> is like an ordinary C<open> except that its first parameter
d1be9408 109is not a filename but rather a file handle name, an IO::Handle object,
948ecc40
CS
110or a file descriptor number.
111
cf7fe8a2 112=item $io->opened
948ecc40 113
a47f745f
NC
114Returns true if the object is currently a valid file descriptor, false
115otherwise.
948ecc40 116
cf7fe8a2 117=item $io->getline
8add82fc 118
cf7fe8a2 119This works like <$io> described in L<perlop/"I/O Operators">
91e74348 120except that it's more readable and can be safely called in a
bb4e8523
SP
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) >>.
8add82fc 124
cf7fe8a2 125=item $io->getlines
8add82fc 126
91e74348
JH
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.
8add82fc
PP
129It will also croak() if accidentally called in a scalar context.
130
cf7fe8a2 131=item $io->ungetc ( ORD )
27d4819a 132
948ecc40 133Pushes a character with the given ordinal value back onto the given
cf7fe8a2
GS
134handle's input stream. Only one character of pushback per handle is
135guaranteed.
27d4819a 136
cf7fe8a2 137=item $io->write ( BUF, LEN [, OFFSET ] )
27d4819a 138
948ecc40 139This C<write> is like C<write> found in C, that is it is the
27d4819a
JM
140opposite of read. The wrapper for the perl C<write> function is
141called C<format_write>.
142
cf7fe8a2 143=item $io->error
948ecc40
CS
144
145Returns a true value if the given handle has experienced any errors
a47f745f
NC
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.
948ecc40 149
cf7fe8a2 150=item $io->clearerr
948ecc40 151
a47f745f
NC
152Clear the given handle's error indicator. Returns -1 if the handle is
153invalid, 0 otherwise.
27d4819a 154
cf7fe8a2
GS
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
a47f745f
NC
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
54d9745e
NC
163platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
164for an invalid handle. See L<fsync(3c)>.
cf7fe8a2
GS
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
54d9745e
NC
170will be written to the underlying file descriptor. Returns "0 but true"
171on success, C<undef> on error.
cf7fe8a2
GS
172
173=item $io->printflush ( ARGS )
174
175Turns on autoflush, print ARGS and then restores the autoflush status of the
a47f745f 176C<IO::Handle> object. Returns the return value from print.
cf7fe8a2
GS
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
8add82fc
PP
188=back
189
cf7fe8a2 190
948ecc40
CS
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
a47f745f
NC
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
284196a3
JH
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
a47f745f
NC
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
54d9745e
NC
210returns nothing. setvbuf returns "0 but true", on success, C<undef> on
211failure.
948ecc40
CS
212
213Lastly, there is a special method for working under B<-T> and setuid/gid
214scripts:
515e7bd7 215
bbc7dcd2 216=over 4
515e7bd7 217
cf7fe8a2 218=item $io->untaint
515e7bd7
RR
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
a47f745f
NC
223vulnerability should be kept in mind. Returns 0 on success, -1 if setting
224the taint-clean flag failed. (eg invalid handle)
515e7bd7
RR
225
226=back
227
27d4819a 228=head1 NOTE
8add82fc 229
d1be9408 230An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
cf7fe8a2 231the C<Symbol> package). Some modules that
8add82fc
PP
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">,
774d564b 242L<IO::File>
8add82fc
PP
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
cf7fe8a2 253Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
8add82fc
PP
254
255=cut
256
3b825e41 257use 5.006_001;
7a4c00b4 258use strict;
17f410f9 259our($VERSION, @EXPORT_OK, @ISA);
8add82fc
PP
260use Carp;
261use Symbol;
262use SelectSaver;
cf7fe8a2 263use IO (); # Load the XS module
8add82fc
PP
264
265require Exporter;
266@ISA = qw(Exporter);
267
0d863452 268$VERSION = "1.26";
105cd853 269$VERSION = eval $VERSION;
8add82fc
PP
270
271@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
0d863452 288 say
8add82fc
PP
289 getline
290 getlines
291
cf7fe8a2
GS
292 printflush
293 flush
294
8add82fc
PP
295 SEEK_SET
296 SEEK_CUR
297 SEEK_END
298 _IOFBF
299 _IOLBF
300 _IONBF
8add82fc
PP
301);
302
8add82fc
PP
303################################################
304## Constructors, destructors.
305##
306
307sub new {
27d4819a
JM
308 my $class = ref($_[0]) || $_[0] || "IO::Handle";
309 @_ == 1 or croak "usage: new $class";
cf7fe8a2
GS
310 my $io = gensym;
311 bless $io, $class;
8add82fc
PP
312}
313
314sub new_from_fd {
27d4819a
JM
315 my $class = ref($_[0]) || $_[0] || "IO::Handle";
316 @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
cf7fe8a2 317 my $io = gensym;
c927212d 318 shift;
cf7fe8a2 319 IO::Handle::fdopen($io, @_)
8add82fc 320 or return undef;
cf7fe8a2 321 bless $io, $class;
8add82fc
PP
322}
323
98d4926f
CS
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#
330sub DESTROY {}
7a4c00b4 331
8add82fc
PP
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 {
cf7fe8a2
GS
348 @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
349 my ($io, $fd, $mode) = @_;
8add82fc
PP
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
cf7fe8a2
GS
362 open($io, _open_mode_string($mode) . '&' . $fd)
363 ? $io : undef;
8add82fc
PP
364}
365
366sub close {
cf7fe8a2
GS
367 @_ == 1 or croak 'usage: $io->close()';
368 my($io) = @_;
8add82fc 369
cf7fe8a2 370 close($io);
8add82fc
PP
371}
372
373################################################
374## Normal I/O functions.
375##
376
8add82fc 377# flock
8add82fc 378# select
8add82fc
PP
379
380sub opened {
cf7fe8a2 381 @_ == 1 or croak 'usage: $io->opened()';
8add82fc
PP
382 defined fileno($_[0]);
383}
384
385sub fileno {
cf7fe8a2 386 @_ == 1 or croak 'usage: $io->fileno()';
8add82fc
PP
387 fileno($_[0]);
388}
389
390sub getc {
cf7fe8a2 391 @_ == 1 or croak 'usage: $io->getc()';
8add82fc
PP
392 getc($_[0]);
393}
394
8add82fc 395sub eof {
cf7fe8a2 396 @_ == 1 or croak 'usage: $io->eof()';
8add82fc
PP
397 eof($_[0]);
398}
399
400sub print {
cf7fe8a2 401 @_ or croak 'usage: $io->print(ARGS)';
8add82fc
PP
402 my $this = shift;
403 print $this @_;
404}
405
406sub printf {
cf7fe8a2 407 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
8add82fc
PP
408 my $this = shift;
409 printf $this @_;
410}
411
e4769da7
RGS
412if ($] >= 5.009003) {
413 *say = eval q{ sub {
414 @_ or croak 'usage: $io->say(ARGS)';
415 my $this = shift;
416 use feature 'say';
417 say $this @_;
418 }};
419}
420else {
421 *say = sub { croak "say() is not implemented for this version of perl\n" };
0d863452
RH
422}
423
8add82fc 424sub getline {
cf7fe8a2 425 @_ == 1 or croak 'usage: $io->getline()';
8add82fc
PP
426 my $this = shift;
427 return scalar <$this>;
428}
429
f86702cc
PP
430*gets = \&getline; # deprecated
431
8add82fc 432sub getlines {
cf7fe8a2 433 @_ == 1 or croak 'usage: $io->getlines()';
8add82fc 434 wantarray or
cf7fe8a2 435 croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
27d4819a 436 my $this = shift;
8add82fc
PP
437 return <$this>;
438}
439
440sub truncate {
cf7fe8a2 441 @_ == 2 or croak 'usage: $io->truncate(LEN)';
8add82fc
PP
442 truncate($_[0], $_[1]);
443}
444
445sub read {
cf7fe8a2 446 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
8add82fc
PP
447 read($_[0], $_[1], $_[2], $_[3] || 0);
448}
449
27d4819a 450sub sysread {
cf7fe8a2 451 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
27d4819a
JM
452 sysread($_[0], $_[1], $_[2], $_[3] || 0);
453}
454
8add82fc 455sub write {
8fd73a68 456 @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
8add82fc 457 local($\) = "";
8fd73a68 458 $_[2] = length($_[1]) unless defined $_[2];
8add82fc
PP
459 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
460}
461
27d4819a 462sub syswrite {
8fd73a68 463 @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
2ecf2f18
GB
464 if (defined($_[2])) {
465 syswrite($_[0], $_[1], $_[2], $_[3] || 0);
466 } else {
467 syswrite($_[0], $_[1]);
468 }
27d4819a
JM
469}
470
8add82fc 471sub stat {
cf7fe8a2 472 @_ == 1 or croak 'usage: $io->stat()';
8add82fc
PP
473 stat($_[0]);
474}
475
476################################################
477## State modification functions.
478##
479
480sub autoflush {
cf7fe8a2 481 my $old = new SelectSaver qualify($_[0], caller);
8add82fc
PP
482 my $prev = $|;
483 $| = @_ > 1 ? $_[1] : 1;
484 $prev;
485}
486
487sub output_field_separator {
cf7fe8a2
GS
488 carp "output_field_separator is not supported on a per-handle basis"
489 if ref($_[0]);
8add82fc
PP
490 my $prev = $,;
491 $, = $_[1] if @_ > 1;
492 $prev;
493}
494
495sub output_record_separator {
cf7fe8a2
GS
496 carp "output_record_separator is not supported on a per-handle basis"
497 if ref($_[0]);
8add82fc
PP
498 my $prev = $\;
499 $\ = $_[1] if @_ > 1;
500 $prev;
501}
502
503sub input_record_separator {
cf7fe8a2
GS
504 carp "input_record_separator is not supported on a per-handle basis"
505 if ref($_[0]);
8add82fc
PP
506 my $prev = $/;
507 $/ = $_[1] if @_ > 1;
508 $prev;
509}
510
511sub input_line_number {
91cce263 512 local $.;
76df5e8f 513 () = tell qualify($_[0], caller) if ref($_[0]);
91cce263
PJ
514 my $prev = $.;
515 $. = $_[1] if @_ > 1;
516 $prev;
517}
91cce263 518
8add82fc 519sub format_page_number {
76df5e8f
DM
520 my $old;
521 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
8add82fc
PP
522 my $prev = $%;
523 $% = $_[1] if @_ > 1;
524 $prev;
525}
526
527sub format_lines_per_page {
76df5e8f
DM
528 my $old;
529 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
8add82fc
PP
530 my $prev = $=;
531 $= = $_[1] if @_ > 1;
532 $prev;
533}
534
535sub format_lines_left {
76df5e8f
DM
536 my $old;
537 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
8add82fc
PP
538 my $prev = $-;
539 $- = $_[1] if @_ > 1;
540 $prev;
541}
542
543sub format_name {
76df5e8f
DM
544 my $old;
545 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
8add82fc
PP
546 my $prev = $~;
547 $~ = qualify($_[1], caller) if @_ > 1;
548 $prev;
549}
550
551sub format_top_name {
76df5e8f
DM
552 my $old;
553 $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
8add82fc
PP
554 my $prev = $^;
555 $^ = qualify($_[1], caller) if @_ > 1;
556 $prev;
557}
558
559sub format_line_break_characters {
cf7fe8a2
GS
560 carp "format_line_break_characters is not supported on a per-handle basis"
561 if ref($_[0]);
8add82fc
PP
562 my $prev = $:;
563 $: = $_[1] if @_ > 1;
564 $prev;
565}
566
567sub format_formfeed {
cf7fe8a2
GS
568 carp "format_formfeed is not supported on a per-handle basis"
569 if ref($_[0]);
8add82fc
PP
570 my $prev = $^L;
571 $^L = $_[1] if @_ > 1;
572 $prev;
573}
574
575sub formline {
cf7fe8a2 576 my $io = shift;
8add82fc
PP
577 my $picture = shift;
578 local($^A) = $^A;
579 local($\) = "";
580 formline($picture, @_);
cf7fe8a2 581 print $io $^A;
8add82fc
PP
582}
583
584sub format_write {
cf7fe8a2 585 @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
8add82fc 586 if (@_ == 2) {
cf7fe8a2
GS
587 my ($io, $fmt) = @_;
588 my $oldfmt = $io->format_name($fmt);
589 CORE::write($io);
590 $io->format_name($oldfmt);
8add82fc 591 } else {
56f7f34b 592 CORE::write($_[0]);
8add82fc
PP
593 }
594}
595
21e970cc 596# XXX undocumented
27d4819a 597sub fcntl {
cf7fe8a2 598 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
21e970cc
GS
599 my ($io, $op) = @_;
600 return fcntl($io, $op, $_[2]);
27d4819a
JM
601}
602
21e970cc 603# XXX undocumented
27d4819a 604sub ioctl {
cf7fe8a2 605 @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
21e970cc
GS
606 my ($io, $op) = @_;
607 return ioctl($io, $op, $_[2]);
27d4819a 608}
8add82fc 609
cf7fe8a2
GS
610# this sub is for compatability with older releases of IO that used
611# a sub called constant to detemine 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 chech defined(&CONSTANT_NAME)
615
616sub constant {
617 no strict 'refs';
618 my $name = shift;
619 (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
620 ? &{$name}() : undef;
621}
622
623
6facdfff 624# so that flush.pl can be deprecated
cf7fe8a2
GS
625
626sub printflush {
627 my $io = shift;
76df5e8f
DM
628 my $old;
629 $old = new SelectSaver qualify($io, caller) if ref($io);
cf7fe8a2
GS
630 local $| = 1;
631 if(ref($io)) {
632 print $io @_;
633 }
634 else {
635 print @_;
636 }
637}
638
8add82fc 6391;