[p5sagit/p5-mst-13.2.git] / ext / IO / lib / IO / Handle.pm


package IO::Handle;

=head1 NAME

IO::Handle - supply object methods for I/O handles

=head1 SYNOPSIS

    use IO::Handle;

    $fh = new IO::Handle;
    if ($fh->fdopen(fileno(STDIN),"r")) {
        print $fh->getline;
        $fh->close;
    }

    $fh = new IO::Handle;
    if ($fh->fdopen(fileno(STDOUT),"w")) {
        $fh->print("Some text\n");
    }

    $fh->setvbuf($buffer_var, _IOLBF, 1024);

    undef $fh;       # 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. 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>

A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)

=head1 CONSTRUCTOR

=over 4

=item new ()

Creates a new C<IO::Handle> object.

=item new_from_fd ( FD, MODE )

Creates a C<IO::Handle> like C<new> does.
It requires two parameters, which are passed to the method C<fdopen>;
if the fdopen fails, the object is destroyed. Otherwise, it is returned
to the caller.

=back

=head1 METHODS

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
    eof
    read
    truncate
    stat
    print
    printf
    sysread
    syswrite

See L<perlvar> for complete descriptions of each of the following
supported C<IO::Handle> methods:

    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

Furthermore, for doing normal I/O you might need these:

=over 

=item $fh->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 $fh->opened

Returns true if the object is currently a valid file descriptor.

=item $fh->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.

=item $fh->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.
It will also croak() if accidentally called in a scalar context.

=item $fh->ungetc ( ORD )

Pushes a character with the given ordinal value back onto the given
handle's input stream.

=item $fh->write ( BUF, LEN [, OFFSET }\] )

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->flush

Flush the given handle's buffer.

=item $fh->error

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 $fh->clearerr

Clear the given handle's error indicator.

=back

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!

Lastly, there is a special method for working under B<-T> and setuid/gid
scripts:

=over

=item $fh->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
take, and appropriate consideration for the data source and potential
vulnerability should be kept in mind.

=back

=head1 NOTE

A C<IO::Handle> object is a GLOB reference. 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
its variables with its own name separated by _'s. For example the IO::Socket
module keeps a C<timeout> variable in 'io_socket_timeout'.

=head1 SEE ALSO

L<perlfunc>, 
L<perlop/"I/O Operators">,
L<IO::File>

=head1 BUGS

Due to backwards compatibility, all filehandles resemble objects
of class C<IO::Handle>, or actually classes derived from that class.
They actually aren't.  Which means you can't derive your own 
class from C<IO::Handle> and inherit those methods.

=head1 HISTORY

Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>

=cut

require 5.000;
use strict;
use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
use Carp;
use Symbol;
use SelectSaver;

require Exporter;
@ISA = qw(Exporter);

$VERSION = "1.1504";
$XS_VERSION = "1.15";

@EXPORT_OK = qw(
    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

    print
    printf
    getline
    getlines

    SEEK_SET
    SEEK_CUR
    SEEK_END
    _IOFBF
    _IOLBF
    _IONBF
);


################################################
## Interaction with the XS.
##

require DynaLoader;
@IO::ISA = qw(DynaLoader);
bootstrap IO $XS_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";
    no strict 'refs';
    *$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;
}

sub new_from_fd {
    my $class = ref($_[0]) || $_[0] || "IO::Handle";
    @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
    my $fh = gensym;
    shift;
    IO::Handle::fdopen($fh, @_)
	or return undef;
    bless $fh, $class;
}

#
# 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 {}


################################################
## Open and close.
##

sub _open_mode_string {
    my ($mode) = @_;
    $mode =~ /^\+?(<|>>?)$/
      or $mode =~ s/^r(\+?)$/$1</
      or $mode =~ s/^w(\+?)$/$1>/
      or $mode =~ s/^a(\+?)$/$1>>/
      or croak "IO::Handle: bad open mode: $mode";
    $mode;
}

sub fdopen {
    @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
    my ($fh, $fd, $mode) = @_;
    local(*GLOB);

    if (ref($fd) && "".$fd =~ /GLOB\(/o) {
	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
	my $n = qualify(*GLOB);
	*GLOB = *{*$fd};
	$fd =  $n;
    } elsif ($fd =~ m#^\d+$#) {
	# It's an FD number; prefix with "=".
	$fd = "=$fd";
    }

    open($fh, _open_mode_string($mode) . '&' . $fd)
	? $fh : undef;
}

sub close {
    @_ == 1 or croak 'usage: $fh->close()';
    my($fh) = @_;

    close($fh);
}

################################################
## Normal I/O functions.
##

# flock
# select

sub opened {
    @_ == 1 or croak 'usage: $fh->opened()';
    defined fileno($_[0]);
}

sub fileno {
    @_ == 1 or croak 'usage: $fh->fileno()';
    fileno($_[0]);
}

sub getc {
    @_ == 1 or croak 'usage: $fh->getc()';
    getc($_[0]);
}

sub eof {
    @_ == 1 or croak 'usage: $fh->eof()';
    eof($_[0]);
}

sub print {
    @_ or croak 'usage: $fh->print([ARGS])';
    my $this = shift;
    print $this @_;
}

sub printf {
    @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
    my $this = shift;
    printf $this @_;
}

sub getline {
    @_ == 1 or croak 'usage: $fh->getline';
    my $this = shift;
    return scalar <$this>;
} 

*gets = \&getline;  # deprecated

sub getlines {
    @_ == 1 or croak 'usage: $fh->getline()';
    wantarray or
	croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
    my $this = shift;
    return <$this>;
}

sub truncate {
    @_ == 2 or croak 'usage: $fh->truncate(LEN)';
    truncate($_[0], $_[1]);
}

sub read {
    @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
    read($_[0], $_[1], $_[2], $_[3] || 0);
}

sub sysread {
    @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
    sysread($_[0], $_[1], $_[2], $_[3] || 0);
}

sub write {
    @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
    local($\) = "";
    print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
}

sub syswrite {
    @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
    syswrite($_[0], $_[1], $_[2], $_[3] || 0);
}

sub stat {
    @_ == 1 or croak 'usage: $fh->stat()';
    stat($_[0]);
}

################################################
## State modification functions.
##

sub autoflush {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $|;
    $| = @_ > 1 ? $_[1] : 1;
    $prev;
}

sub output_field_separator {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $,;
    $, = $_[1] if @_ > 1;
    $prev;
}

sub output_record_separator {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $\;
    $\ = $_[1] if @_ > 1;
    $prev;
}

sub input_record_separator {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $/;
    $/ = $_[1] if @_ > 1;
    $prev;
}

sub input_line_number {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $.;
    $. = $_[1] if @_ > 1;
    $prev;
}

sub format_page_number {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $%;
    $% = $_[1] if @_ > 1;
    $prev;
}

sub format_lines_per_page {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $=;
    $= = $_[1] if @_ > 1;
    $prev;
}

sub format_lines_left {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $-;
    $- = $_[1] if @_ > 1;
    $prev;
}

sub format_name {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $~;
    $~ = qualify($_[1], caller) if @_ > 1;
    $prev;
}

sub format_top_name {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $^;
    $^ = qualify($_[1], caller) if @_ > 1;
    $prev;
}

sub format_line_break_characters {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $:;
    $: = $_[1] if @_ > 1;
    $prev;
}

sub format_formfeed {
    my $old = new SelectSaver qualify($_[0], caller);
    my $prev = $^L;
    $^L = $_[1] if @_ > 1;
    $prev;
}

sub formline {
    my $fh = shift;
    my $picture = shift;
    local($^A) = $^A;
    local($\) = "";
    formline($picture, @_);
    print $fh $^A;
}

sub format_write {
    @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )';
    if (@_ == 2) {
	my ($fh, $fmt) = @_;
	my $oldfmt = $fh->format_name($fmt);
	write($fh);
	$fh->format_name($oldfmt);
    } else {
	write($_[0]);
    }
}

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;
}

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;
}

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