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