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