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