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