+
package IO::Handle;
=head1 NAME
use IO::Handle;
- $fh = new IO::Handle;
- if ($fh->open "< file") {
- print <$fh>;
- $fh->close;
- }
-
- $fh = new IO::Handle "> FOO";
- if (defined $fh) {
- print $fh "bar\n";
- $fh->close;
+ $io = new IO::Handle;
+ if ($io->fdopen(fileno(STDIN),"r")) {
+ print $io->getline;
+ $io->close;
}
- $fh = new IO::Handle "file", "r";
- if (defined $fh) {
- print <$fh>;
- undef $fh; # automatically closes the file
+ $io = new IO::Handle;
+ if ($io->fdopen(fileno(STDOUT),"w")) {
+ $io->print("Some text\n");
}
- $fh = new IO::Handle "file", O_WRONLY|O_APPEND;
- if (defined $fh) {
- print $fh "corge\n";
- undef $fh; # automatically closes the file
- }
-
- $pos = $fh->getpos;
- $fh->setpos $pos;
+ use IO::Handle '_IOLBF';
+ $io->setvbuf($buffer_var, _IOLBF, 1024);
- $fh->setvbuf($buffer_var, _IOLBF, 1024);
+ undef $io; # automatically closes the file if it's open
autoflush STDOUT 1;
=head1 DESCRIPTION
-C<IO::Handle> is the base class for all other IO handle classes.
-A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+in the IO hierarchy.
+
+If you are reading this documentation, looking for a replacement for
+the C<FileHandle> package, then I suggest you read the documentation
+for C<IO::File> too.
=head1 CONSTRUCTOR
=head1 METHODS
-If the C function setvbuf() is available, then C<IO::Handle::setvbuf>
-sets the buffering policy for the IO::Handle. The calling sequence
-for the Perl function is the same as its C counterpart, including the
-macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
-parameter specifies a scalar variable to use as a buffer. WARNING: A
-variable used as a buffer by C<IO::Handle::setvbuf> must not be
-modified in any way until the IO::Handle is closed or until
-C<IO::Handle::setvbuf> is called again, or memory corruption may
-result!
-
See L<perlfunc> for complete descriptions of each of the following
supported C<IO::Handle> methods, which are just front ends for the
corresponding built-in functions:
-
- close
- fileno
- getc
- gets
- eof
- read
- truncate
- stat
- print
- printf
- sysread
- syswrite
+
+ $io->close
+ $io->eof
+ $io->fileno
+ $io->format_write( [FORMAT_NAME] )
+ $io->getc
+ $io->read ( BUF, LEN, [OFFSET] )
+ $io->print ( ARGS )
+ $io->printf ( FMT, [ARGS] )
+ $io->stat
+ $io->sysread ( BUF, LEN, [OFFSET] )
+ $io->syswrite ( BUF, LEN, [OFFSET] )
+ $io->truncate ( LEN )
See L<perlvar> for complete descriptions of each of the following
-supported C<IO::Handle> methods:
+supported C<IO::Handle> methods. All of them return the previous
+value of the attribute and takes an optional single argument that when
+given will set the value. If no argument is given the previous value
+is unchanged (except for $io->autoflush will actually turn ON
+autoflush by default).
- autoflush
- output_field_separator
- output_record_separator
- input_record_separator
- input_line_number
- format_page_number
- format_lines_per_page
- format_lines_left
- format_name
- format_top_name
- format_line_break_characters
- format_formfeed
- format_write
+ $io->autoflush ( [BOOL] ) $|
+ $io->format_page_number( [NUM] ) $%
+ $io->format_lines_per_page( [NUM] ) $=
+ $io->format_lines_left( [NUM] ) $-
+ $io->format_name( [STR] ) $~
+ $io->format_top_name( [STR] ) $^
+ $io->input_line_number( [NUM]) $.
+
+The following methods are not supported on a per-filehandle basis.
+
+ IO::Handle->format_line_break_characters( [STR] ) $:
+ IO::Handle->format_formfeed( [STR]) $^L
+ IO::Handle->output_field_separator( [STR] ) $,
+ IO::Handle->output_record_separator( [STR] ) $\
+
+ IO::Handle->input_record_separator( [STR] ) $/
Furthermore, for doing normal I/O you might need these:
=over
-=item $fh->getline
+=item $io->fdopen ( FD, MODE )
+
+C<fdopen> is like an ordinary C<open> except that its first parameter
+is not a filename but rather a file handle name, a IO::Handle object,
+or a file descriptor number.
+
+=item $io->opened
+
+Returns true if the object is currently a valid file descriptor.
+
+=item $io->getline
-This works like <$fh> described in L<perlop/"I/O Operators">
-except that it's more readable and can be safely called in an
-array context but still returns just one line.
+This works like <$io> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in a
+list context but still returns just one line.
-=item $fh->getlines
+=item $io->getlines
-This works like <$fh> when called in an array context to
-read all the remaining lines in a file, except that it's more readable.
+This works like <$io> when called in a list context to read all
+the remaining lines in a file, except that it's more readable.
It will also croak() if accidentally called in a scalar context.
-=item $fh->fdopen ( FD, MODE )
+=item $io->ungetc ( ORD )
-C<fdopen> is like an ordinary C<open> except that its first parameter
-is not a filename but rather a file handle name, a IO::Handle object,
-or a file descriptor number.
+Pushes a character with the given ordinal value back onto the given
+handle's input stream. Only one character of pushback per handle is
+guaranteed.
-=item $fh->write ( BUF, LEN [, OFFSET }\] )
+=item $io->write ( BUF, LEN [, OFFSET ] )
-C<write> is like C<write> found in C, that is it is the
+This C<write> is like C<write> found in C, that is it is the
opposite of read. The wrapper for the perl C<write> function is
called C<format_write>.
-=item $fh->opened
+=item $io->error
-Returns true if the object is currently a valid file descriptor.
+Returns a true value if the given handle has experienced any errors
+since it was opened or since the last call to C<clearerr>.
+
+=item $io->clearerr
+
+Clear the given handle's error indicator.
+
+=item $io->sync
+
+C<sync> synchronizes a file's in-memory state with that on the
+physical medium. C<sync> does not operate at the perlio api level, but
+operates on the file descriptor, this means that any data held at the
+perlio api level will not be synchronized. To synchronize data that is
+buffered at the perlio api level you must use the flush method. C<sync>
+is not implemented on all platforms. See L<fsync(3c)>.
+
+=item $io->flush
+
+C<flush> causes perl to flush any buffered data at the perlio api level.
+Any unread data in the buffer will be discarded, and any unwritten data
+will be written to the underlying file descriptor.
+
+=item $io->printflush ( ARGS )
+
+Turns on autoflush, print ARGS and then restores the autoflush status of the
+C<IO::Handle> object.
+
+=item $io->blocking ( [ BOOL ] )
+
+If called with an argument C<blocking> will turn on non-blocking IO if
+C<BOOL> is false, and turn it off if C<BOOL> is true.
+
+C<blocking> will return the value of the previous setting, or the
+current setting if C<BOOL> is not given.
+
+If an error occurs C<blocking> will return undef and C<$!> will be set.
=back
-Lastly, a special method for working under B<-T> and setuid/gid scripts:
+
+If the C functions setbuf() and/or setvbuf() are available, then
+C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
+policy for an IO::Handle. The calling sequences for the Perl functions
+are the same as their C counterparts--including the constants C<_IOFBF>,
+C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
+specifies a scalar variable to use as a buffer. WARNING: A variable
+used as a buffer by C<setbuf> or C<setvbuf> must not be modified in any
+way until the IO::Handle is closed or C<setbuf> or C<setvbuf> is called
+again, or memory corruption may result! Note that you need to import
+the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly.
+
+Lastly, there is a special method for working under B<-T> and setuid/gid
+scripts:
=over
-=item $fh->untaint
+=item $io->untaint
Marks the object as taint-clean, and as such data read from it will also
be considered taint-clean. Note that this is a very trusting action to
=head1 NOTE
-A C<IO::Handle> object is a GLOB reference. Some modules that
+A C<IO::Handle> object is a reference to a symbol/GLOB reference (see
+the C<Symbol> package). Some modules that
inherit from C<IO::Handle> may want to keep object related variables
in the hash table part of the GLOB. In an attempt to prevent modules
trampling on each other I propose the that any such module should prefix
L<perlfunc>,
L<perlop/"I/O Operators">,
-L<FileHandle>
+L<IO::File>
=head1 BUGS
=head1 HISTORY
-Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
=cut
-require 5.000;
-use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD);
+require 5.005_64;
+use strict;
+our($VERSION, @EXPORT_OK, @ISA);
use Carp;
use Symbol;
use SelectSaver;
+use IO (); # Load the XS module
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.12";
-$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/);
+$VERSION = "1.21";
@EXPORT_OK = qw(
autoflush
getline
getlines
+ printflush
+ flush
+
SEEK_SET
SEEK_CUR
SEEK_END
_IOFBF
_IOLBF
_IONBF
-
- _open_mode_string
);
-
-################################################
-## Interaction with the XS.
-##
-
-require DynaLoader;
-@IO::ISA = qw(DynaLoader);
-bootstrap IO $VERSION;
-
-sub AUTOLOAD {
- if ($AUTOLOAD =~ /::(_?[a-z])/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD
- }
- my $constname = $AUTOLOAD;
- $constname =~ s/.*:://;
- my $val = constant($constname);
- defined $val or croak "$constname is not a valid IO::Handle macro";
- *$AUTOLOAD = sub { $val };
- goto &$AUTOLOAD;
-}
-
-
################################################
## Constructors, destructors.
##
sub new {
my $class = ref($_[0]) || $_[0] || "IO::Handle";
@_ == 1 or croak "usage: new $class";
- my $fh = gensym;
- bless $fh, $class;
+ my $io = gensym;
+ bless $io, $class;
}
sub new_from_fd {
my $class = ref($_[0]) || $_[0] || "IO::Handle";
@_ == 3 or croak "usage: new_from_fd $class FD, MODE";
- my $fh = gensym;
+ my $io = gensym;
shift;
- IO::Handle::fdopen($fh, @_)
+ IO::Handle::fdopen($io, @_)
or return undef;
- bless $fh, $class;
+ bless $io, $class;
}
#
-# That an IO::Handle is being destroyed does not necessarily mean
-# that the associated filehandle should be closed. This is because
-# *FOO{FILEHANDLE} may by a synonym for *BAR{FILEHANDLE}.
-#
-# If this IO::Handle really does have the final reference to the
-# given FILEHANDLE, then Perl will close it for us automatically.
+# There is no need for DESTROY to do anything, because when the
+# last reference to an IO object is gone, Perl automatically
+# closes its associated files (if any). However, to avoid any
+# attempts to autoload DESTROY, we here define it to do nothing.
#
+sub DESTROY {}
-sub DESTROY {
-}
################################################
## Open and close.
}
sub fdopen {
- @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
- my ($fh, $fd, $mode) = @_;
+ @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
+ my ($io, $fd, $mode) = @_;
local(*GLOB);
if (ref($fd) && "".$fd =~ /GLOB\(/o) {
$fd = "=$fd";
}
- open($fh, _open_mode_string($mode) . '&' . $fd)
- ? $fh : undef;
+ open($io, _open_mode_string($mode) . '&' . $fd)
+ ? $io : undef;
}
sub close {
- @_ == 1 or croak 'usage: $fh->close()';
- my($fh) = @_;
- my $r = close($fh);
-
- # This may seem as though it should be in IO::Pipe, but the
- # object gets blessed out of IO::Pipe when reader/writer is called
- waitpid(${*$fh}{'io_pipe_pid'},0)
- if(defined ${*$fh}{'io_pipe_pid'});
+ @_ == 1 or croak 'usage: $io->close()';
+ my($io) = @_;
- $r;
+ close($io);
}
################################################
# select
sub opened {
- @_ == 1 or croak 'usage: $fh->opened()';
+ @_ == 1 or croak 'usage: $io->opened()';
defined fileno($_[0]);
}
sub fileno {
- @_ == 1 or croak 'usage: $fh->fileno()';
+ @_ == 1 or croak 'usage: $io->fileno()';
fileno($_[0]);
}
sub getc {
- @_ == 1 or croak 'usage: $fh->getc()';
+ @_ == 1 or croak 'usage: $io->getc()';
getc($_[0]);
}
-sub gets {
- @_ == 1 or croak 'usage: $fh->gets()';
- my ($handle) = @_;
- scalar <$handle>;
-}
-
sub eof {
- @_ == 1 or croak 'usage: $fh->eof()';
+ @_ == 1 or croak 'usage: $io->eof()';
eof($_[0]);
}
sub print {
- @_ or croak 'usage: $fh->print([ARGS])';
+ @_ or croak 'usage: $io->print(ARGS)';
my $this = shift;
print $this @_;
}
sub printf {
- @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
+ @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
my $this = shift;
printf $this @_;
}
sub getline {
- @_ == 1 or croak 'usage: $fh->getline';
+ @_ == 1 or croak 'usage: $io->getline()';
my $this = shift;
return scalar <$this>;
}
+*gets = \&getline; # deprecated
+
sub getlines {
- @_ == 1 or croak 'usage: $fh->getline()';
+ @_ == 1 or croak 'usage: $io->getlines()';
wantarray or
- croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
+ croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
my $this = shift;
return <$this>;
}
sub truncate {
- @_ == 2 or croak 'usage: $fh->truncate(LEN)';
+ @_ == 2 or croak 'usage: $io->truncate(LEN)';
truncate($_[0], $_[1]);
}
sub read {
- @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
+ @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
read($_[0], $_[1], $_[2], $_[3] || 0);
}
sub sysread {
- @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
+ @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
sysread($_[0], $_[1], $_[2], $_[3] || 0);
}
sub write {
- @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
+ @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
local($\) = "";
+ $_[2] = length($_[1]) unless defined $_[2];
print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
}
sub syswrite {
- @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
+ @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
+ $_[2] = length($_[1]) unless defined $_[2];
syswrite($_[0], $_[1], $_[2], $_[3] || 0);
}
sub stat {
- @_ == 1 or croak 'usage: $fh->stat()';
+ @_ == 1 or croak 'usage: $io->stat()';
stat($_[0]);
}
}
sub output_field_separator {
- my $old = new SelectSaver qualify($_[0], caller);
+ carp "output_field_separator is not supported on a per-handle basis"
+ if ref($_[0]);
my $prev = $,;
$, = $_[1] if @_ > 1;
$prev;
}
sub output_record_separator {
- my $old = new SelectSaver qualify($_[0], caller);
+ carp "output_record_separator is not supported on a per-handle basis"
+ if ref($_[0]);
my $prev = $\;
$\ = $_[1] if @_ > 1;
$prev;
}
sub input_record_separator {
- my $old = new SelectSaver qualify($_[0], caller);
+ carp "input_record_separator is not supported on a per-handle basis"
+ if ref($_[0]);
my $prev = $/;
$/ = $_[1] if @_ > 1;
$prev;
}
sub input_line_number {
- my $old = new SelectSaver qualify($_[0], caller);
+ local $.;
+ my $tell = tell qualify($_[0], caller) if ref($_[0]);
my $prev = $.;
$. = $_[1] if @_ > 1;
$prev;
}
sub format_page_number {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $%;
$% = $_[1] if @_ > 1;
$prev;
}
sub format_lines_per_page {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $=;
$= = $_[1] if @_ > 1;
$prev;
}
sub format_lines_left {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $-;
$- = $_[1] if @_ > 1;
$prev;
}
sub format_name {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $~;
$~ = qualify($_[1], caller) if @_ > 1;
$prev;
}
sub format_top_name {
- my $old = new SelectSaver qualify($_[0], caller);
+ my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
my $prev = $^;
$^ = qualify($_[1], caller) if @_ > 1;
$prev;
}
sub format_line_break_characters {
- my $old = new SelectSaver qualify($_[0], caller);
+ carp "format_line_break_characters is not supported on a per-handle basis"
+ if ref($_[0]);
my $prev = $:;
$: = $_[1] if @_ > 1;
$prev;
}
sub format_formfeed {
- my $old = new SelectSaver qualify($_[0], caller);
+ carp "format_formfeed is not supported on a per-handle basis"
+ if ref($_[0]);
my $prev = $^L;
$^L = $_[1] if @_ > 1;
$prev;
}
sub formline {
- my $fh = shift;
+ my $io = shift;
my $picture = shift;
local($^A) = $^A;
local($\) = "";
formline($picture, @_);
- print $fh $^A;
+ print $io $^A;
}
sub format_write {
- @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )';
+ @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
if (@_ == 2) {
- my ($fh, $fmt) = @_;
- my $oldfmt = $fh->format_name($fmt);
- write($fh);
- $fh->format_name($oldfmt);
+ my ($io, $fmt) = @_;
+ my $oldfmt = $io->format_name($fmt);
+ CORE::write($io);
+ $io->format_name($oldfmt);
} else {
- write($_[0]);
+ CORE::write($_[0]);
}
}
+# XXX undocumented
sub fcntl {
- @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );';
- my ($fh, $op, $val) = @_;
- my $r = fcntl($fh, $op, $val);
- defined $r && $r eq "0 but true" ? 0 : $r;
+ @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
+ my ($io, $op) = @_;
+ return fcntl($io, $op, $_[2]);
}
+# XXX undocumented
sub ioctl {
- @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );';
- my ($fh, $op, $val) = @_;
- my $r = ioctl($fh, $op, $val);
- defined $r && $r eq "0 but true" ? 0 : $r;
+ @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
+ my ($io, $op) = @_;
+ return ioctl($io, $op, $_[2]);
+}
+
+# this sub is for compatability with older releases of IO that used
+# a sub called constant to detemine if a constant existed -- GMB
+#
+# The SEEK_* and _IO?BF constants were the only constants at that time
+# any new code should just chech defined(&CONSTANT_NAME)
+
+sub constant {
+ no strict 'refs';
+ my $name = shift;
+ (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
+ ? &{$name}() : undef;
+}
+
+
+# so that flush.pl can be depriciated
+
+sub printflush {
+ my $io = shift;
+ my $old = new SelectSaver qualify($io, caller) if ref($io);
+ local $| = 1;
+ if(ref($io)) {
+ print $io @_;
+ }
+ else {
+ print @_;
+ }
}
1;
projects / p5sagit/p5-mst-13.2.git / blobdiff