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