Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package IO::Handle; |
2 | ||
3 | =head1 NAME | |
4 | ||
5 | IO::Handle - supply object methods for I/O handles | |
6 | ||
7 | =head1 SYNOPSIS | |
8 | ||
9 | use IO::Handle; | |
10 | ||
11 | $io = new IO::Handle; | |
12 | if ($io->fdopen(fileno(STDIN),"r")) { | |
13 | print $io->getline; | |
14 | $io->close; | |
15 | } | |
16 | ||
17 | $io = new IO::Handle; | |
18 | if ($io->fdopen(fileno(STDOUT),"w")) { | |
19 | $io->print("Some text\n"); | |
20 | } | |
21 | ||
22 | # setvbuf is not available by default on Perls 5.8.0 and later. | |
23 | use IO::Handle '_IOLBF'; | |
24 | $io->setvbuf($buffer_var, _IOLBF, 1024); | |
25 | ||
26 | undef $io; # automatically closes the file if it's open | |
27 | ||
28 | autoflush STDOUT 1; | |
29 | ||
30 | =head1 DESCRIPTION | |
31 | ||
32 | C<IO::Handle> is the base class for all other IO handle classes. It is | |
33 | not intended that objects of C<IO::Handle> would be created directly, | |
34 | but instead C<IO::Handle> is inherited from by several other classes | |
35 | in the IO hierarchy. | |
36 | ||
37 | If you are reading this documentation, looking for a replacement for | |
38 | the C<FileHandle> package, then I suggest you read the documentation | |
39 | for C<IO::File> too. | |
40 | ||
41 | =head1 CONSTRUCTOR | |
42 | ||
43 | =over 4 | |
44 | ||
45 | =item new () | |
46 | ||
47 | Creates a new C<IO::Handle> object. | |
48 | ||
49 | =item new_from_fd ( FD, MODE ) | |
50 | ||
51 | Creates an C<IO::Handle> like C<new> does. | |
52 | It requires two parameters, which are passed to the method C<fdopen>; | |
53 | if the fdopen fails, the object is destroyed. Otherwise, it is returned | |
54 | to the caller. | |
55 | ||
56 | =back | |
57 | ||
58 | =head1 METHODS | |
59 | ||
60 | See L<perlfunc> for complete descriptions of each of the following | |
61 | supported C<IO::Handle> methods, which are just front ends for the | |
62 | corresponding built-in functions: | |
63 | ||
64 | $io->close | |
65 | $io->eof | |
66 | $io->fileno | |
67 | $io->format_write( [FORMAT_NAME] ) | |
68 | $io->getc | |
69 | $io->read ( BUF, LEN, [OFFSET] ) | |
70 | $io->print ( ARGS ) | |
71 | $io->printf ( FMT, [ARGS] ) | |
72 | $io->stat | |
73 | $io->sysread ( BUF, LEN, [OFFSET] ) | |
74 | $io->syswrite ( BUF, [LEN, [OFFSET]] ) | |
75 | $io->truncate ( LEN ) | |
76 | ||
77 | See L<perlvar> for complete descriptions of each of the following | |
78 | supported C<IO::Handle> methods. All of them return the previous | |
79 | value of the attribute and takes an optional single argument that when | |
80 | given will set the value. If no argument is given the previous value | |
81 | is unchanged (except for $io->autoflush will actually turn ON | |
82 | autoflush by default). | |
83 | ||
84 | $io->autoflush ( [BOOL] ) $| | |
85 | $io->format_page_number( [NUM] ) $% | |
86 | $io->format_lines_per_page( [NUM] ) $= | |
87 | $io->format_lines_left( [NUM] ) $- | |
88 | $io->format_name( [STR] ) $~ | |
89 | $io->format_top_name( [STR] ) $^ | |
90 | $io->input_line_number( [NUM]) $. | |
91 | ||
92 | The following methods are not supported on a per-filehandle basis. | |
93 | ||
94 | IO::Handle->format_line_break_characters( [STR] ) $: | |
95 | IO::Handle->format_formfeed( [STR]) $^L | |
96 | IO::Handle->output_field_separator( [STR] ) $, | |
97 | IO::Handle->output_record_separator( [STR] ) $\ | |
98 | ||
99 | IO::Handle->input_record_separator( [STR] ) $/ | |
100 | ||
101 | Furthermore, for doing normal I/O you might need these: | |
102 | ||
103 | =over 4 | |
104 | ||
105 | =item $io->fdopen ( FD, MODE ) | |
106 | ||
107 | C<fdopen> is like an ordinary C<open> except that its first parameter | |
108 | is not a filename but rather a file handle name, an IO::Handle object, | |
109 | or a file descriptor number. | |
110 | ||
111 | =item $io->opened | |
112 | ||
113 | Returns true if the object is currently a valid file descriptor, false | |
114 | otherwise. | |
115 | ||
116 | =item $io->getline | |
117 | ||
118 | This works like <$io> described in L<perlop/"I/O Operators"> | |
119 | except that it's more readable and can be safely called in a | |
120 | list context but still returns just one line. If used as the conditional | |
121 | +within a C<while> or C-style C<for> loop, however, you will need to | |
122 | +emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>. | |
123 | ||
124 | =item $io->getlines | |
125 | ||
126 | This works like <$io> when called in a list context to read all | |
127 | the remaining lines in a file, except that it's more readable. | |
128 | It will also croak() if accidentally called in a scalar context. | |
129 | ||
130 | =item $io->ungetc ( ORD ) | |
131 | ||
132 | Pushes a character with the given ordinal value back onto the given | |
133 | handle's input stream. Only one character of pushback per handle is | |
134 | guaranteed. | |
135 | ||
136 | =item $io->write ( BUF, LEN [, OFFSET ] ) | |
137 | ||
138 | This C<write> is like C<write> found in C, that is it is the | |
139 | opposite of read. The wrapper for the perl C<write> function is | |
140 | called C<format_write>. | |
141 | ||
142 | =item $io->error | |
143 | ||
144 | Returns a true value if the given handle has experienced any errors | |
145 | since it was opened or since the last call to C<clearerr>, or if the | |
146 | handle is invalid. It only returns false for a valid handle with no | |
147 | outstanding errors. | |
148 | ||
149 | =item $io->clearerr | |
150 | ||
151 | Clear the given handle's error indicator. Returns -1 if the handle is | |
152 | invalid, 0 otherwise. | |
153 | ||
154 | =item $io->sync | |
155 | ||
156 | C<sync> synchronizes a file's in-memory state with that on the | |
157 | physical medium. C<sync> does not operate at the perlio api level, but | |
158 | operates on the file descriptor (similar to sysread, sysseek and | |
159 | systell). This means that any data held at the perlio api level will not | |
160 | be synchronized. To synchronize data that is buffered at the perlio api | |
161 | level you must use the flush method. C<sync> is not implemented on all | |
162 | platforms. Returns "0 but true" on success, C<undef> on error, C<undef> | |
163 | for an invalid handle. See L<fsync(3c)>. | |
164 | ||
165 | =item $io->flush | |
166 | ||
167 | C<flush> causes perl to flush any buffered data at the perlio api level. | |
168 | Any unread data in the buffer will be discarded, and any unwritten data | |
169 | will be written to the underlying file descriptor. Returns "0 but true" | |
170 | on success, C<undef> on error. | |
171 | ||
172 | =item $io->printflush ( ARGS ) | |
173 | ||
174 | Turns on autoflush, print ARGS and then restores the autoflush status of the | |
175 | C<IO::Handle> object. Returns the return value from print. | |
176 | ||
177 | =item $io->blocking ( [ BOOL ] ) | |
178 | ||
179 | If called with an argument C<blocking> will turn on non-blocking IO if | |
180 | C<BOOL> is false, and turn it off if C<BOOL> is true. | |
181 | ||
182 | C<blocking> will return the value of the previous setting, or the | |
183 | current setting if C<BOOL> is not given. | |
184 | ||
185 | If an error occurs C<blocking> will return undef and C<$!> will be set. | |
186 | ||
187 | =back | |
188 | ||
189 | ||
190 | If the C functions setbuf() and/or setvbuf() are available, then | |
191 | C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering | |
192 | policy for an IO::Handle. The calling sequences for the Perl functions | |
193 | are the same as their C counterparts--including the constants C<_IOFBF>, | |
194 | C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter | |
195 | specifies a scalar variable to use as a buffer. You should only | |
196 | change the buffer before any I/O, or immediately after calling flush. | |
197 | ||
198 | WARNING: The IO::Handle::setvbuf() is not available by default on | |
199 | Perls 5.8.0 and later because setvbuf() is rather specific to using | |
200 | the stdio library, while Perl prefers the new perlio subsystem instead. | |
201 | ||
202 | WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not | |
203 | be modified> in any way until the IO::Handle is closed or C<setbuf> or | |
204 | C<setvbuf> is called again, or memory corruption may result! Remember that | |
205 | the order of global destruction is undefined, so even if your buffer | |
206 | variable remains in scope until program termination, it may be undefined | |
207 | before the file IO::Handle is closed. Note that you need to import the | |
208 | constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf | |
209 | returns nothing. setvbuf returns "0 but true", on success, C<undef> on | |
210 | failure. | |
211 | ||
212 | Lastly, there is a special method for working under B<-T> and setuid/gid | |
213 | scripts: | |
214 | ||
215 | =over 4 | |
216 | ||
217 | =item $io->untaint | |
218 | ||
219 | Marks the object as taint-clean, and as such data read from it will also | |
220 | be considered taint-clean. Note that this is a very trusting action to | |
221 | take, and appropriate consideration for the data source and potential | |
222 | vulnerability should be kept in mind. Returns 0 on success, -1 if setting | |
223 | the taint-clean flag failed. (eg invalid handle) | |
224 | ||
225 | =back | |
226 | ||
227 | =head1 NOTE | |
228 | ||
229 | An C<IO::Handle> object is a reference to a symbol/GLOB reference (see | |
230 | the C<Symbol> package). Some modules that | |
231 | inherit from C<IO::Handle> may want to keep object related variables | |
232 | in the hash table part of the GLOB. In an attempt to prevent modules | |
233 | trampling on each other I propose the that any such module should prefix | |
234 | its variables with its own name separated by _'s. For example the IO::Socket | |
235 | module keeps a C<timeout> variable in 'io_socket_timeout'. | |
236 | ||
237 | =head1 SEE ALSO | |
238 | ||
239 | L<perlfunc>, | |
240 | L<perlop/"I/O Operators">, | |
241 | L<IO::File> | |
242 | ||
243 | =head1 BUGS | |
244 | ||
245 | Due to backwards compatibility, all filehandles resemble objects | |
246 | of class C<IO::Handle>, or actually classes derived from that class. | |
247 | They actually aren't. Which means you can't derive your own | |
248 | class from C<IO::Handle> and inherit those methods. | |
249 | ||
250 | =head1 HISTORY | |
251 | ||
252 | Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt> | |
253 | ||
254 | =cut | |
255 | ||
256 | use 5.006_001; | |
257 | use strict; | |
258 | our($VERSION, @EXPORT_OK, @ISA); | |
259 | use Carp; | |
260 | use Symbol; | |
261 | use SelectSaver; | |
262 | use IO (); # Load the XS module | |
263 | ||
264 | require Exporter; | |
265 | @ISA = qw(Exporter); | |
266 | ||
267 | $VERSION = "1.25"; | |
268 | $VERSION = eval $VERSION; | |
269 | ||
270 | @EXPORT_OK = qw( | |
271 | autoflush | |
272 | output_field_separator | |
273 | output_record_separator | |
274 | input_record_separator | |
275 | input_line_number | |
276 | format_page_number | |
277 | format_lines_per_page | |
278 | format_lines_left | |
279 | format_name | |
280 | format_top_name | |
281 | format_line_break_characters | |
282 | format_formfeed | |
283 | format_write | |
284 | ||
285 | ||
286 | printf | |
287 | getline | |
288 | getlines | |
289 | ||
290 | printflush | |
291 | flush | |
292 | ||
293 | SEEK_SET | |
294 | SEEK_CUR | |
295 | SEEK_END | |
296 | _IOFBF | |
297 | _IOLBF | |
298 | _IONBF | |
299 | ); | |
300 | ||
301 | ################################################ | |
302 | ## Constructors, destructors. | |
303 | ## | |
304 | ||
305 | sub new { | |
306 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | |
307 | @_ == 1 or croak "usage: new $class"; | |
308 | my $io = gensym; | |
309 | bless $io, $class; | |
310 | } | |
311 | ||
312 | sub new_from_fd { | |
313 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | |
314 | @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; | |
315 | my $io = gensym; | |
316 | shift; | |
317 | IO::Handle::fdopen($io, @_) | |
318 | or return undef; | |
319 | bless $io, $class; | |
320 | } | |
321 | ||
322 | # | |
323 | # There is no need for DESTROY to do anything, because when the | |
324 | # last reference to an IO object is gone, Perl automatically | |
325 | # closes its associated files (if any). However, to avoid any | |
326 | # attempts to autoload DESTROY, we here define it to do nothing. | |
327 | # | |
328 | sub DESTROY {} | |
329 | ||
330 | ||
331 | ################################################ | |
332 | ## Open and close. | |
333 | ## | |
334 | ||
335 | sub _open_mode_string { | |
336 | my ($mode) = @_; | |
337 | $mode =~ /^\+?(<|>>?)$/ | |
338 | or $mode =~ s/^r(\+?)$/$1</ | |
339 | or $mode =~ s/^w(\+?)$/$1>/ | |
340 | or $mode =~ s/^a(\+?)$/$1>>/ | |
341 | or croak "IO::Handle: bad open mode: $mode"; | |
342 | $mode; | |
343 | } | |
344 | ||
345 | sub fdopen { | |
346 | @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; | |
347 | my ($io, $fd, $mode) = @_; | |
348 | local(*GLOB); | |
349 | ||
350 | if (ref($fd) && "".$fd =~ /GLOB\(/o) { | |
351 | # It's a glob reference; Alias it as we cannot get name of anon GLOBs | |
352 | my $n = qualify(*GLOB); | |
353 | *GLOB = *{*$fd}; | |
354 | $fd = $n; | |
355 | } elsif ($fd =~ m#^\d+$#) { | |
356 | # It's an FD number; prefix with "=". | |
357 | $fd = "=$fd"; | |
358 | } | |
359 | ||
360 | open($io, _open_mode_string($mode) . '&' . $fd) | |
361 | ? $io : undef; | |
362 | } | |
363 | ||
364 | sub close { | |
365 | @_ == 1 or croak 'usage: $io->close()'; | |
366 | my($io) = @_; | |
367 | ||
368 | close($io); | |
369 | } | |
370 | ||
371 | ################################################ | |
372 | ## Normal I/O functions. | |
373 | ## | |
374 | ||
375 | # flock | |
376 | # select | |
377 | ||
378 | sub opened { | |
379 | @_ == 1 or croak 'usage: $io->opened()'; | |
380 | defined fileno($_[0]); | |
381 | } | |
382 | ||
383 | sub fileno { | |
384 | @_ == 1 or croak 'usage: $io->fileno()'; | |
385 | fileno($_[0]); | |
386 | } | |
387 | ||
388 | sub getc { | |
389 | @_ == 1 or croak 'usage: $io->getc()'; | |
390 | getc($_[0]); | |
391 | } | |
392 | ||
393 | sub eof { | |
394 | @_ == 1 or croak 'usage: $io->eof()'; | |
395 | eof($_[0]); | |
396 | } | |
397 | ||
398 | sub print { | |
399 | @_ or croak 'usage: $io->print(ARGS)'; | |
400 | my $this = shift; | |
401 | print $this @_; | |
402 | } | |
403 | ||
404 | sub printf { | |
405 | @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; | |
406 | my $this = shift; | |
407 | printf $this @_; | |
408 | } | |
409 | ||
410 | sub getline { | |
411 | @_ == 1 or croak 'usage: $io->getline()'; | |
412 | my $this = shift; | |
413 | return scalar <$this>; | |
414 | } | |
415 | ||
416 | *gets = \&getline; # deprecated | |
417 | ||
418 | sub getlines { | |
419 | @_ == 1 or croak 'usage: $io->getlines()'; | |
420 | wantarray or | |
421 | croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; | |
422 | my $this = shift; | |
423 | return <$this>; | |
424 | } | |
425 | ||
426 | sub truncate { | |
427 | @_ == 2 or croak 'usage: $io->truncate(LEN)'; | |
428 | truncate($_[0], $_[1]); | |
429 | } | |
430 | ||
431 | sub read { | |
432 | @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; | |
433 | read($_[0], $_[1], $_[2], $_[3] || 0); | |
434 | } | |
435 | ||
436 | sub sysread { | |
437 | @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; | |
438 | sysread($_[0], $_[1], $_[2], $_[3] || 0); | |
439 | } | |
440 | ||
441 | sub write { | |
442 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; | |
443 | local($\) = ""; | |
444 | $_[2] = length($_[1]) unless defined $_[2]; | |
445 | print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); | |
446 | } | |
447 | ||
448 | sub syswrite { | |
449 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; | |
450 | if (defined($_[2])) { | |
451 | syswrite($_[0], $_[1], $_[2], $_[3] || 0); | |
452 | } else { | |
453 | syswrite($_[0], $_[1]); | |
454 | } | |
455 | } | |
456 | ||
457 | sub stat { | |
458 | @_ == 1 or croak 'usage: $io->stat()'; | |
459 | stat($_[0]); | |
460 | } | |
461 | ||
462 | ################################################ | |
463 | ## State modification functions. | |
464 | ## | |
465 | ||
466 | sub autoflush { | |
467 | my $old = new SelectSaver qualify($_[0], caller); | |
468 | my $prev = $|; | |
469 | $| = @_ > 1 ? $_[1] : 1; | |
470 | $prev; | |
471 | } | |
472 | ||
473 | sub output_field_separator { | |
474 | carp "output_field_separator is not supported on a per-handle basis" | |
475 | if ref($_[0]); | |
476 | my $prev = $,; | |
477 | $, = $_[1] if @_ > 1; | |
478 | $prev; | |
479 | } | |
480 | ||
481 | sub output_record_separator { | |
482 | carp "output_record_separator is not supported on a per-handle basis" | |
483 | if ref($_[0]); | |
484 | my $prev = $\; | |
485 | $\ = $_[1] if @_ > 1; | |
486 | $prev; | |
487 | } | |
488 | ||
489 | sub input_record_separator { | |
490 | carp "input_record_separator is not supported on a per-handle basis" | |
491 | if ref($_[0]); | |
492 | my $prev = $/; | |
493 | $/ = $_[1] if @_ > 1; | |
494 | $prev; | |
495 | } | |
496 | ||
497 | sub input_line_number { | |
498 | local $.; | |
499 | () = tell qualify($_[0], caller) if ref($_[0]); | |
500 | my $prev = $.; | |
501 | $. = $_[1] if @_ > 1; | |
502 | $prev; | |
503 | } | |
504 | ||
505 | sub format_page_number { | |
506 | my $old; | |
507 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | |
508 | my $prev = $%; | |
509 | $% = $_[1] if @_ > 1; | |
510 | $prev; | |
511 | } | |
512 | ||
513 | sub format_lines_per_page { | |
514 | my $old; | |
515 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | |
516 | my $prev = $=; | |
517 | $= = $_[1] if @_ > 1; | |
518 | $prev; | |
519 | } | |
520 | ||
521 | sub format_lines_left { | |
522 | my $old; | |
523 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | |
524 | my $prev = $-; | |
525 | $- = $_[1] if @_ > 1; | |
526 | $prev; | |
527 | } | |
528 | ||
529 | sub format_name { | |
530 | my $old; | |
531 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | |
532 | my $prev = $~; | |
533 | $~ = qualify($_[1], caller) if @_ > 1; | |
534 | $prev; | |
535 | } | |
536 | ||
537 | sub format_top_name { | |
538 | my $old; | |
539 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | |
540 | my $prev = $^; | |
541 | $^ = qualify($_[1], caller) if @_ > 1; | |
542 | $prev; | |
543 | } | |
544 | ||
545 | sub format_line_break_characters { | |
546 | carp "format_line_break_characters is not supported on a per-handle basis" | |
547 | if ref($_[0]); | |
548 | my $prev = $:; | |
549 | $: = $_[1] if @_ > 1; | |
550 | $prev; | |
551 | } | |
552 | ||
553 | sub format_formfeed { | |
554 | carp "format_formfeed is not supported on a per-handle basis" | |
555 | if ref($_[0]); | |
556 | my $prev = $^L; | |
557 | $^L = $_[1] if @_ > 1; | |
558 | $prev; | |
559 | } | |
560 | ||
561 | sub formline { | |
562 | my $io = shift; | |
563 | my $picture = shift; | |
564 | local($^A) = $^A; | |
565 | local($\) = ""; | |
566 | formline($picture, @_); | |
567 | print $io $^A; | |
568 | } | |
569 | ||
570 | sub format_write { | |
571 | @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; | |
572 | if (@_ == 2) { | |
573 | my ($io, $fmt) = @_; | |
574 | my $oldfmt = $io->format_name($fmt); | |
575 | CORE::write($io); | |
576 | $io->format_name($oldfmt); | |
577 | } else { | |
578 | CORE::write($_[0]); | |
579 | } | |
580 | } | |
581 | ||
582 | # XXX undocumented | |
583 | sub fcntl { | |
584 | @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; | |
585 | my ($io, $op) = @_; | |
586 | return fcntl($io, $op, $_[2]); | |
587 | } | |
588 | ||
589 | # XXX undocumented | |
590 | sub ioctl { | |
591 | @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; | |
592 | my ($io, $op) = @_; | |
593 | return ioctl($io, $op, $_[2]); | |
594 | } | |
595 | ||
596 | # this sub is for compatability with older releases of IO that used | |
597 | # a sub called constant to detemine if a constant existed -- GMB | |
598 | # | |
599 | # The SEEK_* and _IO?BF constants were the only constants at that time | |
600 | # any new code should just chech defined(&CONSTANT_NAME) | |
601 | ||
602 | sub constant { | |
603 | no strict 'refs'; | |
604 | my $name = shift; | |
605 | (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) | |
606 | ? &{$name}() : undef; | |
607 | } | |
608 | ||
609 | ||
610 | # so that flush.pl can be deprecated | |
611 | ||
612 | sub printflush { | |
613 | my $io = shift; | |
614 | my $old; | |
615 | $old = new SelectSaver qualify($io, caller) if ref($io); | |
616 | local $| = 1; | |
617 | if(ref($io)) { | |
618 | print $io @_; | |
619 | } | |
620 | else { | |
621 | print @_; | |
622 | } | |
623 | } | |
624 | ||
625 | 1; |