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 |
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 |
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 |
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 |
88 | print |
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 |
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 |
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 | |
71be2cbc |
183 | Version 1.1201 specialized from 1.12 for inclusion in Perl distribution |
184 | |
8add82fc |
185 | =cut |
186 | |
187 | require 5.000; |
27d4819a |
188 | use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD); |
8add82fc |
189 | use Carp; |
190 | use Symbol; |
191 | use SelectSaver; |
192 | |
193 | require Exporter; |
194 | @ISA = qw(Exporter); |
195 | |
71be2cbc |
196 | $VERSION = "1.1201"; |
27d4819a |
197 | $RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/); |
8add82fc |
198 | |
199 | @EXPORT_OK = qw( |
200 | autoflush |
201 | output_field_separator |
202 | output_record_separator |
203 | input_record_separator |
204 | input_line_number |
205 | format_page_number |
206 | format_lines_per_page |
207 | format_lines_left |
208 | format_name |
209 | format_top_name |
210 | format_line_break_characters |
211 | format_formfeed |
212 | format_write |
213 | |
214 | print |
215 | printf |
216 | getline |
217 | getlines |
218 | |
219 | SEEK_SET |
220 | SEEK_CUR |
221 | SEEK_END |
222 | _IOFBF |
223 | _IOLBF |
224 | _IONBF |
225 | |
226 | _open_mode_string |
227 | ); |
228 | |
229 | |
230 | ################################################ |
231 | ## Interaction with the XS. |
232 | ## |
233 | |
234 | require DynaLoader; |
235 | @IO::ISA = qw(DynaLoader); |
236 | bootstrap IO $VERSION; |
237 | |
238 | sub AUTOLOAD { |
239 | if ($AUTOLOAD =~ /::(_?[a-z])/) { |
240 | $AutoLoader::AUTOLOAD = $AUTOLOAD; |
241 | goto &AutoLoader::AUTOLOAD |
242 | } |
243 | my $constname = $AUTOLOAD; |
244 | $constname =~ s/.*:://; |
245 | my $val = constant($constname); |
246 | defined $val or croak "$constname is not a valid IO::Handle macro"; |
247 | *$AUTOLOAD = sub { $val }; |
248 | goto &$AUTOLOAD; |
249 | } |
250 | |
251 | |
252 | ################################################ |
253 | ## Constructors, destructors. |
254 | ## |
255 | |
256 | sub new { |
27d4819a |
257 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; |
258 | @_ == 1 or croak "usage: new $class"; |
8add82fc |
259 | my $fh = gensym; |
260 | bless $fh, $class; |
261 | } |
262 | |
263 | sub new_from_fd { |
27d4819a |
264 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; |
265 | @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; |
8add82fc |
266 | my $fh = gensym; |
c927212d |
267 | shift; |
8add82fc |
268 | IO::Handle::fdopen($fh, @_) |
269 | or return undef; |
270 | bless $fh, $class; |
8add82fc |
271 | } |
272 | |
c927212d |
273 | # |
274 | # That an IO::Handle is being destroyed does not necessarily mean |
275 | # that the associated filehandle should be closed. This is because |
276 | # *FOO{FILEHANDLE} may by a synonym for *BAR{FILEHANDLE}. |
277 | # |
278 | # If this IO::Handle really does have the final reference to the |
279 | # given FILEHANDLE, then Perl will close it for us automatically. |
280 | # |
8add82fc |
281 | |
c927212d |
282 | sub DESTROY { |
27d4819a |
283 | } |
8add82fc |
284 | |
285 | ################################################ |
286 | ## Open and close. |
287 | ## |
288 | |
289 | sub _open_mode_string { |
290 | my ($mode) = @_; |
291 | $mode =~ /^\+?(<|>>?)$/ |
292 | or $mode =~ s/^r(\+?)$/$1</ |
293 | or $mode =~ s/^w(\+?)$/$1>/ |
294 | or $mode =~ s/^a(\+?)$/$1>>/ |
295 | or croak "IO::Handle: bad open mode: $mode"; |
296 | $mode; |
297 | } |
298 | |
299 | sub fdopen { |
300 | @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)'; |
301 | my ($fh, $fd, $mode) = @_; |
302 | local(*GLOB); |
303 | |
304 | if (ref($fd) && "".$fd =~ /GLOB\(/o) { |
305 | # It's a glob reference; Alias it as we cannot get name of anon GLOBs |
306 | my $n = qualify(*GLOB); |
307 | *GLOB = *{*$fd}; |
308 | $fd = $n; |
309 | } elsif ($fd =~ m#^\d+$#) { |
310 | # It's an FD number; prefix with "=". |
311 | $fd = "=$fd"; |
312 | } |
313 | |
314 | open($fh, _open_mode_string($mode) . '&' . $fd) |
315 | ? $fh : undef; |
316 | } |
317 | |
318 | sub close { |
319 | @_ == 1 or croak 'usage: $fh->close()'; |
320 | my($fh) = @_; |
321 | my $r = close($fh); |
322 | |
323 | # This may seem as though it should be in IO::Pipe, but the |
324 | # object gets blessed out of IO::Pipe when reader/writer is called |
325 | waitpid(${*$fh}{'io_pipe_pid'},0) |
326 | if(defined ${*$fh}{'io_pipe_pid'}); |
327 | |
328 | $r; |
329 | } |
330 | |
331 | ################################################ |
332 | ## Normal I/O functions. |
333 | ## |
334 | |
8add82fc |
335 | # flock |
8add82fc |
336 | # select |
8add82fc |
337 | |
338 | sub opened { |
339 | @_ == 1 or croak 'usage: $fh->opened()'; |
340 | defined fileno($_[0]); |
341 | } |
342 | |
343 | sub fileno { |
344 | @_ == 1 or croak 'usage: $fh->fileno()'; |
345 | fileno($_[0]); |
346 | } |
347 | |
348 | sub getc { |
349 | @_ == 1 or croak 'usage: $fh->getc()'; |
350 | getc($_[0]); |
351 | } |
352 | |
353 | sub gets { |
354 | @_ == 1 or croak 'usage: $fh->gets()'; |
355 | my ($handle) = @_; |
356 | scalar <$handle>; |
357 | } |
358 | |
359 | sub eof { |
360 | @_ == 1 or croak 'usage: $fh->eof()'; |
361 | eof($_[0]); |
362 | } |
363 | |
364 | sub print { |
365 | @_ or croak 'usage: $fh->print([ARGS])'; |
366 | my $this = shift; |
367 | print $this @_; |
368 | } |
369 | |
370 | sub printf { |
371 | @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])'; |
372 | my $this = shift; |
373 | printf $this @_; |
374 | } |
375 | |
376 | sub getline { |
377 | @_ == 1 or croak 'usage: $fh->getline'; |
378 | my $this = shift; |
379 | return scalar <$this>; |
380 | } |
381 | |
382 | sub getlines { |
383 | @_ == 1 or croak 'usage: $fh->getline()'; |
8add82fc |
384 | wantarray or |
27d4819a |
385 | croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline'; |
386 | my $this = shift; |
8add82fc |
387 | return <$this>; |
388 | } |
389 | |
390 | sub truncate { |
391 | @_ == 2 or croak 'usage: $fh->truncate(LEN)'; |
392 | truncate($_[0], $_[1]); |
393 | } |
394 | |
395 | sub read { |
396 | @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])'; |
397 | read($_[0], $_[1], $_[2], $_[3] || 0); |
398 | } |
399 | |
27d4819a |
400 | sub sysread { |
401 | @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])'; |
402 | sysread($_[0], $_[1], $_[2], $_[3] || 0); |
403 | } |
404 | |
8add82fc |
405 | sub write { |
406 | @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])'; |
407 | local($\) = ""; |
408 | print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); |
409 | } |
410 | |
27d4819a |
411 | sub syswrite { |
412 | @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])'; |
5f05dabc |
413 | syswrite($_[0], $_[1], $_[2], $_[3] || 0); |
27d4819a |
414 | } |
415 | |
8add82fc |
416 | sub stat { |
417 | @_ == 1 or croak 'usage: $fh->stat()'; |
418 | stat($_[0]); |
419 | } |
420 | |
421 | ################################################ |
422 | ## State modification functions. |
423 | ## |
424 | |
425 | sub autoflush { |
426 | my $old = new SelectSaver qualify($_[0], caller); |
427 | my $prev = $|; |
428 | $| = @_ > 1 ? $_[1] : 1; |
429 | $prev; |
430 | } |
431 | |
432 | sub output_field_separator { |
433 | my $old = new SelectSaver qualify($_[0], caller); |
434 | my $prev = $,; |
435 | $, = $_[1] if @_ > 1; |
436 | $prev; |
437 | } |
438 | |
439 | sub output_record_separator { |
440 | my $old = new SelectSaver qualify($_[0], caller); |
441 | my $prev = $\; |
442 | $\ = $_[1] if @_ > 1; |
443 | $prev; |
444 | } |
445 | |
446 | sub input_record_separator { |
447 | my $old = new SelectSaver qualify($_[0], caller); |
448 | my $prev = $/; |
449 | $/ = $_[1] if @_ > 1; |
450 | $prev; |
451 | } |
452 | |
453 | sub input_line_number { |
454 | my $old = new SelectSaver qualify($_[0], caller); |
455 | my $prev = $.; |
456 | $. = $_[1] if @_ > 1; |
457 | $prev; |
458 | } |
459 | |
460 | sub format_page_number { |
461 | my $old = new SelectSaver qualify($_[0], caller); |
462 | my $prev = $%; |
463 | $% = $_[1] if @_ > 1; |
464 | $prev; |
465 | } |
466 | |
467 | sub format_lines_per_page { |
468 | my $old = new SelectSaver qualify($_[0], caller); |
469 | my $prev = $=; |
470 | $= = $_[1] if @_ > 1; |
471 | $prev; |
472 | } |
473 | |
474 | sub format_lines_left { |
475 | my $old = new SelectSaver qualify($_[0], caller); |
476 | my $prev = $-; |
477 | $- = $_[1] if @_ > 1; |
478 | $prev; |
479 | } |
480 | |
481 | sub format_name { |
482 | my $old = new SelectSaver qualify($_[0], caller); |
483 | my $prev = $~; |
484 | $~ = qualify($_[1], caller) if @_ > 1; |
485 | $prev; |
486 | } |
487 | |
488 | sub format_top_name { |
489 | my $old = new SelectSaver qualify($_[0], caller); |
490 | my $prev = $^; |
491 | $^ = qualify($_[1], caller) if @_ > 1; |
492 | $prev; |
493 | } |
494 | |
495 | sub format_line_break_characters { |
496 | my $old = new SelectSaver qualify($_[0], caller); |
497 | my $prev = $:; |
498 | $: = $_[1] if @_ > 1; |
499 | $prev; |
500 | } |
501 | |
502 | sub format_formfeed { |
503 | my $old = new SelectSaver qualify($_[0], caller); |
504 | my $prev = $^L; |
505 | $^L = $_[1] if @_ > 1; |
506 | $prev; |
507 | } |
508 | |
509 | sub formline { |
510 | my $fh = shift; |
511 | my $picture = shift; |
512 | local($^A) = $^A; |
513 | local($\) = ""; |
514 | formline($picture, @_); |
515 | print $fh $^A; |
516 | } |
517 | |
518 | sub format_write { |
519 | @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )'; |
520 | if (@_ == 2) { |
521 | my ($fh, $fmt) = @_; |
522 | my $oldfmt = $fh->format_name($fmt); |
523 | write($fh); |
524 | $fh->format_name($oldfmt); |
525 | } else { |
526 | write($_[0]); |
527 | } |
528 | } |
529 | |
27d4819a |
530 | sub fcntl { |
531 | @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );'; |
532 | my ($fh, $op, $val) = @_; |
533 | my $r = fcntl($fh, $op, $val); |
534 | defined $r && $r eq "0 but true" ? 0 : $r; |
535 | } |
536 | |
537 | sub ioctl { |
538 | @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );'; |
539 | my ($fh, $op, $val) = @_; |
540 | my $r = ioctl($fh, $op, $val); |
541 | defined $r && $r eq "0 but true" ? 0 : $r; |
542 | } |
8add82fc |
543 | |
544 | 1; |