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