This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated to IO-1.12.
[perl5.git] / ext / IO / lib / IO / Handle.pm
CommitLineData
8add82fc
PP
1#
2
3package IO::Handle;
4
5=head1 NAME
6
7IO::Handle - supply object methods for filehandles
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
46C<IO::Handle::new> creates a C<IO::Handle>, which is a reference to a
47newly created symbol (see the C<Symbol> package). If it receives any
48parameters, they are passed to C<IO::Handle::open>; if the open fails,
49the C<IO::Handle> object is destroyed. Otherwise, it is returned to
50the caller.
51
52C<IO::Handle::new_from_fd> creates a C<IO::Handle> like C<new> does.
53It requires two parameters, which are passed to C<IO::Handle::fdopen>;
54if the fdopen fails, the C<IO::Handle> object is destroyed.
55Otherwise, it is returned to the caller.
56
57C<IO::Handle::open> accepts one parameter or two. With one parameter,
58it is just a front end for the built-in C<open> function. With two
59parameters, the first parameter is a filename that may include
60whitespace or other special characters, and the second parameter is
61the open mode in either Perl form (">", "+<", etc.) or POSIX form
62("w", "r+", etc.).
63
64C<IO::Handle::fdopen> is like C<open> except that its first parameter
65is not a filename but rather a file handle name, a IO::Handle object,
66or a file descriptor number.
67
68C<IO::Handle::write> is like C<write> found in C, that is it is the
69opposite of read. The wrapper for the perl C<write> function is
70called C<format_write>.
71
72C<IO::Handle::opened> returns true if the object is currently a valid
73file descriptor.
74
75If the C functions fgetpos() and fsetpos() are available, then
76C<IO::Handle::getpos> returns an opaque value that represents the
77current position of the IO::Handle, and C<IO::Handle::setpos> uses
78that value to return to a previously visited position.
79
80If the C function setvbuf() is available, then C<IO::Handle::setvbuf>
81sets the buffering policy for the IO::Handle. The calling sequence
82for the Perl function is the same as its C counterpart, including the
83macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
84parameter specifies a scalar variable to use as a buffer. WARNING: A
85variable used as a buffer by C<IO::Handle::setvbuf> must not be
86modified in any way until the IO::Handle is closed or until
87C<IO::Handle::setvbuf> is called again, or memory corruption may
88result!
89
90See L<perlfunc> for complete descriptions of each of the following
91supported C<IO::Handle> methods, which are just front ends for the
92corresponding built-in functions:
93
94 close
95 fileno
96 getc
97 gets
98 eof
99 read
100 truncate
101 stat
102
103See L<perlvar> for complete descriptions of each of the following
104supported C<IO::Handle> methods:
105
106 autoflush
107 output_field_separator
108 output_record_separator
109 input_record_separator
110 input_line_number
111 format_page_number
112 format_lines_per_page
113 format_lines_left
114 format_name
115 format_top_name
116 format_line_break_characters
117 format_formfeed
118 format_write
119
120Furthermore, for doing normal I/O you might need these:
121
122=over
123
124=item $fh->print
125
126See L<perlfunc/print>.
127
128=item $fh->printf
129
130See L<perlfunc/printf>.
131
132=item $fh->getline
133
134This works like <$fh> described in L<perlop/"I/O Operators">
135except that it's more readable and can be safely called in an
136array context but still returns just one line.
137
138=item $fh->getlines
139
140This works like <$fh> when called in an array context to
141read all the remaining lines in a file, except that it's more readable.
142It will also croak() if accidentally called in a scalar context.
143
144=back
145
146=head1
147
148The reference returned from new is a GLOB reference. Some modules that
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
170Derived from FileHandle.pm by Graham Barr <bodg@tiuk.ti.com>
171
172=cut
173
174require 5.000;
175use vars qw($VERSION @EXPORT_OK $AUTOLOAD);
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
188
760ac839 189$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\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 {
249 @_ == 1 or croak 'usage: new IO::Handle';
250 my $class = ref($_[0]) || $_[0];
251 my $fh = gensym;
252 bless $fh, $class;
253}
254
255sub new_from_fd {
256 @_ == 3 or croak 'usage: new_from_fd IO::Handle FD, MODE';
257 my $class = shift;
258 my $fh = gensym;
259 IO::Handle::fdopen($fh, @_)
260 or return undef;
261 bless $fh, $class;
8add82fc
PP
262}
263
264# FileHandle::DESTROY use to call close(). This creates a problem
265# if 2 Handle objects have the same fd. sv_clear will call io close
266# when the refcount in the xpvio becomes zero.
267#
268# It is defined as empty to stop AUTOLOAD being called :-)
269
270sub DESTROY { }
271
272################################################
273## Open and close.
274##
275
276sub _open_mode_string {
277 my ($mode) = @_;
278 $mode =~ /^\+?(<|>>?)$/
279 or $mode =~ s/^r(\+?)$/$1</
280 or $mode =~ s/^w(\+?)$/$1>/
281 or $mode =~ s/^a(\+?)$/$1>>/
282 or croak "IO::Handle: bad open mode: $mode";
283 $mode;
284}
285
286sub fdopen {
287 @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
288 my ($fh, $fd, $mode) = @_;
289 local(*GLOB);
290
291 if (ref($fd) && "".$fd =~ /GLOB\(/o) {
292 # It's a glob reference; Alias it as we cannot get name of anon GLOBs
293 my $n = qualify(*GLOB);
294 *GLOB = *{*$fd};
295 $fd = $n;
296 } elsif ($fd =~ m#^\d+$#) {
297 # It's an FD number; prefix with "=".
298 $fd = "=$fd";
299 }
300
301 open($fh, _open_mode_string($mode) . '&' . $fd)
302 ? $fh : undef;
303}
304
305sub close {
306 @_ == 1 or croak 'usage: $fh->close()';
307 my($fh) = @_;
308 my $r = close($fh);
309
310 # This may seem as though it should be in IO::Pipe, but the
311 # object gets blessed out of IO::Pipe when reader/writer is called
312 waitpid(${*$fh}{'io_pipe_pid'},0)
313 if(defined ${*$fh}{'io_pipe_pid'});
314
315 $r;
316}
317
318################################################
319## Normal I/O functions.
320##
321
322# fcntl
323# flock
324# ioctl
325# select
326# sysread
327# syswrite
328
329sub opened {
330 @_ == 1 or croak 'usage: $fh->opened()';
331 defined fileno($_[0]);
332}
333
334sub fileno {
335 @_ == 1 or croak 'usage: $fh->fileno()';
336 fileno($_[0]);
337}
338
339sub getc {
340 @_ == 1 or croak 'usage: $fh->getc()';
341 getc($_[0]);
342}
343
344sub gets {
345 @_ == 1 or croak 'usage: $fh->gets()';
346 my ($handle) = @_;
347 scalar <$handle>;
348}
349
350sub eof {
351 @_ == 1 or croak 'usage: $fh->eof()';
352 eof($_[0]);
353}
354
355sub print {
356 @_ or croak 'usage: $fh->print([ARGS])';
357 my $this = shift;
358 print $this @_;
359}
360
361sub printf {
362 @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
363 my $this = shift;
364 printf $this @_;
365}
366
367sub getline {
368 @_ == 1 or croak 'usage: $fh->getline';
369 my $this = shift;
370 return scalar <$this>;
371}
372
373sub getlines {
374 @_ == 1 or croak 'usage: $fh->getline()';
375 my $this = shift;
376 wantarray or
377 croak "Can't call IO::Handle::getlines in a scalar context, use IO::Handle::getline";
378 return <$this>;
379}
380
381sub truncate {
382 @_ == 2 or croak 'usage: $fh->truncate(LEN)';
383 truncate($_[0], $_[1]);
384}
385
386sub read {
387 @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
388 read($_[0], $_[1], $_[2], $_[3] || 0);
389}
390
391sub write {
392 @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
393 local($\) = "";
394 print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
395}
396
397sub stat {
398 @_ == 1 or croak 'usage: $fh->stat()';
399 stat($_[0]);
400}
401
402################################################
403## State modification functions.
404##
405
406sub autoflush {
407 my $old = new SelectSaver qualify($_[0], caller);
408 my $prev = $|;
409 $| = @_ > 1 ? $_[1] : 1;
410 $prev;
411}
412
413sub output_field_separator {
414 my $old = new SelectSaver qualify($_[0], caller);
415 my $prev = $,;
416 $, = $_[1] if @_ > 1;
417 $prev;
418}
419
420sub output_record_separator {
421 my $old = new SelectSaver qualify($_[0], caller);
422 my $prev = $\;
423 $\ = $_[1] if @_ > 1;
424 $prev;
425}
426
427sub input_record_separator {
428 my $old = new SelectSaver qualify($_[0], caller);
429 my $prev = $/;
430 $/ = $_[1] if @_ > 1;
431 $prev;
432}
433
434sub input_line_number {
435 my $old = new SelectSaver qualify($_[0], caller);
436 my $prev = $.;
437 $. = $_[1] if @_ > 1;
438 $prev;
439}
440
441sub format_page_number {
442 my $old = new SelectSaver qualify($_[0], caller);
443 my $prev = $%;
444 $% = $_[1] if @_ > 1;
445 $prev;
446}
447
448sub format_lines_per_page {
449 my $old = new SelectSaver qualify($_[0], caller);
450 my $prev = $=;
451 $= = $_[1] if @_ > 1;
452 $prev;
453}
454
455sub format_lines_left {
456 my $old = new SelectSaver qualify($_[0], caller);
457 my $prev = $-;
458 $- = $_[1] if @_ > 1;
459 $prev;
460}
461
462sub format_name {
463 my $old = new SelectSaver qualify($_[0], caller);
464 my $prev = $~;
465 $~ = qualify($_[1], caller) if @_ > 1;
466 $prev;
467}
468
469sub format_top_name {
470 my $old = new SelectSaver qualify($_[0], caller);
471 my $prev = $^;
472 $^ = qualify($_[1], caller) if @_ > 1;
473 $prev;
474}
475
476sub format_line_break_characters {
477 my $old = new SelectSaver qualify($_[0], caller);
478 my $prev = $:;
479 $: = $_[1] if @_ > 1;
480 $prev;
481}
482
483sub format_formfeed {
484 my $old = new SelectSaver qualify($_[0], caller);
485 my $prev = $^L;
486 $^L = $_[1] if @_ > 1;
487 $prev;
488}
489
490sub formline {
491 my $fh = shift;
492 my $picture = shift;
493 local($^A) = $^A;
494 local($\) = "";
495 formline($picture, @_);
496 print $fh $^A;
497}
498
499sub 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
5121;