[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

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

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->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->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->write ( BUF, LEN [, OFFSET }\] )

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

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

=back

Lastly, 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.1501";
$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

    _open_mode_string
);


################################################
## 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 gets {
    @_ == 1 or croak 'usage: $fh->gets()';
    my ($handle) = @_;
    scalar <$handle>;
}

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

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