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