my $io = gensym;    shift;    IO::Handle::fdopen($io, @_)	or return undef;    bless $io, $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: $io->fdopen(FD, MODE)';    my ($io, $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($io, _open_mode_string($mode) . '&' . $fd)	? $io : undef;}sub close {    @_ == 1 or croak 'usage: $io->close()';    my($io) = @_;    close($io);}################################################## Normal I/O functions.### flock# selectsub opened {    @_ == 1 or croak 'usage: $io->opened()';    defined fileno($_[0]);}sub fileno {    @_ == 1 or croak 'usage: $io->fileno()';    fileno($_[0]);}sub getc {    @_ == 1 or croak 'usage: $io->getc()';    getc($_[0]);}sub eof {    @_ == 1 or croak 'usage: $io->eof()';    eof($_[0]);}sub print {    @_ or croak 'usage: $io->print(ARGS)';    my $this = shift;    print $this @_;}sub printf {    @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';    my $this = shift;    printf $this @_;}sub getline {    @_ == 1 or croak 'usage: $io->getline()';    my $this = shift;    return scalar <$this>;} *gets = \&getline;  # deprecatedsub getlines {    @_ == 1 or croak 'usage: $io->getlines()';    wantarray or	croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';    my $this = shift;    return <$this>;}sub truncate {    @_ == 2 or croak 'usage: $io->truncate(LEN)';    truncate($_[0], $_[1]);}sub read {    @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';    read($_[0], $_[1], $_[2], $_[3] || 0);}sub sysread {    @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';    sysread($_[0], $_[1], $_[2], $_[3] || 0);}sub write {    @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';    local($\) = "";    $_[2] = length($_[1]) unless defined $_[2];    print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);}sub syswrite {    @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';    if (defined($_[2])) {	syswrite($_[0], $_[1], $_[2], $_[3] || 0);    } else {	syswrite($_[0], $_[1]);    }}sub stat {    @_ == 1 or croak 'usage: $io->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 {    carp "output_field_separator is not supported on a per-handle basis"	if ref($_[0]);    my $prev = $,;    $, = $_[1] if @_ > 1;    $prev;}sub output_record_separator {    carp "output_record_separator is not supported on a per-handle basis"	if ref($_[0]);    my $prev = $\;    $\ = $_[1] if @_ > 1;    $prev;}sub input_record_separator {    carp "input_record_separator is not supported on a per-handle basis"	if ref($_[0]);    my $prev = $/;    $/ = $_[1] if @_ > 1;    $prev;}sub input_line_number {    local $.;    my $tell = tell qualify($_[0], caller) if ref($_[0]);    my $prev = $.;    $. = $_[1] if @_ > 1;    $prev;}sub format_page_number {    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);    my $prev = $%;    $% = $_[1] if @_ > 1;    $prev;}sub format_lines_per_page {    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);    my $prev = $=;    $= = $_[1] if @_ > 1;    $prev;}sub format_lines_left {    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);    my $prev = $-;    $- = $_[1] if @_ > 1;    $prev;}sub format_name {    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);    my $prev = $~;    $~ = qualify($_[1], caller) if @_ > 1;    $prev;}sub format_top_name {    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);    my $prev = $^;    $^ = qualify($_[1], caller) if @_ > 1;    $prev;}sub format_line_break_characters {    carp "format_line_break_characters is not supported on a per-handle basis"	if ref($_[0]);    my $prev = $:;    $: = $_[1] if @_ > 1;    $prev;}sub format_formfeed {    carp "format_formfeed is not supported on a per-handle basis"	if ref($_[0]);    my $prev = $^L;    $^L = $_[1] if @_ > 1;    $prev;}sub formline {    my $io = shift;    my $picture = shift;    local($^A) = $^A;    local($\) = "";    formline($picture, @_);    print $io $^A;}sub format_write {    @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';    if (@_ == 2) {	my ($io, $fmt) = @_;	my $oldfmt = $io->format_name($fmt);	CORE::write($io);	$io->format_name($oldfmt);    } else {	CORE::write($_[0]);    }}# XXX undocumentedsub fcntl {    @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';    my ($io, $op) = @_;    return fcntl($io, $op, $_[2]);}# XXX undocumentedsub ioctl {    @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';    my ($io, $op) = @_;    return ioctl($io, $op, $_[2]);}# this sub is for compatability with older releases of IO that used# a sub called constant to detemine if a constant existed -- GMB## The SEEK_* and _IO?BF constants were the only constants at that time# any new code should just chech defined(&CONSTANT_NAME)sub constant {    no strict 'refs';    my $name = shift;    (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})	? &{$name}() : undef;}# so that flush.pl can be depriciatedsub printflush {    my $io = shift;    my $old = new SelectSaver qualify($io, caller) if ref($io);    local $| = 1;    if(ref($io)) {        print $io @_;    }    else {	print @_;    }}1;