[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->open "< file") {
        print <$fh>;
        $fh->close;
    }

    $fh = new IO::Handle "> FOO";
    if (defined $fh) {
        print $fh "bar\n";
        $fh->close;
    }

    $fh = new IO::Handle "file", "r";
    if (defined $fh) {
        print <$fh>;
        undef $fh;       # automatically closes the file
    }

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

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

    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)

=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<FileHandle>

=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 vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD);
use Carp;
use Symbol;
use SelectSaver;

require Exporter;
@ISA = qw(Exporter);

$VERSION = "1.12";
$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/);

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

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

#
# 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.
#

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) = @_;
    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'});

    $r;
}

################################################
## 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
8add82fc	1	package IO::Handle;
	2
	3	=head1 NAME
	4
27d4819a	5	IO::Handle - supply object methods for I/O handles
8add82fc	6
	7	=head1 SYNOPSIS
	8
	9	use IO::Handle;
	10
	11	$fh = new IO::Handle;
	12	if ($fh->open "< file") {
	13	print <$fh>;
	14	$fh->close;
	15	}
	16
	17	$fh = new IO::Handle "> FOO";
	18	if (defined $fh) {
	19	print $fh "bar\n";
	20	$fh->close;
	21	}
	22
	23	$fh = new IO::Handle "file", "r";
	24	if (defined $fh) {
	25	print <$fh>;
	26	undef $fh; # automatically closes the file
	27	}
	28
	29	$fh = new IO::Handle "file", O_WRONLY\|O_APPEND;
	30	if (defined $fh) {
	31	print $fh "corge\n";
	32	undef $fh; # automatically closes the file
	33	}
	34
	35	$pos = $fh->getpos;
	36	$fh->setpos $pos;
	37
	38	$fh->setvbuf($buffer_var, _IOLBF, 1024);
	39
	40	autoflush STDOUT 1;
	41
	42	=head1 DESCRIPTION
	43
27d4819a	44	C<IO::Handle> is the base class for all other IO handle classes.
27d4819a	45	A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
8add82fc	46
27d4819a	47	=head1 CONSTRUCTOR
	48
	49	=over 4
	50
	51	=item new ()
8add82fc	52
27d4819a	53	Creates a new C<IO::Handle> object.
8add82fc	54
27d4819a	55	=item new_from_fd ( FD, MODE )
	56
	57	Creates a C<IO::Handle> like C<new> does.
	58	It requires two parameters, which are passed to the method C<fdopen>;
	59	if the fdopen fails, the object is destroyed. Otherwise, it is returned
	60	to the caller.
	61
	62	=back
	63
	64	=head1 METHODS
8add82fc	65
	66	If the C function setvbuf() is available, then C<IO::Handle::setvbuf>
	67	sets the buffering policy for the IO::Handle. The calling sequence
	68	for the Perl function is the same as its C counterpart, including the
	69	macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
	70	parameter specifies a scalar variable to use as a buffer. WARNING: A
	71	variable used as a buffer by C<IO::Handle::setvbuf> must not be
	72	modified in any way until the IO::Handle is closed or until
	73	C<IO::Handle::setvbuf> is called again, or memory corruption may
	74	result!
	75
	76	See L<perlfunc> for complete descriptions of each of the following
	77	supported C<IO::Handle> methods, which are just front ends for the
	78	corresponding built-in functions:
	79
	80	close
	81	fileno
	82	getc
	83	gets
	84	eof
	85	read
	86	truncate
	87	stat
27d4819a	88	print
	89	printf
	90	sysread
	91	syswrite
8add82fc	92
	93	See L<perlvar> for complete descriptions of each of the following
	94	supported C<IO::Handle> methods:
	95
	96	autoflush
	97	output_field_separator
	98	output_record_separator
	99	input_record_separator
	100	input_line_number
	101	format_page_number
	102	format_lines_per_page
	103	format_lines_left
	104	format_name
	105	format_top_name
	106	format_line_break_characters
	107	format_formfeed
	108	format_write
	109
	110	Furthermore, for doing normal I/O you might need these:
	111
	112	=over
	113
8add82fc	114	=item $fh->getline
	115
	116	This works like <$fh> described in L<perlop/"I/O Operators">
	117	except that it's more readable and can be safely called in an
	118	array context but still returns just one line.
	119
	120	=item $fh->getlines
	121
	122	This works like <$fh> when called in an array context to
	123	read all the remaining lines in a file, except that it's more readable.
	124	It will also croak() if accidentally called in a scalar context.
	125
27d4819a	126	=item $fh->fdopen ( FD, MODE )
	127
	128	C<fdopen> is like an ordinary C<open> except that its first parameter
	129	is not a filename but rather a file handle name, a IO::Handle object,
	130	or a file descriptor number.
	131
	132	=item $fh->write ( BUF, LEN [, OFFSET }\] )
	133
	134	C<write> is like C<write> found in C, that is it is the
	135	opposite of read. The wrapper for the perl C<write> function is
	136	called C<format_write>.
	137
	138	=item $fh->opened
	139
	140	Returns true if the object is currently a valid file descriptor.
	141
8add82fc	142	=back
8add82fc	143
515e7bd7	144	Lastly, a special method for working under B<-T> and setuid/gid scripts:
	145
	146	=over
	147
	148	=item $fh->untaint
	149
	150	Marks the object as taint-clean, and as such data read from it will also
	151	be considered taint-clean. Note that this is a very trusting action to
	152	take, and appropriate consideration for the data source and potential
	153	vulnerability should be kept in mind.
	154
	155	=back
	156
27d4819a	157	=head1 NOTE
8add82fc	158
27d4819a	159	A C<IO::Handle> object is a GLOB reference. Some modules that
8add82fc	160	inherit from C<IO::Handle> may want to keep object related variables
	161	in the hash table part of the GLOB. In an attempt to prevent modules
	162	trampling on each other I propose the that any such module should prefix
	163	its variables with its own name separated by _'s. For example the IO::Socket
	164	module keeps a C<timeout> variable in 'io_socket_timeout'.
	165
	166	=head1 SEE ALSO
	167
	168	L<perlfunc>,
	169	L<perlop/"I/O Operators">,
55497cff	170	L<FileHandle>
8add82fc	171
	172	=head1 BUGS
	173
	174	Due to backwards compatibility, all filehandles resemble objects
	175	of class C<IO::Handle>, or actually classes derived from that class.
	176	They actually aren't. Which means you can't derive your own
	177	class from C<IO::Handle> and inherit those methods.
	178
	179	=head1 HISTORY
	180
27d4819a	181	Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
8add82fc	182
	183	=cut
	184
	185	require 5.000;
27d4819a	186	use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD);
8add82fc	187	use Carp;
	188	use Symbol;
	189	use SelectSaver;
	190
	191	require Exporter;
	192	@ISA = qw(Exporter);
	193
27d4819a	194	$VERSION = "1.12";
27d4819a	195	$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/);
8add82fc	196
	197	@EXPORT_OK = qw(
	198	autoflush
	199	output_field_separator
	200	output_record_separator
	201	input_record_separator
	202	input_line_number
	203	format_page_number
	204	format_lines_per_page
	205	format_lines_left
	206	format_name
	207	format_top_name
	208	format_line_break_characters
	209	format_formfeed
	210	format_write
	211
	212	print
	213	printf
	214	getline
	215	getlines
	216
	217	SEEK_SET
	218	SEEK_CUR
	219	SEEK_END
	220	_IOFBF
	221	_IOLBF
	222	_IONBF
	223
	224	_open_mode_string
	225	);
	226
	227
	228	################################################
	229	## Interaction with the XS.
	230	##
	231
	232	require DynaLoader;
	233	@IO::ISA = qw(DynaLoader);
	234	bootstrap IO $VERSION;
	235
	236	sub AUTOLOAD {
	237	if ($AUTOLOAD =~ /::(_?[a-z])/) {
	238	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	239	goto &AutoLoader::AUTOLOAD
	240	}
	241	my $constname = $AUTOLOAD;
	242	$constname =~ s/.*:://;
	243	my $val = constant($constname);
	244	defined $val or croak "$constname is not a valid IO::Handle macro";
	245	*$AUTOLOAD = sub { $val };
	246	goto &$AUTOLOAD;
	247	}
	248
	249
	250	################################################
	251	## Constructors, destructors.
	252	##
	253
	254	sub new {
27d4819a	255	my $class = ref($_[0]) \|\| $_[0] \|\| "IO::Handle";
27d4819a	256	@_ == 1 or croak "usage: new $class";
8add82fc	257	my $fh = gensym;
	258	bless $fh, $class;
	259	}
	260
	261	sub new_from_fd {
27d4819a	262	my $class = ref($_[0]) \|\| $_[0] \|\| "IO::Handle";
27d4819a	263	@_ == 3 or croak "usage: new_from_fd $class FD, MODE";
8add82fc	264	my $fh = gensym;
c927212d	265	shift;
8add82fc	266	IO::Handle::fdopen($fh, @_)
	267	or return undef;
	268	bless $fh, $class;
8add82fc	269	}
8add82fc	270
c927212d	271	#
	272	# That an IO::Handle is being destroyed does not necessarily mean
	273	# that the associated filehandle should be closed. This is because
	274	# FOO{FILEHANDLE} may by a synonym for BAR{FILEHANDLE}.
	275	#
	276	# If this IO::Handle really does have the final reference to the
	277	# given FILEHANDLE, then Perl will close it for us automatically.
	278	#
8add82fc	279
c927212d	280	sub DESTROY {
27d4819a	281	}
8add82fc	282
	283	################################################
	284	## Open and close.
	285	##
	286
	287	sub _open_mode_string {
	288	my ($mode) = @_;
	289	$mode =~ /^\+?(<\|>>?)$/
	290	or $mode =~ s/^r(\+?)$/$1</
	291	or $mode =~ s/^w(\+?)$/$1>/
	292	or $mode =~ s/^a(\+?)$/$1>>/
	293	or croak "IO::Handle: bad open mode: $mode";
	294	$mode;
	295	}
	296
	297	sub fdopen {
	298	@_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
	299	my ($fh, $fd, $mode) = @_;
	300	local(*GLOB);
	301
	302	if (ref($fd) && "".$fd =~ /GLOB\(/o) {
	303	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
	304	my $n = qualify(*GLOB);
	305	GLOB = {*$fd};
	306	$fd = $n;
	307	} elsif ($fd =~ m#^\d+$#) {
	308	# It's an FD number; prefix with "=".
	309	$fd = "=$fd";
	310	}
	311
	312	open($fh, _open_mode_string($mode) . '&' . $fd)
	313	? $fh : undef;
	314	}
	315
	316	sub close {
	317	@_ == 1 or croak 'usage: $fh->close()';
	318	my($fh) = @_;
	319	my $r = close($fh);
	320
	321	# This may seem as though it should be in IO::Pipe, but the
	322	# object gets blessed out of IO::Pipe when reader/writer is called
	323	waitpid(${*$fh}{'io_pipe_pid'},0)
	324	if(defined ${*$fh}{'io_pipe_pid'});
	325
	326	$r;
	327	}
	328
	329	################################################
	330	## Normal I/O functions.
	331	##
	332
8add82fc	333	# flock
8add82fc	334	# select
8add82fc	335
	336	sub opened {
	337	@_ == 1 or croak 'usage: $fh->opened()';
	338	defined fileno($_[0]);
	339	}
	340
	341	sub fileno {
	342	@_ == 1 or croak 'usage: $fh->fileno()';
	343	fileno($_[0]);
	344	}
	345
	346	sub getc {
	347	@_ == 1 or croak 'usage: $fh->getc()';
	348	getc($_[0]);
	349	}
	350
	351	sub gets {
	352	@_ == 1 or croak 'usage: $fh->gets()';
	353	my ($handle) = @_;
	354	scalar <$handle>;
	355	}
	356
	357	sub eof {
	358	@_ == 1 or croak 'usage: $fh->eof()';
	359	eof($_[0]);
	360	}
	361
	362	sub print {
	363	@_ or croak 'usage: $fh->print([ARGS])';
	364	my $this = shift;
	365	print $this @_;
	366	}
	367
	368	sub printf {
	369	@_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
	370	my $this = shift;
	371	printf $this @_;
	372	}
	373
	374	sub getline {
	375	@_ == 1 or croak 'usage: $fh->getline';
	376	my $this = shift;
	377	return scalar <$this>;
	378	}
	379
	380	sub getlines {
	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;