This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make IO::Handle::getline(s) respect the open pragma
[perl5.git] / dist / 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 = IO::Handle->new();
12     if ($io->fdopen(fileno(STDIN),"r")) {
13         print $io->getline;
14         $io->close;
15     }
16
17     $io = IO::Handle->new();
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.33";
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     if (@_ != 1) {
313         # Since perl will automatically require IO::File if needed, but
314         # also initialises IO::File's @ISA as part of the core we must
315         # ensure IO::File is loaded if IO::Handle is. This avoids effect-
316         # ively "half-loading" IO::File.
317         if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) {
318             require IO::File;
319             shift;
320             return IO::File::->new(@_);
321         }
322         croak "usage: $class->new()";
323     }
324     my $io = gensym;
325     bless $io, $class;
326 }
327
328 sub new_from_fd {
329     my $class = ref($_[0]) || $_[0] || "IO::Handle";
330     @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)";
331     my $io = gensym;
332     shift;
333     IO::Handle::fdopen($io, @_)
334         or return undef;
335     bless $io, $class;
336 }
337
338 #
339 # There is no need for DESTROY to do anything, because when the
340 # last reference to an IO object is gone, Perl automatically
341 # closes its associated files (if any).  However, to avoid any
342 # attempts to autoload DESTROY, we here define it to do nothing.
343 #
344 sub DESTROY {}
345
346
347 ################################################
348 ## Open and close.
349 ##
350
351 sub _open_mode_string {
352     my ($mode) = @_;
353     $mode =~ /^\+?(<|>>?)$/
354       or $mode =~ s/^r(\+?)$/$1</
355       or $mode =~ s/^w(\+?)$/$1>/
356       or $mode =~ s/^a(\+?)$/$1>>/
357       or croak "IO::Handle: bad open mode: $mode";
358     $mode;
359 }
360
361 sub fdopen {
362     @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
363     my ($io, $fd, $mode) = @_;
364     local(*GLOB);
365
366     if (ref($fd) && "".$fd =~ /GLOB\(/o) {
367         # It's a glob reference; Alias it as we cannot get name of anon GLOBs
368         my $n = qualify(*GLOB);
369         *GLOB = *{*$fd};
370         $fd =  $n;
371     } elsif ($fd =~ m#^\d+$#) {
372         # It's an FD number; prefix with "=".
373         $fd = "=$fd";
374     }
375
376     open($io, _open_mode_string($mode) . '&' . $fd)
377         ? $io : undef;
378 }
379
380 sub close {
381     @_ == 1 or croak 'usage: $io->close()';
382     my($io) = @_;
383
384     close($io);
385 }
386
387 ################################################
388 ## Normal I/O functions.
389 ##
390
391 # flock
392 # select
393
394 sub opened {
395     @_ == 1 or croak 'usage: $io->opened()';
396     defined fileno($_[0]);
397 }
398
399 sub fileno {
400     @_ == 1 or croak 'usage: $io->fileno()';
401     fileno($_[0]);
402 }
403
404 sub getc {
405     @_ == 1 or croak 'usage: $io->getc()';
406     getc($_[0]);
407 }
408
409 sub eof {
410     @_ == 1 or croak 'usage: $io->eof()';
411     eof($_[0]);
412 }
413
414 sub print {
415     @_ or croak 'usage: $io->print(ARGS)';
416     my $this = shift;
417     print $this @_;
418 }
419
420 sub printf {
421     @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
422     my $this = shift;
423     printf $this @_;
424 }
425
426 sub say {
427     @_ or croak 'usage: $io->say(ARGS)';
428     my $this = shift;
429     local $\ = "\n";
430     print $this @_;
431 }
432
433 # Special XS wrapper to make them inherit lexical hints from the caller.
434 _create_getline_subs( <<'END' ) or die $@;
435 sub getline {
436     @_ == 1 or croak 'usage: $io->getline()';
437     my $this = shift;
438     return scalar <$this>;
439
440
441 sub getlines {
442     @_ == 1 or croak 'usage: $io->getlines()';
443     wantarray or
444         croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
445     my $this = shift;
446     return <$this>;
447 }
448 1; # return true for error checking
449 END
450
451 *gets = \&getline;  # deprecated
452
453 sub truncate {
454     @_ == 2 or croak 'usage: $io->truncate(LEN)';
455     truncate($_[0], $_[1]);
456 }
457
458 sub read {
459     @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
460     read($_[0], $_[1], $_[2], $_[3] || 0);
461 }
462
463 sub sysread {
464     @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
465     sysread($_[0], $_[1], $_[2], $_[3] || 0);
466 }
467
468 sub write {
469     @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
470     local($\) = "";
471     $_[2] = length($_[1]) unless defined $_[2];
472     print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
473 }
474
475 sub syswrite {
476     @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
477     if (defined($_[2])) {
478         syswrite($_[0], $_[1], $_[2], $_[3] || 0);
479     } else {
480         syswrite($_[0], $_[1]);
481     }
482 }
483
484 sub stat {
485     @_ == 1 or croak 'usage: $io->stat()';
486     stat($_[0]);
487 }
488
489 ################################################
490 ## State modification functions.
491 ##
492
493 sub autoflush {
494     my $old = new SelectSaver qualify($_[0], caller);
495     my $prev = $|;
496     $| = @_ > 1 ? $_[1] : 1;
497     $prev;
498 }
499
500 sub output_field_separator {
501     carp "output_field_separator is not supported on a per-handle basis"
502         if ref($_[0]);
503     my $prev = $,;
504     $, = $_[1] if @_ > 1;
505     $prev;
506 }
507
508 sub output_record_separator {
509     carp "output_record_separator is not supported on a per-handle basis"
510         if ref($_[0]);
511     my $prev = $\;
512     $\ = $_[1] if @_ > 1;
513     $prev;
514 }
515
516 sub input_record_separator {
517     carp "input_record_separator 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 input_line_number {
525     local $.;
526     () = tell qualify($_[0], caller) if ref($_[0]);
527     my $prev = $.;
528     $. = $_[1] if @_ > 1;
529     $prev;
530 }
531
532 sub format_page_number {
533     my $old;
534     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
535     my $prev = $%;
536     $% = $_[1] if @_ > 1;
537     $prev;
538 }
539
540 sub format_lines_per_page {
541     my $old;
542     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
543     my $prev = $=;
544     $= = $_[1] if @_ > 1;
545     $prev;
546 }
547
548 sub format_lines_left {
549     my $old;
550     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
551     my $prev = $-;
552     $- = $_[1] if @_ > 1;
553     $prev;
554 }
555
556 sub format_name {
557     my $old;
558     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
559     my $prev = $~;
560     $~ = qualify($_[1], caller) if @_ > 1;
561     $prev;
562 }
563
564 sub format_top_name {
565     my $old;
566     $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
567     my $prev = $^;
568     $^ = qualify($_[1], caller) if @_ > 1;
569     $prev;
570 }
571
572 sub format_line_break_characters {
573     carp "format_line_break_characters is not supported on a per-handle basis"
574         if ref($_[0]);
575     my $prev = $:;
576     $: = $_[1] if @_ > 1;
577     $prev;
578 }
579
580 sub format_formfeed {
581     carp "format_formfeed is not supported on a per-handle basis"
582         if ref($_[0]);
583     my $prev = $^L;
584     $^L = $_[1] if @_ > 1;
585     $prev;
586 }
587
588 sub formline {
589     my $io = shift;
590     my $picture = shift;
591     local($^A) = $^A;
592     local($\) = "";
593     formline($picture, @_);
594     print $io $^A;
595 }
596
597 sub format_write {
598     @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
599     if (@_ == 2) {
600         my ($io, $fmt) = @_;
601         my $oldfmt = $io->format_name(qualify($fmt,caller));
602         CORE::write($io);
603         $io->format_name($oldfmt);
604     } else {
605         CORE::write($_[0]);
606     }
607 }
608
609 sub fcntl {
610     @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
611     my ($io, $op) = @_;
612     return fcntl($io, $op, $_[2]);
613 }
614
615 sub ioctl {
616     @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
617     my ($io, $op) = @_;
618     return ioctl($io, $op, $_[2]);
619 }
620
621 # this sub is for compatibility with older releases of IO that used
622 # a sub called constant to determine if a constant existed -- GMB
623 #
624 # The SEEK_* and _IO?BF constants were the only constants at that time
625 # any new code should just chech defined(&CONSTANT_NAME)
626
627 sub constant {
628     no strict 'refs';
629     my $name = shift;
630     (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
631         ? &{$name}() : undef;
632 }
633
634
635 # so that flush.pl can be deprecated
636
637 sub printflush {
638     my $io = shift;
639     my $old;
640     $old = new SelectSaver qualify($io, caller) if ref($io);
641     local $| = 1;
642     if(ref($io)) {
643         print $io @_;
644     }
645     else {
646         print @_;
647     }
648 }
649
650 1;