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