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