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

Version 1.1201 specialized from 1.12 for inclusion in Perl distribution

=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.1201";
$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
71be2cbc	183	Version 1.1201 specialized from 1.12 for inclusion in Perl distribution
71be2cbc	184
8add82fc	185	=cut
	186
	187	require 5.000;
27d4819a	188	use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD);
8add82fc	189	use Carp;
	190	use Symbol;
	191	use SelectSaver;
	192
	193	require Exporter;
	194	@ISA = qw(Exporter);
	195
71be2cbc	196	$VERSION = "1.1201";
27d4819a	197	$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/);
8add82fc	198
	199	@EXPORT_OK = qw(
	200	autoflush
	201	output_field_separator
	202	output_record_separator
	203	input_record_separator
	204	input_line_number
	205	format_page_number
	206	format_lines_per_page
	207	format_lines_left
	208	format_name
	209	format_top_name
	210	format_line_break_characters
	211	format_formfeed
	212	format_write
	213
	214	print
	215	printf
	216	getline
	217	getlines
	218
	219	SEEK_SET
	220	SEEK_CUR
	221	SEEK_END
	222	_IOFBF
	223	_IOLBF
	224	_IONBF
	225
	226	_open_mode_string
	227	);
	228
	229
	230	################################################
	231	## Interaction with the XS.
	232	##
	233
	234	require DynaLoader;
	235	@IO::ISA = qw(DynaLoader);
	236	bootstrap IO $VERSION;
	237
	238	sub AUTOLOAD {
	239	if ($AUTOLOAD =~ /::(_?[a-z])/) {
	240	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	241	goto &AutoLoader::AUTOLOAD
	242	}
	243	my $constname = $AUTOLOAD;
	244	$constname =~ s/.*:://;
	245	my $val = constant($constname);
	246	defined $val or croak "$constname is not a valid IO::Handle macro";
	247	*$AUTOLOAD = sub { $val };
	248	goto &$AUTOLOAD;
	249	}
	250
	251
	252	################################################
	253	## Constructors, destructors.
	254	##
	255
	256	sub new {
27d4819a	257	my $class = ref($_[0]) \|\| $_[0] \|\| "IO::Handle";
27d4819a	258	@_ == 1 or croak "usage: new $class";
8add82fc	259	my $fh = gensym;
	260	bless $fh, $class;
	261	}
	262
	263	sub new_from_fd {
27d4819a	264	my $class = ref($_[0]) \|\| $_[0] \|\| "IO::Handle";
27d4819a	265	@_ == 3 or croak "usage: new_from_fd $class FD, MODE";
8add82fc	266	my $fh = gensym;
c927212d	267	shift;
8add82fc	268	IO::Handle::fdopen($fh, @_)
	269	or return undef;
	270	bless $fh, $class;
8add82fc	271	}
8add82fc	272
c927212d	273	#
	274	# That an IO::Handle is being destroyed does not necessarily mean
	275	# that the associated filehandle should be closed. This is because
	276	# FOO{FILEHANDLE} may by a synonym for BAR{FILEHANDLE}.
	277	#
	278	# If this IO::Handle really does have the final reference to the
	279	# given FILEHANDLE, then Perl will close it for us automatically.
	280	#
8add82fc	281
c927212d	282	sub DESTROY {
27d4819a	283	}
8add82fc	284
	285	################################################
	286	## Open and close.
	287	##
	288
	289	sub _open_mode_string {
	290	my ($mode) = @_;
	291	$mode =~ /^\+?(<\|>>?)$/
	292	or $mode =~ s/^r(\+?)$/$1</
	293	or $mode =~ s/^w(\+?)$/$1>/
	294	or $mode =~ s/^a(\+?)$/$1>>/
	295	or croak "IO::Handle: bad open mode: $mode";
	296	$mode;
	297	}
	298
	299	sub fdopen {
	300	@_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
	301	my ($fh, $fd, $mode) = @_;
	302	local(*GLOB);
	303
	304	if (ref($fd) && "".$fd =~ /GLOB\(/o) {
	305	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
	306	my $n = qualify(*GLOB);
	307	GLOB = {*$fd};
	308	$fd = $n;
	309	} elsif ($fd =~ m#^\d+$#) {
	310	# It's an FD number; prefix with "=".
	311	$fd = "=$fd";
	312	}
	313
	314	open($fh, _open_mode_string($mode) . '&' . $fd)
	315	? $fh : undef;
	316	}
	317
	318	sub close {
	319	@_ == 1 or croak 'usage: $fh->close()';
	320	my($fh) = @_;
	321	my $r = close($fh);
	322
	323	# This may seem as though it should be in IO::Pipe, but the
	324	# object gets blessed out of IO::Pipe when reader/writer is called
	325	waitpid(${*$fh}{'io_pipe_pid'},0)
	326	if(defined ${*$fh}{'io_pipe_pid'});
	327
	328	$r;
	329	}
	330
	331	################################################
	332	## Normal I/O functions.
	333	##
	334
8add82fc	335	# flock
8add82fc	336	# select
8add82fc	337
	338	sub opened {
	339	@_ == 1 or croak 'usage: $fh->opened()';
	340	defined fileno($_[0]);
	341	}
	342
	343	sub fileno {
	344	@_ == 1 or croak 'usage: $fh->fileno()';
	345	fileno($_[0]);
	346	}
	347
	348	sub getc {
	349	@_ == 1 or croak 'usage: $fh->getc()';
	350	getc($_[0]);
	351	}
	352
	353	sub gets {
	354	@_ == 1 or croak 'usage: $fh->gets()';
	355	my ($handle) = @_;
	356	scalar <$handle>;
	357	}
	358
	359	sub eof {
	360	@_ == 1 or croak 'usage: $fh->eof()';
	361	eof($_[0]);
	362	}
	363
	364	sub print {
	365	@_ or croak 'usage: $fh->print([ARGS])';
	366	my $this = shift;
	367	print $this @_;
	368	}
	369
	370	sub printf {
	371	@_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
	372	my $this = shift;
	373	printf $this @_;
	374	}
	375
	376	sub getline {
	377	@_ == 1 or croak 'usage: $fh->getline';
	378	my $this = shift;
	379	return scalar <$this>;
	380	}
	381
	382	sub getlines {
	383	@_ == 1 or croak 'usage: $fh->getline()';
8add82fc	384	wantarray or
27d4819a	385	croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
27d4819a	386	my $this = shift;
8add82fc	387	return <$this>;
	388	}
	389
	390	sub truncate {
	391	@_ == 2 or croak 'usage: $fh->truncate(LEN)';
	392	truncate($_[0], $_[1]);
	393	}
	394
	395	sub read {
	396	@_ == 3 \|\| @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
	397	read($_[0], $_[1], $_[2], $_[3] \|\| 0);
	398	}
	399
27d4819a	400	sub sysread {
	401	@_ == 3 \|\| @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
	402	sysread($_[0], $_[1], $_[2], $_[3] \|\| 0);
	403	}
	404
8add82fc	405	sub write {
	406	@_ == 3 \|\| @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
	407	local($\) = "";
	408	print { $_[0] } substr($_[1], $_[3] \|\| 0, $_[2]);
	409	}
	410
27d4819a	411	sub syswrite {
27d4819a	412	@_ == 3 \|\| @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
5f05dabc	413	syswrite($_[0], $_[1], $_[2], $_[3] \|\| 0);
27d4819a	414	}
27d4819a	415
8add82fc	416	sub stat {
	417	@_ == 1 or croak 'usage: $fh->stat()';
	418	stat($_[0]);
	419	}
	420
	421	################################################
	422	## State modification functions.
	423	##
	424
	425	sub autoflush {
	426	my $old = new SelectSaver qualify($_[0], caller);
	427	my $prev = $\|;
	428	$\| = @_ > 1 ? $_[1] : 1;
	429	$prev;
	430	}
	431
	432	sub output_field_separator {
	433	my $old = new SelectSaver qualify($_[0], caller);
	434	my $prev = $,;
	435	$, = $_[1] if @_ > 1;
	436	$prev;
	437	}
	438
	439	sub output_record_separator {
	440	my $old = new SelectSaver qualify($_[0], caller);
	441	my $prev = $\;
	442	$\ = $_[1] if @_ > 1;
	443	$prev;
	444	}
	445
	446	sub input_record_separator {
	447	my $old = new SelectSaver qualify($_[0], caller);
	448	my $prev = $/;
	449	$/ = $_[1] if @_ > 1;
	450	$prev;
	451	}
	452
	453	sub input_line_number {
	454	my $old = new SelectSaver qualify($_[0], caller);
	455	my $prev = $.;
	456	$. = $_[1] if @_ > 1;
	457	$prev;
	458	}
	459
	460	sub format_page_number {
	461	my $old = new SelectSaver qualify($_[0], caller);
	462	my $prev = $%;
	463	$% = $_[1] if @_ > 1;
	464	$prev;
	465	}
	466
	467	sub format_lines_per_page {
	468	my $old = new SelectSaver qualify($_[0], caller);
	469	my $prev = $=;
	470	$= = $_[1] if @_ > 1;
	471	$prev;
	472	}
	473
	474	sub format_lines_left {
	475	my $old = new SelectSaver qualify($_[0], caller);
	476	my $prev = $-;
	477	$- = $_[1] if @_ > 1;
	478	$prev;
	479	}
480
481	sub format_name {
482	my $old = new SelectSaver qualify($_[0], caller);
483	my $prev = $~;
484	$~ = qualify($_[1], caller) if @_ > 1;
485	$prev;
486	}
487
488	sub format_top_name {
489	my $old = new SelectSaver qualify($_[0], caller);
490	my $prev = $^;
491	$^ = qualify($_[1], caller) if @_ > 1;
492	$prev;
493	}
494
495	sub format_line_break_characters {
496	my $old = new SelectSaver qualify($_[0], caller);
497	my $prev = $:;
498	$: = $_[1] if @_ > 1;
499	$prev;
500	}
501
502	sub format_formfeed {
503	my $old = new SelectSaver qualify($_[0], caller);
504	my $prev = $^L;
505	$^L = $_[1] if @_ > 1;
506	$prev;
507	}
508
509	sub formline {
510	my $fh = shift;
511	my $picture = shift;
512	local($^A) = $^A;
513	local($\) = "";
514	formline($picture, @_);
515	print $fh $^A;
516	}
517
518	sub format_write {
519	@_ < 3 \|\| croak 'usage: $fh->write( [FORMAT_NAME] )';
520	if (@_ == 2) {
521	my ($fh, $fmt) = @_;
522	my $oldfmt = $fh->format_name($fmt);
523	write($fh);
524	$fh->format_name($oldfmt);
525	} else {
526	write($_[0]);
527	}
528	}
529
27d4819a	530	sub fcntl {
	531	@_ == 3 \|\| croak 'usage: $fh->fcntl( OP, VALUE );';
	532	my ($fh, $op, $val) = @_;
	533	my $r = fcntl($fh, $op, $val);
	534	defined $r && $r eq "0 but true" ? 0 : $r;
	535	}
	536
	537	sub ioctl {
	538	@_ == 3 \|\| croak 'usage: $fh->ioctl( OP, VALUE );';
	539	my ($fh, $op, $val) = @_;
	540	my $r = ioctl($fh, $op, $val);
	541	defined $r && $r eq "0 but true" ? 0 : $r;
	542	}
8add82fc	543
8add82fc	544	1;