perl5.002beta3
[perl.git] / lib / FileHandle.pm
1 package FileHandle;
2
3 =head1 NAME
4
5 FileHandle - supply object methods for filehandles
6
7 =head1 SYNOPSIS
8
9     use FileHandle;
10
11     $fh = new FileHandle;
12     if ($fh->open "< file") {
13         print <$fh>;
14         $fh->close;
15     }
16
17     $fh = new FileHandle "> FOO";
18     if (defined $fh) {
19         print $fh "bar\n";
20         $fh->close;
21     }
22
23     $fh = new FileHandle "file", "r";
24     if (defined $fh) {
25         print <$fh>;
26         undef $fh;       # automatically closes the file
27     }
28
29     $fh = new FileHandle "file", O_WRONLY|O_APPEND;
30     if (defined $fh) {
31         print $fh "corge\n";
32         undef $fh;       # automatically closes the file
33     }
34
35     ($readfh, $writefh) = FileHandle::pipe;
36
37     autoflush STDOUT 1;
38   
39 =head1 DESCRIPTION
40
41 C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
42 newly created symbol (see the C<Symbol> package).  If it receives any
43 parameters, they are passed to C<FileHandle::open>; if the open fails,
44 the C<FileHandle> object is destroyed.  Otherwise, it is returned to
45 the caller.
46
47 C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
48 It requires two parameters, which are passed to C<FileHandle::fdopen>;
49 if the fdopen fails, the C<FileHandle> object is destroyed.
50 Otherwise, it is returned to the caller.
51
52 C<FileHandle::open> accepts one parameter or two.  With one parameter,
53 it is just a front end for the built-in C<open> function.  With two
54 parameters, the first parameter is a filename that may include
55 whitespace or other special characters, and the second parameter is
56 the open mode in either Perl form (">", "+<", etc.) or POSIX form
57 ("w", "r+", etc.).
58
59 C<FileHandle::fdopen> is like C<open> except that its first parameter
60 is not a filename but rather a file handle name, a FileHandle object,
61 or a file descriptor number.
62
63 See L<perlfunc> for complete descriptions of each of the following
64 supported C<FileHandle> methods, which are just front ends for the
65 corresponding built-in functions:
66   
67     close
68     fileno
69     getc
70     gets
71     eof
72     clearerr
73     seek
74     tell
75
76 See L<perlvar> for complete descriptions of each of the following
77 supported C<FileHandle> methods:
78
79     autoflush
80     output_field_separator
81     output_record_separator
82     input_record_separator
83     input_line_number
84     format_page_number
85     format_lines_per_page
86     format_lines_left
87     format_name
88     format_top_name
89     format_line_break_characters
90     format_formfeed
91
92 Furthermore, for doing normal I/O you might need these:
93
94 =over 
95
96 =item $fh->print
97
98 See L<perlfunc/print>.
99
100 =item $fh->printf
101
102 See L<perlfunc/printf>.
103
104 =item $fh->getline
105
106 This works like <$fh> described in L<perlop/"I/O Operators">
107 except that it's more readable and can be safely called in an
108 array context but still returns just one line.
109
110 =item $fh->getlines
111
112 This works like <$fh> when called in an array context to
113 read all the remaining lines in a file, except that it's more readable.
114 It will also croak() if accidentally called in a scalar context.
115
116 =back
117
118 =head1 SEE ALSO
119
120 L<perlfunc>, 
121 L<perlop/"I/O Operators">,
122 L<POSIX/"FileHandle">
123
124 =head1 BUGS
125
126 Due to backwards compatibility, all filehandles resemble objects
127 of class C<FileHandle>, or actually classes derived from that class.
128 They actually aren't.  Which means you can't derive your own 
129 class from C<FileHandle> and inherit those methods.
130
131 =cut
132
133 require 5.000;
134 use Carp;
135 use Fcntl;
136 use Symbol;
137 use English;
138 use SelectSaver;
139
140 require Exporter;
141 require DynaLoader;
142 @ISA = qw(Exporter DynaLoader);
143
144 @EXPORT = (@Fcntl::EXPORT,
145            qw(_IOFBF _IOLBF _IONBF));
146
147 @EXPORT_OK = qw(
148     autoflush
149     output_field_separator
150     output_record_separator
151     input_record_separator
152     input_line_number
153     format_page_number
154     format_lines_per_page
155     format_lines_left
156     format_name
157     format_top_name
158     format_line_break_characters
159     format_formfeed
160
161     print
162     printf
163     getline
164     getlines
165 );
166
167
168 ################################################
169 ## Interaction with the XS.
170 ##
171
172 bootstrap FileHandle;
173
174 sub AUTOLOAD {
175     if ($AUTOLOAD =~ /::(_?[a-z])/) {
176         $AutoLoader::AUTOLOAD = $AUTOLOAD;
177         goto &AutoLoader::AUTOLOAD
178     }
179     my $constname = $AUTOLOAD;
180     $constname =~ s/.*:://;
181     my $val = constant($constname);
182     defined $val or croak "$constname is not a valid FileHandle macro";
183     *$AUTOLOAD = sub { $val };
184     goto &$AUTOLOAD;
185 }
186
187
188 ################################################
189 ## Constructors, destructors.
190 ##
191
192 sub new {
193     @_ >= 1 && @_ <= 3 or croak 'usage: new FileHandle [FILENAME [,MODE]]';
194     my $class = shift;
195     my $fh = gensym;
196     if (@_) {
197         FileHandle::open($fh, @_)
198             or return undef;
199     }
200     bless $fh, $class;
201 }
202
203 sub new_from_fd {
204     @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE';
205     my $class = shift;
206     my $fh = gensym;
207     FileHandle::fdopen($fh, @_)
208         or return undef;
209     bless $fh, $class;
210 }
211
212 sub DESTROY {
213     my ($fh) = @_;
214     close($fh);
215 }
216
217 ################################################
218 ## Open and close.
219 ##
220
221 sub pipe {
222     @_ and croak 'usage: FileHandle::pipe()';
223     my $readfh = new FileHandle;
224     my $writefh = new FileHandle;
225     pipe($readfh, $writefh)
226         or return undef;
227     ($readfh, $writefh);
228 }
229
230 sub _open_mode_string {
231     my ($mode) = @_;
232     $mode =~ /^\+?(<|>>?)$/
233       or $mode =~ s/^r(\+?)$/$1</
234       or $mode =~ s/^w(\+?)$/$1>/
235       or $mode =~ s/^a(\+?)$/$1>>/
236       or croak "FileHandle: bad open mode: $mode";
237     $mode;
238 }
239
240 sub open {
241     @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
242     my ($fh, $file) = @_;
243     if (@_ > 2) {
244         my ($mode, $perms) = @_[2, 3];
245         if ($mode =~ /^\d+$/) {
246             defined $perms or $perms = 0666;
247             return sysopen($fh, $file, $mode, $perms);
248         }
249         $file = "./" . $file unless $file =~ m#^/#;
250         $file = _open_mode_string($mode) . " $file\0";
251     }
252     open($fh, $file);
253 }
254
255 sub fdopen {
256     @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
257     my ($fh, $fd, $mode) = @_;
258     if (ref($fd) =~ /GLOB\(/) {
259         # It's a glob reference; remove the star from its name.
260         ($fd = "".$$fd) =~ s/^\*//;
261     } elsif ($fd =~ m#^\d+$#) {
262         # It's an FD number; prefix with "=".
263         $fd = "=$fd";
264     }
265     open($fh, _open_mode_string($mode) . '&' . $fd);
266 }
267
268 sub close {
269     @_ == 1 or croak 'usage: $fh->close()';
270     close($_[0]);
271 }
272
273 ################################################
274 ## Normal I/O functions.
275 ##
276
277 sub fileno {
278     @_ == 1 or croak 'usage: $fh->fileno()';
279     fileno($_[0]);
280 }
281
282 sub getc {
283     @_ == 1 or croak 'usage: $fh->getc()';
284     getc($_[0]);
285 }
286
287 sub gets {
288     @_ == 1 or croak 'usage: $fh->gets()';
289     my ($handle) = @_;
290     scalar <$handle>;
291 }
292
293 sub eof {
294     @_ == 1 or croak 'usage: $fh->eof()';
295     eof($_[0]);
296 }
297
298 sub clearerr {
299     @_ == 1 or croak 'usage: $fh->clearerr()';
300     seek($_[0], 0, 1);
301 }
302
303 sub seek {
304     @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)';
305     seek($_[0], $_[1], $_[2]);
306 }
307
308 sub tell {
309     @_ == 1 or croak 'usage: $fh->tell()';
310     tell($_[0]);
311 }
312
313 sub print {
314     @_ or croak 'usage: $fh->print([ARGS])';
315     my $this = shift;
316     print $this @_;
317 }
318
319 sub printf {
320     @_ or croak 'usage: $fh->printf([ARGS])';
321     my $this = shift;
322     printf $this @_;
323 }
324
325 sub getline {
326     @_ == 1 or croak 'usage: $fh->getline';
327     my $this = shift;
328     return scalar <$this>;
329
330
331 sub getlines {
332     @_ == 1 or croak 'usage: $fh->getline()';
333     my $this = shift;
334     wantarray or croak "Can't call FileHandle::getlines in a scalar context";
335     return <$this>;
336 }
337
338 ################################################
339 ## State modification functions.
340 ##
341
342 sub autoflush {
343     my $old = new SelectSaver qualify($_[0], caller);
344     my $prev = $OUTPUT_AUTOFLUSH;
345     $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1;
346     $prev;
347 }
348
349 sub output_field_separator {
350     my $old = new SelectSaver qualify($_[0], caller);
351     my $prev = $OUTPUT_FIELD_SEPARATOR;
352     $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1;
353     $prev;
354 }
355
356 sub output_record_separator {
357     my $old = new SelectSaver qualify($_[0], caller);
358     my $prev = $OUTPUT_RECORD_SEPARATOR;
359     $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
360     $prev;
361 }
362
363 sub input_record_separator {
364     my $old = new SelectSaver qualify($_[0], caller);
365     my $prev = $INPUT_RECORD_SEPARATOR;
366     $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
367     $prev;
368 }
369
370 sub input_line_number {
371     my $old = new SelectSaver qualify($_[0], caller);
372     my $prev = $INPUT_LINE_NUMBER;
373     $INPUT_LINE_NUMBER = $_[1] if @_ > 1;
374     $prev;
375 }
376
377 sub format_page_number {
378     my $old = new SelectSaver qualify($_[0], caller);
379     my $prev = $FORMAT_PAGE_NUMBER;
380     $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1;
381     $prev;
382 }
383
384 sub format_lines_per_page {
385     my $old = new SelectSaver qualify($_[0], caller);
386     my $prev = $FORMAT_LINES_PER_PAGE;
387     $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1;
388     $prev;
389 }
390
391 sub format_lines_left {
392     my $old = new SelectSaver qualify($_[0], caller);
393     my $prev = $FORMAT_LINES_LEFT;
394     $FORMAT_LINES_LEFT = $_[1] if @_ > 1;
395     $prev;
396 }
397
398 sub format_name {
399     my $old = new SelectSaver qualify($_[0], caller);
400     my $prev = $FORMAT_NAME;
401     $FORMAT_NAME = qualify($_[1], caller) if @_ > 1;
402     $prev;
403 }
404
405 sub format_top_name {
406     my $old = new SelectSaver qualify($_[0], caller);
407     my $prev = $FORMAT_TOP_NAME;
408     $FORMAT_TOP_NAME = qualify($_[1], caller) if @_ > 1;
409     $prev;
410 }
411
412 sub format_line_break_characters {
413     my $old = new SelectSaver qualify($_[0], caller);
414     my $prev = $FORMAT_LINE_BREAK_CHARACTERS;
415     $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1;
416     $prev;
417 }
418
419 sub format_formfeed {
420     my $old = new SelectSaver qualify($_[0], caller);
421     my $prev = $FORMAT_FORMFEED;
422     $FORMAT_FORMFEED = $_[1] if @_ > 1;
423     $prev;
424 }
425
426 1;