[p5sagit/p5-mst-13.2.git] / ext / FileHandle / FileHandle.pm

package FileHandle;

=head1 NAME

FileHandle - supply object methods for filehandles

=head1 SYNOPSIS

    use FileHandle;

    $fh = new FileHandle;
    if ($fh->open "< file") {
        print <$fh>;
        $fh->close;
    }

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

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

    $fh = new FileHandle "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);

    ($readfh, $writefh) = FileHandle::pipe;

    autoflush STDOUT 1;

=head1 DESCRIPTION

C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
newly created symbol (see the C<Symbol> package).  If it receives any
parameters, they are passed to C<FileHandle::open>; if the open fails,
the C<FileHandle> object is destroyed.  Otherwise, it is returned to
the caller.

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

C<FileHandle::open> accepts one parameter or two.  With one parameter,
it is just a front end for the built-in C<open> function.  With two
parameters, the first parameter is a filename that may include
whitespace or other special characters, and the second parameter is
the open mode, optionally followed by a file permission value.

If C<FileHandle::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
Perl C<open> operator.

If C<FileHandle::open> is given a numeric mode, it passes that mode
and the optional permissions value to the Perl C<sysopen> operator.
For convenience, C<FileHandle::import> tries to import the O_XXX
constants from the Fcntl module.  If dynamic loading is not available,
this may fail, but the rest of FileHandle will still work.

C<FileHandle::fdopen> is like C<open> except that its first parameter
is not a filename but rather a file handle name, a FileHandle object,
or a file descriptor number.

If the C functions fgetpos() and fsetpos() are available, then
C<FileHandle::getpos> returns an opaque value that represents the
current position of the FileHandle, and C<FileHandle::setpos> uses
that value to return to a previously visited position.

If the C function setvbuf() is available, then C<FileHandle::setvbuf>
sets the buffering policy for the FileHandle.  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<FileHandle::setvbuf> must not be
modified in any way until the FileHandle is closed or until
C<FileHandle::setvbuf> is called again, or memory corruption may
result!

See L<perlfunc> for complete descriptions of each of the following
supported C<FileHandle> methods, which are just front ends for the
corresponding built-in functions:
  
    close
    fileno
    getc
    gets
    eof
    clearerr
    seek
    tell

See L<perlvar> for complete descriptions of each of the following
supported C<FileHandle> 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

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

=over 

=item $fh-E<gt>print

See L<perlfunc/print>.

=item $fh-E<gt>printf

See L<perlfunc/printf>.

=item $fh-E<gt>getline

This works like E<lt>$fhE<gt> 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-E<gt>getlines

This works like E<lt>$fhE<gt> 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.

=back

=head1 SEE ALSO

L<perlfunc>, 
L<perlop/"I/O Operators">.

=head1 BUGS

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

=cut

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

require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);

require IO::Handle;  # Kludge for bareword handles

$VERSION = "1.00" ;

@EXPORT = qw(_IOFBF _IOLBF _IONBF);

@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

    print
    printf
    getline
    getlines
);


################################################
## If the Fcntl extension is available,
##  export its constants.
##

sub import {
    my $pkg = shift;
    my $callpkg = caller;
    Exporter::export $pkg, $callpkg;
    eval {
	require Fcntl;
	Exporter::export 'Fcntl', $callpkg;
    };
};


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

eval {
    bootstrap FileHandle;
};
if ($@) {
    *constant = sub { undef };
}

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 FileHandle macro";
    *$AUTOLOAD = sub { $val };
    goto &$AUTOLOAD;
}


################################################
## Constructors, destructors.
##

sub new {
    @_ >= 1 && @_ <= 4
	or croak 'usage: new FileHandle [FILENAME [,MODE [,PERMS]]]';
    my $class = shift;
    my $fh = gensym;
    if (@_) {
	FileHandle::open($fh, @_)
	    or return undef;
    }
    bless $fh, $class;
}

sub new_from_fd {
    @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE';
    my $class = shift;
    my $fh = gensym;
    FileHandle::fdopen($fh, @_)
	or return undef;
    bless $fh, $class;
}

sub DESTROY {
    my ($fh) = @_;

   # During global object destruction, this function may be called
   # on FILEHANDLEs as well as on the GLOBs that contains them.
   # Thus the following trickery.  If only the CORE file operators
   # could deal with FILEHANDLEs, it wouldn't be necessary...

   if ($fh =~ /=FILEHANDLE\(/) {
     local *TMP = $fh;
     close(TMP) if defined fileno(TMP);
   }
   else {
     close($fh) if defined fileno($fh);
   }
}

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

sub pipe {
    @_ and croak 'usage: FileHandle::pipe()';
    my $readfh = new FileHandle;
    my $writefh = new FileHandle;
    pipe($readfh, $writefh)
	or return undef;
    ($readfh, $writefh);
}

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

sub open {
    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
    my ($fh, $file) = @_;
    if (@_ > 2) {
	my ($mode, $perms) = @_[2, 3];
	if ($mode =~ /^\d+$/) {
	    defined $perms or $perms = 0666;
	    return sysopen($fh, $file, $mode, $perms);
	}
        $file = "./" . $file unless $file =~ m#^/#;
	$file = _open_mode_string($mode) . " $file\0";
    }
    open($fh, $file);
}

sub fdopen {
    @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
    my ($fh, $fd, $mode) = @_;
    if (ref($fd) =~ /GLOB\(/) {
	# It's a glob reference; remove the star from its name.
	($fd = "".$$fd) =~ s/^\*//;
    } elsif ($fd =~ m#^\d+$#) {
	# It's an FD number; prefix with "=".
	$fd = "=$fd";
    }
    open($fh, _open_mode_string($mode) . '&' . $fd);
}

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

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

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 clearerr {
    @_ == 1 or croak 'usage: $fh->clearerr()';
    seek($_[0], 0, 1);
}

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

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

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

sub printf {
    @_ or croak 'usage: $fh->printf([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()';
    my $this = shift;
    wantarray or croak "Can't call FileHandle::getlines in a scalar context";
    return <$this>;
}

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

1;
Commit	Line	Data
c07a80fd	1	package FileHandle;
	2
	3	=head1 NAME
	4
	5	FileHandle - supply object methods for filehandles
	6
	7	=head1 SYNOPSIS
	8
	9	use FileHandle;
	10
	11	$fh = new FileHandle;
	12	if ($fh->open "< file") {
	13	print <$fh>;
	14	$fh->close;
	15	}
	16
	17	$fh = new FileHandle "> FOO";
	18	if (defined $fh) {
	19	print $fh "bar\n";
	20	$fh->close;
	21	}
	22
	23	$fh = new FileHandle "file", "r";
	24	if (defined $fh) {
	25	print <$fh>;
	26	undef $fh; # automatically closes the file
	27	}
	28
	29	$fh = new FileHandle "file", O_WRONLY\|O_APPEND;
	30	if (defined $fh) {
	31	print $fh "corge\n";
	32	undef $fh; # automatically closes the file
	33	}
	34
a5f75d66	35	$pos = $fh->getpos;
	36	$fh->setpos $pos;
	37
	38	$fh->setvbuf($buffer_var, _IOLBF, 1024);
	39
c07a80fd	40	($readfh, $writefh) = FileHandle::pipe;
	41
	42	autoflush STDOUT 1;
dd7f5759	43
c07a80fd	44	=head1 DESCRIPTION
	45
	46	C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
	47	newly created symbol (see the C<Symbol> package). If it receives any
	48	parameters, they are passed to C<FileHandle::open>; if the open fails,
	49	the C<FileHandle> object is destroyed. Otherwise, it is returned to
	50	the caller.
	51
	52	C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
	53	It requires two parameters, which are passed to C<FileHandle::fdopen>;
	54	if the fdopen fails, the C<FileHandle> object is destroyed.
	55	Otherwise, it is returned to the caller.
	56
	57	C<FileHandle::open> accepts one parameter or two. With one parameter,
	58	it is just a front end for the built-in C<open> function. With two
	59	parameters, the first parameter is a filename that may include
	60	whitespace or other special characters, and the second parameter is
0cbad286	61	the open mode, optionally followed by a file permission value.
0cbad286	62
1fef88e7	63	If C<FileHandle::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
0cbad286	64	or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
	65	Perl C<open> operator.
	66
	67	If C<FileHandle::open> is given a numeric mode, it passes that mode
	68	and the optional permissions value to the Perl C<sysopen> operator.
	69	For convenience, C<FileHandle::import> tries to import the O_XXX
	70	constants from the Fcntl module. If dynamic loading is not available,
	71	this may fail, but the rest of FileHandle will still work.
c07a80fd	72
	73	C<FileHandle::fdopen> is like C<open> except that its first parameter
	74	is not a filename but rather a file handle name, a FileHandle object,
	75	or a file descriptor number.
	76
a5f75d66	77	If the C functions fgetpos() and fsetpos() are available, then
	78	C<FileHandle::getpos> returns an opaque value that represents the
	79	current position of the FileHandle, and C<FileHandle::setpos> uses
	80	that value to return to a previously visited position.
	81
	82	If the C function setvbuf() is available, then C<FileHandle::setvbuf>
	83	sets the buffering policy for the FileHandle. The calling sequence
	84	for the Perl function is the same as its C counterpart, including the
	85	macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
	86	parameter specifies a scalar variable to use as a buffer. WARNING: A
	87	variable used as a buffer by C<FileHandle::setvbuf> must not be
	88	modified in any way until the FileHandle is closed or until
	89	C<FileHandle::setvbuf> is called again, or memory corruption may
	90	result!
	91
c07a80fd	92	See L<perlfunc> for complete descriptions of each of the following
	93	supported C<FileHandle> methods, which are just front ends for the
	94	corresponding built-in functions:
	95
	96	close
	97	fileno
	98	getc
	99	gets
	100	eof
	101	clearerr
	102	seek
	103	tell
	104
	105	See L<perlvar> for complete descriptions of each of the following
	106	supported C<FileHandle> methods:
	107
	108	autoflush
	109	output_field_separator
	110	output_record_separator
	111	input_record_separator
	112	input_line_number
	113	format_page_number
	114	format_lines_per_page
	115	format_lines_left
	116	format_name
	117	format_top_name
	118	format_line_break_characters
	119	format_formfeed
	120
	121	Furthermore, for doing normal I/O you might need these:
	122
	123	=over
	124
1fef88e7	125	=item $fh-E<gt>print
c07a80fd	126
	127	See L<perlfunc/print>.
	128
1fef88e7	129	=item $fh-E<gt>printf
c07a80fd	130
	131	See L<perlfunc/printf>.
	132
1fef88e7	133	=item $fh-E<gt>getline
c07a80fd	134
1fef88e7	135	This works like E<lt>$fhE<gt> described in L<perlop/"I/O Operators">
c07a80fd	136	except that it's more readable and can be safely called in an
	137	array context but still returns just one line.
	138
1fef88e7	139	=item $fh-E<gt>getlines
c07a80fd	140
1fef88e7	141	This works like E<lt>$fhE<gt> when called in an array context to
c07a80fd	142	read all the remaining lines in a file, except that it's more readable.
	143	It will also croak() if accidentally called in a scalar context.
	144
	145	=back
	146
	147	=head1 SEE ALSO
	148
	149	L<perlfunc>,
66b5b9b7	150	L<perlop/"I/O Operators">.
c07a80fd	151
	152	=head1 BUGS
	153
	154	Due to backwards compatibility, all filehandles resemble objects
	155	of class C<FileHandle>, or actually classes derived from that class.
	156	They actually aren't. Which means you can't derive your own
	157	class from C<FileHandle> and inherit those methods.
	158
	159	=cut
	160
	161	require 5.000;
dd7f5759	162	use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD);
c07a80fd	163	use Carp;
c07a80fd	164	use Symbol;
c07a80fd	165	use SelectSaver;
	166
	167	require Exporter;
	168	require DynaLoader;
	169	@ISA = qw(Exporter DynaLoader);
	170
66b5b9b7	171	require IO::Handle; # Kludge for bareword handles
66b5b9b7	172
dd7f5759	173	$VERSION = "1.00" ;
	174
	175	@EXPORT = qw(_IOFBF _IOLBF _IONBF);
c07a80fd	176
	177	@EXPORT_OK = qw(
	178	autoflush
	179	output_field_separator
	180	output_record_separator
	181	input_record_separator
	182	input_line_number
	183	format_page_number
	184	format_lines_per_page
	185	format_lines_left
	186	format_name
	187	format_top_name
	188	format_line_break_characters
	189	format_formfeed
	190
	191	print
	192	printf
	193	getline
	194	getlines
	195	);
	196
	197
	198	################################################
dd7f5759	199	## If the Fcntl extension is available,
	200	## export its constants.
	201	##
	202
	203	sub import {
	204	my $pkg = shift;
	205	my $callpkg = caller;
	206	Exporter::export $pkg, $callpkg;
	207	eval {
	208	require Fcntl;
	209	Exporter::export 'Fcntl', $callpkg;
	210	};
	211	};
	212
	213
	214	################################################
c07a80fd	215	## Interaction with the XS.
	216	##
	217
dd7f5759	218	eval {
	219	bootstrap FileHandle;
	220	};
	221	if ($@) {
	222	*constant = sub { undef };
	223	}
c07a80fd	224
	225	sub AUTOLOAD {
	226	if ($AUTOLOAD =~ /::(_?[a-z])/) {
	227	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	228	goto &AutoLoader::AUTOLOAD
	229	}
	230	my $constname = $AUTOLOAD;
	231	$constname =~ s/.*:://;
	232	my $val = constant($constname);
	233	defined $val or croak "$constname is not a valid FileHandle macro";
	234	*$AUTOLOAD = sub { $val };
	235	goto &$AUTOLOAD;
	236	}
	237
	238
	239	################################################
	240	## Constructors, destructors.
	241	##
	242
	243	sub new {
0cbad286	244	@_ >= 1 && @_ <= 4
0cbad286	245	or croak 'usage: new FileHandle [FILENAME [,MODE [,PERMS]]]';
c07a80fd	246	my $class = shift;
	247	my $fh = gensym;
	248	if (@_) {
	249	FileHandle::open($fh, @_)
	250	or return undef;
	251	}
	252	bless $fh, $class;
	253	}
	254
	255	sub new_from_fd {
	256	@_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE';
	257	my $class = shift;
	258	my $fh = gensym;
	259	FileHandle::fdopen($fh, @_)
	260	or return undef;
	261	bless $fh, $class;
	262	}
	263
	264	sub DESTROY {
	265	my ($fh) = @_;
f75e77c7	266
	267	# During global object destruction, this function may be called
	268	# on FILEHANDLEs as well as on the GLOBs that contains them.
	269	# Thus the following trickery. If only the CORE file operators
	270	# could deal with FILEHANDLEs, it wouldn't be necessary...
	271
	272	if ($fh =~ /=FILEHANDLE\(/) {
	273	local *TMP = $fh;
2c891ab9	274	close(TMP) if defined fileno(TMP);
f75e77c7	275	}
f75e77c7	276	else {
2c891ab9	277	close($fh) if defined fileno($fh);
f75e77c7	278	}
c07a80fd	279	}
	280
	281	################################################
	282	## Open and close.
	283	##
	284
	285	sub pipe {
	286	@_ and croak 'usage: FileHandle::pipe()';
	287	my $readfh = new FileHandle;
	288	my $writefh = new FileHandle;
	289	pipe($readfh, $writefh)
	290	or return undef;
	291	($readfh, $writefh);
	292	}
	293
	294	sub _open_mode_string {
	295	my ($mode) = @_;
	296	$mode =~ /^\+?(<\|>>?)$/
	297	or $mode =~ s/^r(\+?)$/$1</
	298	or $mode =~ s/^w(\+?)$/$1>/
	299	or $mode =~ s/^a(\+?)$/$1>>/
	300	or croak "FileHandle: bad open mode: $mode";
	301	$mode;
	302	}
	303
	304	sub open {
	305	@_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
	306	my ($fh, $file) = @_;
	307	if (@_ > 2) {
	308	my ($mode, $perms) = @_[2, 3];
	309	if ($mode =~ /^\d+$/) {
	310	defined $perms or $perms = 0666;
	311	return sysopen($fh, $file, $mode, $perms);
	312	}
	313	$file = "./" . $file unless $file =~ m#^/#;
	314	$file = _open_mode_string($mode) . " $file\0";
	315	}
	316	open($fh, $file);
	317	}
	318
	319	sub fdopen {
	320	@_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
	321	my ($fh, $fd, $mode) = @_;
	322	if (ref($fd) =~ /GLOB\(/) {
	323	# It's a glob reference; remove the star from its name.
	324	($fd = "".$$fd) =~ s/^\*//;
	325	} elsif ($fd =~ m#^\d+$#) {
	326	# It's an FD number; prefix with "=".
	327	$fd = "=$fd";
	328	}
	329	open($fh, _open_mode_string($mode) . '&' . $fd);
	330	}
	331
	332	sub close {
	333	@_ == 1 or croak 'usage: $fh->close()';
	334	close($_[0]);
	335	}
	336
	337	################################################
	338	## Normal I/O functions.
	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 clearerr {
363	@_ == 1 or croak 'usage: $fh->clearerr()';
364	seek($_[0], 0, 1);
365	}
366
367	sub seek {
368	@_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)';
369	seek($_[0], $_[1], $_[2]);
370	}
371
372	sub tell {
373	@_ == 1 or croak 'usage: $fh->tell()';
374	tell($_[0]);
375	}
376
377	sub print {
378	@_ or croak 'usage: $fh->print([ARGS])';
379	my $this = shift;
380	print $this @_;
381	}
382
383	sub printf {
384	@_ or croak 'usage: $fh->printf([ARGS])';
385	my $this = shift;
386	printf $this @_;
387	}
388
389	sub getline {
390	@_ == 1 or croak 'usage: $fh->getline';
391	my $this = shift;
392	return scalar <$this>;
393	}
394
395	sub getlines {
396	@_ == 1 or croak 'usage: $fh->getline()';
397	my $this = shift;
398	wantarray or croak "Can't call FileHandle::getlines in a scalar context";
399	return <$this>;
400	}
401
402	################################################
403	## State modification functions.
404	##
405
406	sub autoflush {
407	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	408	my $prev = $\|;
eb542a37	409	$\| = @_ > 1 ? $_[1] : 1;
c07a80fd	410	$prev;
	411	}
	412
	413	sub output_field_separator {
	414	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	415	my $prev = $,;
eb542a37	416	$, = $_[1] if @_ > 1;
c07a80fd	417	$prev;
	418	}
	419
	420	sub output_record_separator {
	421	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	422	my $prev = $\;
eb542a37	423	$\ = $_[1] if @_ > 1;
c07a80fd	424	$prev;
	425	}
	426
	427	sub input_record_separator {
	428	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	429	my $prev = $/;
eb542a37	430	$/ = $_[1] if @_ > 1;
c07a80fd	431	$prev;
	432	}
	433
	434	sub input_line_number {
	435	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	436	my $prev = $.;
eb542a37	437	$. = $_[1] if @_ > 1;
c07a80fd	438	$prev;
	439	}
	440
	441	sub format_page_number {
	442	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	443	my $prev = $%;
eb542a37	444	$% = $_[1] if @_ > 1;
c07a80fd	445	$prev;
	446	}
	447
	448	sub format_lines_per_page {
	449	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	450	my $prev = $=;
eb542a37	451	$= = $_[1] if @_ > 1;
c07a80fd	452	$prev;
	453	}
	454
	455	sub format_lines_left {
	456	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	457	my $prev = $-;
eb542a37	458	$- = $_[1] if @_ > 1;
c07a80fd	459	$prev;
	460	}
	461
	462	sub format_name {
	463	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	464	my $prev = $~;
eb542a37	465	$~ = qualify($_[1], caller) if @_ > 1;
c07a80fd	466	$prev;
	467	}
	468
	469	sub format_top_name {
	470	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	471	my $prev = $^;
eb542a37	472	$^ = qualify($_[1], caller) if @_ > 1;
c07a80fd	473	$prev;
	474	}
	475
	476	sub format_line_break_characters {
	477	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	478	my $prev = $:;
eb542a37	479	$: = $_[1] if @_ > 1;
c07a80fd	480	$prev;
	481	}
	482
	483	sub format_formfeed {
	484	my $old = new SelectSaver qualify($_[0], caller);
eb542a37	485	my $prev = $^L;
eb542a37	486	$^L = $_[1] if @_ > 1;
c07a80fd	487	$prev;
	488	}
	489
	490	1;