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