This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
551988bae556c30e54db16edf98993ae7ef7a7e9
[perl5.git] / ext / IO / lib / IO / Handle.pm
1 package IO::Handle;
2
3 =head1 NAME
4
5 IO::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
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 an 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->say ( ARGS )
73     $io->stat
74     $io->sysread ( BUF, LEN, [OFFSET] )
75     $io->syswrite ( BUF, [LEN, [OFFSET]] )
76     $io->truncate ( LEN )
77
78 See L<perlvar> for complete descriptions of each of the following
79 supported C<IO::Handle> methods.  All of them return the previous
80 value of the attribute and takes an optional single argument that when
81 given will set the value.  If no argument is given the previous value
82 is unchanged (except for $io->autoflush will actually turn ON
83 autoflush 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
93 The 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
102 Furthermore, for doing normal I/O you might need these:
103
104 =over 4
105
106 =item $io->fdopen ( FD, MODE )
107
108 C<fdopen> is like an ordinary C<open> except that its first parameter
109 is not a filename but rather a file handle name, an IO::Handle object,
110 or a file descriptor number.
111
112 =item $io->opened
113
114 Returns true if the object is currently a valid file descriptor, false
115 otherwise.
116
117 =item $io->getline
118
119 This works like <$io> described in L<perlop/"I/O Operators">
120 except that it's more readable and can be safely called in a
121 list 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
127 This works like <$io> when called in a list context to read all
128 the remaining lines in a file, except that it's more readable.
129 It will also croak() if accidentally called in a scalar context.
130
131 =item $io->ungetc ( ORD )
132
133 Pushes a character with the given ordinal value back onto the given
134 handle's input stream.  Only one character of pushback per handle is
135 guaranteed.
136
137 =item $io->write ( BUF, LEN [, OFFSET ] )
138
139 This C<write> is like C<write> found in C, that is it is the
140 opposite of read. The wrapper for the perl C<write> function is
141 called C<format_write>.
142
143 =item $io->error
144
145 Returns a true value if the given handle has experienced any errors
146 since it was opened or since the last call to C<clearerr>, or if the
147 handle is invalid. It only returns false for a valid handle with no
148 outstanding errors.
149
150 =item $io->clearerr
151
152 Clear the given handle's error indicator. Returns -1 if the handle is
153 invalid, 0 otherwise.
154
155 =item $io->sync
156
157 C<sync> synchronizes a file's in-memory state  with  that  on the
158 physical medium. C<sync> does not operate at the perlio api level, but
159 operates on the file descriptor (similar to sysread, sysseek and
160 systell). This means that any data held at the perlio api level will not
161 be synchronized. To synchronize data that is buffered at the perlio api
162 level you must use the flush method. C<sync> is not implemented on all
163 platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
164 for an invalid handle. See L<fsync(3c)>.
165
166 =item $io->flush
167
168 C<flush> causes perl to flush any buffered data at the perlio api level.
169 Any unread data in the buffer will be discarded, and any unwritten data
170 will be written to the underlying file descriptor. Returns "0 but true"
171 on success, C<undef> on error.
172
173 =item $io->printflush ( ARGS )
174
175 Turns on autoflush, print ARGS and then restores the autoflush status of the
176 C<IO::Handle> object. Returns the return value from print.
177
178 =item $io->blocking ( [ BOOL ] )
179
180 If called with an argument C<blocking> will turn on non-blocking IO if
181 C<BOOL> is false, and turn it off if C<BOOL> is true.
182
183 C<blocking> will return the value of the previous setting, or the
184 current setting if C<BOOL> is not given. 
185
186 If an error occurs C<blocking> will return undef and C<$!> will be set.
187
188 =back
189
190
191 If the C functions setbuf() and/or setvbuf() are available, then
192 C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
193 policy for an IO::Handle.  The calling sequences for the Perl functions
194 are the same as their C counterparts--including the constants C<_IOFBF>,
195 C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
196 specifies a scalar variable to use as a buffer. You should only
197 change the buffer before any I/O, or immediately after calling flush.
198
199 WARNING: The IO::Handle::setvbuf() is not available by default on
200 Perls 5.8.0 and later because setvbuf() is rather specific to using
201 the stdio library, while Perl prefers the new perlio subsystem instead.
202
203 WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
204 be modified> in any way until the IO::Handle is closed or C<setbuf> or
205 C<setvbuf> is called again, or memory corruption may result! Remember that
206 the order of global destruction is undefined, so even if your buffer
207 variable remains in scope until program termination, it may be undefined
208 before the file IO::Handle is closed. Note that you need to import the
209 constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
210 returns nothing. setvbuf returns "0 but true", on success, C<undef> on
211 failure.
212
213 Lastly, there is a special method for working under B<-T> and setuid/gid
214 scripts:
215
216 =over 4
217
218 =item $io->untaint
219
220 Marks the object as taint-clean, and as such data read from it will also
221 be considered taint-clean. Note that this is a very trusting action to
222 take, and appropriate consideration for the data source and potential
223 vulnerability should be kept in mind. Returns 0 on success, -1 if setting
224 the taint-clean flag failed. (eg invalid handle)
225
226 =back
227
228 =head1 NOTE
229
230 An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
231 the C<Symbol> package).  Some modules that
232 inherit from C<IO::Handle> may want to keep object related variables
233 in the hash table part of the GLOB. In an attempt to prevent modules
234 trampling on each other I propose the that any such module should prefix
235 its variables with its own name separated by _'s. For example the IO::Socket
236 module keeps a C<timeout> variable in 'io_socket_timeout'.
237
238 =head1 SEE ALSO
239
240 L<perlfunc>, 
241 L<perlop/"I/O Operators">,
242 L<IO::File>
243
244 =head1 BUGS
245
246 Due to backwards compatibility, all filehandles resemble objects
247 of class C<IO::Handle>, or actually classes derived from that class.
248 They actually aren't.  Which means you can't derive your own 
249 class from C<IO::Handle> and inherit those methods.
250
251 =head1 HISTORY
252
253 Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
254
255 =cut
256
257 use 5.006_001;
258 use strict;
259 our($VERSION, @EXPORT_OK, @ISA);
260 use Carp;
261 use Symbol;
262 use SelectSaver;
263 use IO ();      # Load the XS module
264
265 require Exporter;
266 @ISA = qw(Exporter);
267
268 $VERSION = "1.26";
269 $VERSION = eval $VERSION;
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
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
307 sub 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
314 sub 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 #
330 sub DESTROY {}
331
332
333 ################################################
334 ## Open and close.
335 ##
336
337 sub _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
347 sub 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
366 sub 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
380 sub opened {
381     @_ == 1 or croak 'usage: $io->opened()';
382     defined fileno($_[0]);
383 }
384
385 sub fileno {
386     @_ == 1 or croak 'usage: $io->fileno()';
387     fileno($_[0]);
388 }
389
390 sub getc {
391     @_ == 1 or croak 'usage: $io->getc()';
392     getc($_[0]);
393 }
394
395 sub eof {
396     @_ == 1 or croak 'usage: $io->eof()';
397     eof($_[0]);
398 }
399
400 sub print {
401     @_ or croak 'usage: $io->print(ARGS)';
402     my $this = shift;
403     print $this @_;
404 }
405
406 sub printf {
407     @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
408     my $this = shift;
409     printf $this @_;
410 }
411
412 sub say {
413     @_ or croak 'usage: $io->say(ARGS)';
414     my $this = shift;
415     use feature 'say';
416     say $this @_;
417 }
418
419 sub getline {
420     @_ == 1 or croak 'usage: $io->getline()';
421     my $this = shift;
422     return scalar <$this>;
423
424
425 *gets = \&getline;  # deprecated
426
427 sub getlines {
428     @_ == 1 or croak 'usage: $io->getlines()';
429     wantarray or
430         croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
431     my $this = shift;
432     return <$this>;
433 }
434
435 sub truncate {
436     @_ == 2 or croak 'usage: $io->truncate(LEN)';
437     truncate($_[0], $_[1]);
438 }
439
440 sub read {
441     @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
442     read($_[0], $_[1], $_[2], $_[3] || 0);
443 }
444
445 sub sysread {
446     @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
447     sysread($_[0], $_[1], $_[2], $_[3] || 0);
448 }
449
450 sub write {
451     @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
452     local($\) = "";
453     $_[2] = length($_[1]) unless defined $_[2];
454     print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
455 }
456
457 sub syswrite {
458     @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
459     if (defined($_[2])) {
460         syswrite($_[0], $_[1], $_[2], $_[3] || 0);
461     } else {
462         syswrite($_[0], $_[1]);
463     }
464 }
465
466 sub stat {
467     @_ == 1 or croak 'usage: $io->stat()';
468     stat($_[0]);
469 }
470
471 ################################################
472 ## State modification functions.
473 ##
474
475 sub autoflush {
476     my $old = new SelectSaver qualify($_[0], caller);
477     my $prev = $|;
478     $| = @_ > 1 ? $_[1] : 1;
479     $prev;
480 }
481
482 sub output_field_separator {
483     carp "output_field_separator is not supported on a per-handle basis"
484         if ref($_[0]);
485     my $prev = $,;
486     $, = $_[1] if @_ > 1;
487     $prev;
488 }
489
490 sub output_record_separator {
491     carp "output_record_separator is not supported on a per-handle basis"
492         if ref($_[0]);
493     my $prev = $\;
494     $\ = $_[1] if @_ > 1;
495     $prev;
496 }
497
498 sub input_record_separator {
499     carp "input_record_separator is not supported on a per-handle basis"
500         if ref($_[0]);
501     my $prev = $/;
502     $/ = $_[1] if @_ > 1;
503     $prev;
504 }
505
506 sub input_line_number {
507     local $.;
508     () = tell qualify($_[0], caller) if ref($_[0]);
509     my $prev = $.;
510     $. = $_[1] if @_ > 1;
511     $prev;
512 }
513
514 sub format_page_number {
515     my $old;
516     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
517     my $prev = $%;
518     $% = $_[1] if @_ > 1;
519     $prev;
520 }
521
522 sub format_lines_per_page {
523     my $old;
524     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
525     my $prev = $=;
526     $= = $_[1] if @_ > 1;
527     $prev;
528 }
529
530 sub format_lines_left {
531     my $old;
532     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
533     my $prev = $-;
534     $- = $_[1] if @_ > 1;
535     $prev;
536 }
537
538 sub format_name {
539     my $old;
540     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
541     my $prev = $~;
542     $~ = qualify($_[1], caller) if @_ > 1;
543     $prev;
544 }
545
546 sub format_top_name {
547     my $old;
548     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
549     my $prev = $^;
550     $^ = qualify($_[1], caller) if @_ > 1;
551     $prev;
552 }
553
554 sub format_line_break_characters {
555     carp "format_line_break_characters is not supported on a per-handle basis"
556         if ref($_[0]);
557     my $prev = $:;
558     $: = $_[1] if @_ > 1;
559     $prev;
560 }
561
562 sub format_formfeed {
563     carp "format_formfeed is not supported on a per-handle basis"
564         if ref($_[0]);
565     my $prev = $^L;
566     $^L = $_[1] if @_ > 1;
567     $prev;
568 }
569
570 sub formline {
571     my $io = shift;
572     my $picture = shift;
573     local($^A) = $^A;
574     local($\) = "";
575     formline($picture, @_);
576     print $io $^A;
577 }
578
579 sub format_write {
580     @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
581     if (@_ == 2) {
582         my ($io, $fmt) = @_;
583         my $oldfmt = $io->format_name($fmt);
584         CORE::write($io);
585         $io->format_name($oldfmt);
586     } else {
587         CORE::write($_[0]);
588     }
589 }
590
591 # XXX undocumented
592 sub fcntl {
593     @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
594     my ($io, $op) = @_;
595     return fcntl($io, $op, $_[2]);
596 }
597
598 # XXX undocumented
599 sub ioctl {
600     @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
601     my ($io, $op) = @_;
602     return ioctl($io, $op, $_[2]);
603 }
604
605 # this sub is for compatability with older releases of IO that used
606 # a sub called constant to detemine if a constant existed -- GMB
607 #
608 # The SEEK_* and _IO?BF constants were the only constants at that time
609 # any new code should just chech defined(&CONSTANT_NAME)
610
611 sub constant {
612     no strict 'refs';
613     my $name = shift;
614     (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
615         ? &{$name}() : undef;
616 }
617
618
619 # so that flush.pl can be deprecated
620
621 sub printflush {
622     my $io = shift;
623     my $old;
624     $old = new SelectSaver qualify($io, caller) if ref($io);
625     local $| = 1;
626     if(ref($io)) {
627         print $io @_;
628     }
629     else {
630         print @_;
631     }
632 }
633
634 1;