perl-5.6.0 + local changes

10 files changed, 897 insertions, 928 deletions

diff --git a/gnu/usr.bin/perl/ext/IO/IO.pm b/gnu/usr.bin/perl/ext/IO/IO.pm
index 4d4c81ce405..0087530c7e6 100644
--- a/gnu/usr.bin/perl/ext/IO/IO.pm
+++ b/gnu/usr.bin/perl/ext/IO/IO.pm
@@ -2,6 +2,24 @@
 
 package IO;
 
+use XSLoader ();
+use Carp;
+
+$VERSION = "1.20";
+XSLoader::load 'IO', $VERSION;
+
+sub import {
+    shift;
+    my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
+
+    eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
+	or croak $@;
+}
+
+1;
+
+__END__
+
 =head1 NAME
 
 IO - load various IO modules
@@ -20,17 +38,10 @@ Currently this includes:
       IO::File
       IO::Pipe
       IO::Socket
+      IO::Dir
 
 For more information on any of these modules, please see its respective
 documentation.
 
 =cut
 
-use IO::Handle;
-use IO::Seekable;
-use IO::File;
-use IO::Pipe;
-use IO::Socket;
-
-1;
-
diff --git a/gnu/usr.bin/perl/ext/IO/IO.xs b/gnu/usr.bin/perl/ext/IO/IO.xs
index 300581ed4e2..1b79cfd4c09 100644
--- a/gnu/usr.bin/perl/ext/IO/IO.xs
+++ b/gnu/usr.bin/perl/ext/IO/IO.xs
@@ -1,20 +1,20 @@
+/*
+ * Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+ * This program is free software; you can redistribute it and/or
+ * modify it under the same terms as Perl itself.
+ */
+
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
 #include "perl.h"
 #include "XSUB.h"
-
+#include "poll.h"
 #ifdef I_UNISTD
 #  include <unistd.h>
 #endif
-#ifdef I_FCNTL
-#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
-#define _NO_OLDNAMES
-#endif 
+#if defined(I_FCNTL) || defined(HAS_FCNTL)
 #  include <fcntl.h>
-#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
-#undef _NO_OLDNAMES
-#endif 
-
 #endif
 
 #ifdef PerlIO
@@ -28,6 +28,12 @@ typedef FILE * InputStream;
 typedef FILE * OutputStream;
 #endif
 
+#define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
+
+#ifndef gv_stashpvn
+#define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
+#endif
+
 static int
 not_here(char *s)
 {
@@ -35,56 +41,99 @@ not_here(char *s)
     return -1;
 }
 
-static bool
-constant(char *name, IV *pval)
-{
-    switch (*name) {
-    case '_':
-	if (strEQ(name, "_IOFBF"))
-#ifdef _IOFBF
-	    { *pval = _IOFBF; return TRUE; }
-#else
-	    return FALSE;
-#endif
-	if (strEQ(name, "_IOLBF"))
-#ifdef _IOLBF
-	    { *pval = _IOLBF; return TRUE; }
-#else
-	    return FALSE;
-#endif
-	if (strEQ(name, "_IONBF"))
-#ifdef _IONBF
-	    { *pval = _IONBF; return TRUE; }
-#else
-	    return FALSE;
+
+#ifndef PerlIO
+#define PerlIO_fileno(f) fileno(f)
 #endif
-	break;
-    case 'S':
-	if (strEQ(name, "SEEK_SET"))
-#ifdef SEEK_SET
-	    { *pval = SEEK_SET; return TRUE; }
+
+static int
+io_blocking(InputStream f, int block)
+{
+    int RETVAL;
+    if(!f) {
+	errno = EBADF;
+	return -1;
+    }
+#if defined(HAS_FCNTL)
+    RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+    if (RETVAL >= 0) {
+	int mode = RETVAL;
+#ifdef O_NONBLOCK
+	/* POSIX style */ 
+#if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK
+	/* Ooops has O_NDELAY too - make sure we don't 
+	 * get SysV behaviour by mistake. */
+
+	/* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
+	 * after a successful F_SETFL of an O_NONBLOCK. */
+	RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1;
+
+	if (block >= 0) {
+	    if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) {
+	        int ret;
+	        mode = (mode & ~O_NDELAY) | O_NONBLOCK;
+	        ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	        if(ret < 0)
+		    RETVAL = ret;
+	    }
+	    else
+              if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) {
+	        int ret;
+	        mode &= ~(O_NONBLOCK | O_NDELAY);
+	        ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	        if(ret < 0)
+		    RETVAL = ret;
+              }
+	}
 #else
-	    return FALSE;
-#endif
-	if (strEQ(name, "SEEK_CUR"))
-#ifdef SEEK_CUR
-	    { *pval = SEEK_CUR; return TRUE; }
+	/* Standard POSIX */ 
+	RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
+
+	if ((block == 0) && !(mode & O_NONBLOCK)) {
+	    int ret;
+	    mode |= O_NONBLOCK;
+	    ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	    if(ret < 0)
+		RETVAL = ret;
+	 }
+	else if ((block > 0) && (mode & O_NONBLOCK)) {
+	    int ret;
+	    mode &= ~O_NONBLOCK;
+	    ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	    if(ret < 0)
+		RETVAL = ret;
+	 }
+#endif 
 #else
-	    return FALSE;
+	/* Not POSIX - better have O_NDELAY or we can't cope.
+	 * for BSD-ish machines this is an acceptable alternative
+	 * for SysV we can't tell "would block" from EOF but that is 
+	 * the way SysV is...
+	 */
+	RETVAL = RETVAL & O_NDELAY ? 0 : 1;
+
+	if ((block == 0) && !(mode & O_NDELAY)) {
+	    int ret;
+	    mode |= O_NDELAY;
+	    ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	    if(ret < 0)
+		RETVAL = ret;
+	 }
+	else if ((block > 0) && (mode & O_NDELAY)) {
+	    int ret;
+	    mode &= ~O_NDELAY;
+	    ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+	    if(ret < 0)
+		RETVAL = ret;
+	 }
 #endif
-	if (strEQ(name, "SEEK_END"))
-#ifdef SEEK_END
-	    { *pval = SEEK_END; return TRUE; }
+    }
+    return RETVAL;
 #else
-	    return FALSE;
+ return -1;
 #endif
-	break;
-    }
-
-    return FALSE;
 }
 
-
 MODULE = IO	PACKAGE = IO::Seekable	PREFIX = f
 
 SV *
@@ -110,9 +159,9 @@ fsetpos(handle, pos)
 	InputStream	handle
 	SV *		pos
     CODE:
-	char *p;
-	STRLEN n_a;
-	if (handle && (p = SvPVx(pos, n_a)) && n_a == sizeof(Fpos_t))
+        char *p;
+	STRLEN len;
+	if (handle && (p = SvPV(pos,len)) && len == sizeof(Fpos_t))
 #ifdef PerlIO
 	    RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
 #else
@@ -144,24 +193,63 @@ new_tmpfile(packname = "IO::File")
 	if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
 	    ST(0) = sv_2mortal(newRV((SV*)gv));
 	    sv_bless(ST(0), gv_stashpv(packname, TRUE));
-	    SvREFCNT_dec(gv);	/* undo increment in newRV() */
+	    SvREFCNT_dec(gv);   /* undo increment in newRV() */
 	}
 	else {
 	    ST(0) = &PL_sv_undef;
 	    SvREFCNT_dec(gv);
 	}
 
+MODULE = IO	PACKAGE = IO::Poll
+
+void   
+_poll(timeout,...)
+	int timeout;
+PPCODE:
+{
+#ifdef HAS_POLL
+    int nfd = (items - 1) / 2;
+    SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
+    struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv);
+    int i,j,ret;
+    for(i=1, j=0  ; j < nfd ; j++) {
+	fds[j].fd = SvIV(ST(i));
+	i++;
+	fds[j].events = SvIV(ST(i));
+	i++;
+	fds[j].revents = 0;
+    }
+    if((ret = poll(fds,nfd,timeout)) >= 0) {
+	for(i=1, j=0 ; j < nfd ; j++) {
+	    sv_setiv(ST(i), fds[j].fd); i++;
+	    sv_setiv(ST(i), fds[j].revents); i++;
+	}
+    }
+    SvREFCNT_dec(tmpsv);
+    XSRETURN_IV(ret);
+#else
+	not_here("IO::Poll::poll");
+#endif
+}
+
+MODULE = IO	PACKAGE = IO::Handle	PREFIX = io_
+
+void
+io_blocking(handle,blk=-1)
+	InputStream	handle
+	int		blk
+PROTOTYPE: $;$
+CODE:
+{
+    int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0);
+    if(ret >= 0)
+	XSRETURN_IV(ret);
+    else
+	XSRETURN_UNDEF;
+}
+
 MODULE = IO	PACKAGE = IO::Handle	PREFIX = f
 
-SV *
-constant(name)
-	char *		name
-    CODE:
-	IV i;
-	if (constant(name, &i))
-	    ST(0) = sv_2mortal(newSViv(i));
-	else
-	    ST(0) = &PL_sv_undef;
 
 int
 ungetc(handle, c)
@@ -274,8 +362,7 @@ setvbuf(handle, buf, type, size)
 	int		type
 	int		size
     CODE:
-/* Should check HAS_SETVBUF once Configure tests for that */
-#if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
 	if (!handle)			/* Try input stream. */
 	    handle = IoIFP(sv_2io(ST(0)));
 	if (handle)
@@ -291,3 +378,84 @@ setvbuf(handle, buf, type, size)
 	RETVAL
 
 
+SysRet
+fsync(handle)
+	OutputStream handle
+    CODE:
+#ifdef HAS_FSYNC
+	if(handle)
+	    RETVAL = fsync(PerlIO_fileno(handle));
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+#else
+	RETVAL = (SysRet) not_here("IO::Handle::sync");
+#endif
+    OUTPUT:
+	RETVAL
+
+
+BOOT:
+{
+    HV *stash;
+    /*
+     * constant subs for IO::Poll
+     */
+    stash = gv_stashpvn("IO::Poll", 8, TRUE);
+#ifdef	POLLIN
+	newCONSTSUB(stash,"POLLIN",newSViv(POLLIN));
+#endif
+#ifdef	POLLPRI
+        newCONSTSUB(stash,"POLLPRI", newSViv(POLLPRI));
+#endif
+#ifdef	POLLOUT
+        newCONSTSUB(stash,"POLLOUT", newSViv(POLLOUT));
+#endif
+#ifdef	POLLRDNORM
+        newCONSTSUB(stash,"POLLRDNORM", newSViv(POLLRDNORM));
+#endif
+#ifdef	POLLWRNORM
+        newCONSTSUB(stash,"POLLWRNORM", newSViv(POLLWRNORM));
+#endif
+#ifdef	POLLRDBAND
+        newCONSTSUB(stash,"POLLRDBAND", newSViv(POLLRDBAND));
+#endif
+#ifdef	POLLWRBAND
+        newCONSTSUB(stash,"POLLWRBAND", newSViv(POLLWRBAND));
+#endif
+#ifdef	POLLNORM
+        newCONSTSUB(stash,"POLLNORM", newSViv(POLLNORM));
+#endif
+#ifdef	POLLERR
+        newCONSTSUB(stash,"POLLERR", newSViv(POLLERR));
+#endif
+#ifdef	POLLHUP
+        newCONSTSUB(stash,"POLLHUP", newSViv(POLLHUP));
+#endif
+#ifdef	POLLNVAL
+        newCONSTSUB(stash,"POLLNVAL", newSViv(POLLNVAL));
+#endif
+    /*
+     * constant subs for IO::Handle
+     */
+    stash = gv_stashpvn("IO::Handle", 10, TRUE);
+#ifdef _IOFBF
+        newCONSTSUB(stash,"_IOFBF", newSViv(_IOFBF));
+#endif
+#ifdef _IOLBF
+        newCONSTSUB(stash,"_IOLBF", newSViv(_IOLBF));
+#endif
+#ifdef _IONBF
+        newCONSTSUB(stash,"_IONBF", newSViv(_IONBF));
+#endif
+#ifdef SEEK_SET
+        newCONSTSUB(stash,"SEEK_SET", newSViv(SEEK_SET));
+#endif
+#ifdef SEEK_CUR
+        newCONSTSUB(stash,"SEEK_CUR", newSViv(SEEK_CUR));
+#endif
+#ifdef SEEK_END
+        newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
+#endif
+}
diff --git a/gnu/usr.bin/perl/ext/IO/Makefile.PL b/gnu/usr.bin/perl/ext/IO/Makefile.PL
index 6a2d50dc83c..095d7c2b511 100644
--- a/gnu/usr.bin/perl/ext/IO/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/IO/Makefile.PL
@@ -1,8 +1,9 @@
 use ExtUtils::MakeMaker;
+use Config qw(%Config);
+
 WriteMakefile(
-    NAME => 'IO',
-    MAN3PODS   => {},			# Pods will be built by installman.
-    XSPROTOARG => '-noprototypes', 	# XXX remove later?
-    VERSION_FROM => 'lib/IO/Handle.pm',
-    XS_VERSION => 1.15
+	VERSION_FROM	=> "IO.pm",
+	NAME      	=> "IO",
+	OBJECT		=> '$(O_FILES)', 
+	MAN3PODS	=> {},		# Pods will be built by installman.
 );
diff --git a/gnu/usr.bin/perl/ext/IO/README b/gnu/usr.bin/perl/ext/IO/README
index e855afade40..191d5504bc1 100644
--- a/gnu/usr.bin/perl/ext/IO/README
+++ b/gnu/usr.bin/perl/ext/IO/README
@@ -1,4 +1,5 @@
-This directory contains files from the IO distribution maintained by
-Graham Barr <bodg@tiuk.ti.com>. If you find that you have to modify
-any files in this directory then please forward him a patch for only
-the files in this directory.
+This directory contains files from the IO distribution created by
+Graham Barr.  It is currently maintained by the Perl Porters as part
+of the Perl source distribution. If you find that you have to modify
+any files in this directory then please forward them a patch at
+<perl5-porters@perl.org>.
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm
index de7fabc6f25..569c2800f80 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm
@@ -49,7 +49,7 @@ these classes with methods that are specific to file handles.
 
 =over 4
 
-=item new ([ ARGS ] )
+=item new ( FILENAME [,MODE [,PERMS]] )
 
 Creates a C<IO::File>.  If it receives any parameters, they are passed to
 the method C<open>; if the open fails, the object is destroyed.  Otherwise,
@@ -72,20 +72,21 @@ Otherwise, it is returned to the caller.
 =item open( FILENAME [,MODE [,PERMS]] )
 
 C<open> accepts one, two or three parameters.  With one parameter,
-it is just a front end for the built-in C<open> function.  With two
+it is just a front end for the built-in C<open> function.  With two or three
 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<IO::File::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.
+or a ANSI C fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator (but protects any special characters).
 
 If C<IO::File::open> is given a numeric mode, it passes that mode
 and the optional permissions value to the Perl C<sysopen> operator.
-For convenience, C<IO::File::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 IO::File will still work.
+The permissions default to 0666.
+
+For convenience, C<IO::File> exports the O_XXX constants from the
+Fcntl module, if this module is available.
 
 =back
 
@@ -98,24 +99,24 @@ L<IO::Seekable>
 
 =head1 HISTORY
 
-Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>.
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>.
 
 =cut
 
-require 5.000;
+require 5.005_64;
 use strict;
-use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
+our($VERSION, @EXPORT, @EXPORT_OK, @ISA);
 use Carp;
 use Symbol;
 use SelectSaver;
 use IO::Seekable;
+use File::Spec;
 
 require Exporter;
-require DynaLoader;
 
-@ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader);
+@ISA = qw(IO::Handle IO::Seekable Exporter);
 
-$VERSION = "1.06021";
+$VERSION = "1.08";
 
 @EXPORT = @IO::Seekable::EXPORT;
 
@@ -127,7 +128,6 @@ eval {
     push(@EXPORT, @O);
 };
 
-
 ################################################
 ## Constructor
 ##
@@ -158,7 +158,9 @@ sub open {
 	    defined $perms or $perms = 0666;
 	    return sysopen($fh, $file, $mode, $perms);
 	}
-	$file = './' . $file if $file =~ m{\A[^\\/\w]};
+	if (! File::Spec->file_name_is_absolute($file)) {
+            $file = File::Spec->catfile(File::Spec->curdir(),$file);
+        }
 	$file = IO::Handle::_open_mode_string($mode) . " $file\0";
     }
     open($fh, $file);
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
index 7927641f7f1..930df55fec8 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Handle.pm
@@ -9,21 +9,21 @@ IO::Handle - supply object methods for I/O handles
 
     use IO::Handle;
 
-    $fh = new IO::Handle;
-    if ($fh->fdopen(fileno(STDIN),"r")) {
-        print $fh->getline;
-        $fh->close;
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDIN),"r")) {
+        print $io->getline;
+        $io->close;
     }
 
-    $fh = new IO::Handle;
-    if ($fh->fdopen(fileno(STDOUT),"w")) {
-        $fh->print("Some text\n");
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDOUT),"w")) {
+        $io->print("Some text\n");
     }
 
     use IO::Handle '_IOLBF';
-    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+    $io->setvbuf($buffer_var, _IOLBF, 1024);
 
-    undef $fh;       # automatically closes the file if it's open
+    undef $io;       # automatically closes the file if it's open
 
     autoflush STDOUT 1;
 
@@ -36,9 +36,7 @@ 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)
+for C<IO::File> too.
 
 =head1 CONSTRUCTOR
 
@@ -63,87 +61,123 @@ 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
+    $io->close
+    $io->eof
+    $io->fileno
+    $io->format_write( [FORMAT_NAME] )
+    $io->getc
+    $io->read ( BUF, LEN, [OFFSET] )
+    $io->print ( ARGS )
+    $io->printf ( FMT, [ARGS] )
+    $io->stat
+    $io->sysread ( BUF, LEN, [OFFSET] )
+    $io->syswrite ( BUF, LEN, [OFFSET] )
+    $io->truncate ( LEN )
 
 See L<perlvar> for complete descriptions of each of the following
-supported C<IO::Handle> methods:
+supported C<IO::Handle> methods.  All of them return the previous
+value of the attribute and takes an optional single argument that when
+given will set the value.  If no argument is given the previous value
+is unchanged (except for $io->autoflush will actually turn ON
+autoflush by default).
 
-    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
+    $io->autoflush ( [BOOL] )                         $|
+    $io->format_page_number( [NUM] )                  $%
+    $io->format_lines_per_page( [NUM] )               $=
+    $io->format_lines_left( [NUM] )                   $-
+    $io->format_name( [STR] )                         $~
+    $io->format_top_name( [STR] )                     $^
+    $io->input_line_number( [NUM])                    $.
+
+The following methods are not supported on a per-filehandle basis.
+
+    IO::Handle->format_line_break_characters( [STR] ) $:
+    IO::Handle->format_formfeed( [STR])               $^L
+    IO::Handle->output_field_separator( [STR] )       $,
+    IO::Handle->output_record_separator( [STR] )      $\
+
+    IO::Handle->input_record_separator( [STR] )       $/
 
 Furthermore, for doing normal I/O you might need these:
 
 =over 
 
-=item $fh->fdopen ( FD, MODE )
+=item $io->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->opened
+=item $io->opened
 
 Returns true if the object is currently a valid file descriptor.
 
-=item $fh->getline
+=item $io->getline
 
-This works like <$fh> described in L<perlop/"I/O Operators">
+This works like <$io> 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
+=item $io->getlines
 
-This works like <$fh> when called in an array context to
+This works like <$io> 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->ungetc ( ORD )
+=item $io->ungetc ( ORD )
 
 Pushes a character with the given ordinal value back onto the given
-handle's input stream.
+handle's input stream.  Only one character of pushback per handle is
+guaranteed.
 
-=item $fh->write ( BUF, LEN [, OFFSET }\] )
+=item $io->write ( BUF, LEN [, OFFSET ] )
 
 This 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->flush
-
-Flush the given handle's buffer.
-
-=item $fh->error
+=item $io->error
 
 Returns a true value if the given handle has experienced any errors
 since it was opened or since the last call to C<clearerr>.
 
-=item $fh->clearerr
+=item $io->clearerr
 
 Clear the given handle's error indicator.
 
+=item $io->sync
+
+C<sync> synchronizes a file's in-memory state  with  that  on the
+physical medium. C<sync> does not operate at the perlio api level, but
+operates on the file descriptor, this means that any data held at the
+perlio api level will not be synchronized. To synchronize data that is
+buffered at the perlio api level you must use the flush method. C<sync>
+is not implemented on all platforms. See L<fsync(3c)>.
+
+=item $io->flush
+
+C<flush> causes perl to flush any buffered data at the perlio api level.
+Any unread data in the buffer will be discarded, and any unwritten data
+will be written to the underlying file descriptor.
+
+=item $io->printflush ( ARGS )
+
+Turns on autoflush, print ARGS and then restores the autoflush status of the
+C<IO::Handle> object.
+
+=item $io->blocking ( [ BOOL ] )
+
+If called with an argument C<blocking> will turn on non-blocking IO if
+C<BOOL> is false, and turn it off if C<BOOL> is true.
+
+C<blocking> will return the value of the previous setting, or the
+current setting if C<BOOL> is not given. 
+
+If an error occurs C<blocking> will return undef and C<$!> will be set.
+
 =back
 
+
 If the C functions setbuf() and/or setvbuf() are available, then
 C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
 policy for an IO::Handle.  The calling sequences for the Perl functions
@@ -152,7 +186,7 @@ C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
 specifies a scalar variable to use as a buffer.  WARNING: A variable
 used as a buffer by C<setbuf> or C<setvbuf> must not be modified in any
 way until the IO::Handle is closed or C<setbuf> or C<setvbuf> is called
-again, or memory corruption may result!  Note that you need to import
+again, or memory corruption may result! Note that you need to import
 the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly.
 
 Lastly, there is a special method for working under B<-T> and setuid/gid
@@ -160,7 +194,7 @@ scripts:
 
 =over
 
-=item $fh->untaint
+=item $io->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
@@ -171,7 +205,8 @@ vulnerability should be kept in mind.
 
 =head1 NOTE
 
-A C<IO::Handle> object is a GLOB reference. Some modules that
+A C<IO::Handle> object is a reference to a symbol/GLOB reference (see
+the C<Symbol> package).  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
@@ -193,22 +228,22 @@ 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>
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
 
 =cut
 
-require 5.000;
+require 5.005_64;
 use strict;
-use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
+our($VERSION, @EXPORT_OK, @ISA);
 use Carp;
 use Symbol;
 use SelectSaver;
+use IO ();	# Load the XS module
 
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = "1.1505";
-$XS_VERSION = "1.15";
+$VERSION = "1.21";
 
 @EXPORT_OK = qw(
     autoflush
@@ -230,6 +265,9 @@ $XS_VERSION = "1.15";
     getline
     getlines
 
+    printflush
+    flush
+
     SEEK_SET
     SEEK_CUR
     SEEK_END
@@ -238,30 +276,6 @@ $XS_VERSION = "1.15";
     _IONBF
 );
 
-
-################################################
-## 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.
 ##
@@ -269,18 +283,18 @@ sub AUTOLOAD {
 sub new {
     my $class = ref($_[0]) || $_[0] || "IO::Handle";
     @_ == 1 or croak "usage: new $class";
-    my $fh = gensym;
-    bless $fh, $class;
+    my $io = gensym;
+    bless $io, $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;
+    my $io = gensym;
     shift;
-    IO::Handle::fdopen($fh, @_)
+    IO::Handle::fdopen($io, @_)
 	or return undef;
-    bless $fh, $class;
+    bless $io, $class;
 }
 
 #
@@ -307,8 +321,8 @@ sub _open_mode_string {
 }
 
 sub fdopen {
-    @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
-    my ($fh, $fd, $mode) = @_;
+    @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
+    my ($io, $fd, $mode) = @_;
     local(*GLOB);
 
     if (ref($fd) && "".$fd =~ /GLOB\(/o) {
@@ -321,15 +335,15 @@ sub fdopen {
 	$fd = "=$fd";
     }
 
-    open($fh, _open_mode_string($mode) . '&' . $fd)
-	? $fh : undef;
+    open($io, _open_mode_string($mode) . '&' . $fd)
+	? $io : undef;
 }
 
 sub close {
-    @_ == 1 or croak 'usage: $fh->close()';
-    my($fh) = @_;
+    @_ == 1 or croak 'usage: $io->close()';
+    my($io) = @_;
 
-    close($fh);
+    close($io);
 }
 
 ################################################
@@ -340,39 +354,39 @@ sub close {
 # select
 
 sub opened {
-    @_ == 1 or croak 'usage: $fh->opened()';
+    @_ == 1 or croak 'usage: $io->opened()';
     defined fileno($_[0]);
 }
 
 sub fileno {
-    @_ == 1 or croak 'usage: $fh->fileno()';
+    @_ == 1 or croak 'usage: $io->fileno()';
     fileno($_[0]);
 }
 
 sub getc {
-    @_ == 1 or croak 'usage: $fh->getc()';
+    @_ == 1 or croak 'usage: $io->getc()';
     getc($_[0]);
 }
 
 sub eof {
-    @_ == 1 or croak 'usage: $fh->eof()';
+    @_ == 1 or croak 'usage: $io->eof()';
     eof($_[0]);
 }
 
 sub print {
-    @_ or croak 'usage: $fh->print([ARGS])';
+    @_ or croak 'usage: $io->print(ARGS)';
     my $this = shift;
     print $this @_;
 }
 
 sub printf {
-    @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
+    @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
     my $this = shift;
     printf $this @_;
 }
 
 sub getline {
-    @_ == 1 or croak 'usage: $fh->getline';
+    @_ == 1 or croak 'usage: $io->getline()';
     my $this = shift;
     return scalar <$this>;
 } 
@@ -380,41 +394,43 @@ sub getline {
 *gets = \&getline;  # deprecated
 
 sub getlines {
-    @_ == 1 or croak 'usage: $fh->getline()';
+    @_ == 1 or croak 'usage: $io->getlines()';
     wantarray or
-	croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
+	croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
     my $this = shift;
     return <$this>;
 }
 
 sub truncate {
-    @_ == 2 or croak 'usage: $fh->truncate(LEN)';
+    @_ == 2 or croak 'usage: $io->truncate(LEN)';
     truncate($_[0], $_[1]);
 }
 
 sub read {
-    @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
+    @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
     read($_[0], $_[1], $_[2], $_[3] || 0);
 }
 
 sub sysread {
-    @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
+    @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
     sysread($_[0], $_[1], $_[2], $_[3] || 0);
 }
 
 sub write {
-    @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
+    @_ >= 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 {
-    @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
+    @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
+    $_[2] = length($_[1]) unless defined $_[2];
     syswrite($_[0], $_[1], $_[2], $_[3] || 0);
 }
 
 sub stat {
-    @_ == 1 or croak 'usage: $fh->stat()';
+    @_ == 1 or croak 'usage: $io->stat()';
     stat($_[0]);
 }
 
@@ -423,32 +439,39 @@ sub stat {
 ##
 
 sub autoflush {
-    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    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 {
-    # localizing $. doesn't work as advertised.  grrrrrr.
+    local $.;
+    my $tell = tell qualify($_[0], caller) if ref($_[0]);
     my $prev = $.;
     $. = $_[1] if @_ > 1;
     $prev;
@@ -490,50 +513,82 @@ sub format_top_name {
 }
 
 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 $fh = shift;
+    my $io = shift;
     my $picture = shift;
     local($^A) = $^A;
     local($\) = "";
     formline($picture, @_);
-    print $fh $^A;
+    print $io $^A;
 }
 
 sub format_write {
-    @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )';
+    @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
     if (@_ == 2) {
-	my ($fh, $fmt) = @_;
-	my $oldfmt = $fh->format_name($fmt);
-	CORE::write($fh);
-	$fh->format_name($oldfmt);
+	my ($io, $fmt) = @_;
+	my $oldfmt = $io->format_name($fmt);
+	CORE::write($io);
+	$io->format_name($oldfmt);
     } else {
 	CORE::write($_[0]);
     }
 }
 
+# XXX undocumented
 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;
+    @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
+    my ($io, $op) = @_;
+    return fcntl($io, $op, $_[2]);
 }
 
+# XXX undocumented
 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;
+    @_ == 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 depriciated
+
+sub printflush {
+    my $io = shift;
+    my $old = new SelectSaver qualify($io, caller) if ref($io);
+    local $| = 1;
+    if(ref($io)) {
+        print $io @_;
+    }
+    else {
+	print @_;
+    }
 }
 
 1;
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
index 23c51b08319..27b5ad03e1a 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Pipe.pm
@@ -1,20 +1,20 @@
 # IO::Pipe.pm
 #
-# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package IO::Pipe;
 
-require 5.000;
+require 5.005_64;
 
 use IO::Handle;
 use strict;
-use vars qw($VERSION);
+our($VERSION);
 use Carp;
 use Symbol;
 
-$VERSION = "1.0902";
+$VERSION = "1.121";
 
 sub new {
     my $type = shift;
@@ -65,7 +65,7 @@ sub _doit {
         }
         bless $io, "IO::Handle";
         $io->fdopen($fh, $mode);
-        $fh->close;
+	$fh->close;
 
         if ($do_spawn) {
           $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
@@ -88,8 +88,12 @@ sub _doit {
 }
 
 sub reader {
-    @_ >= 1 or croak 'usage: $pipe->reader()';
+    @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
     my $me = shift;
+
+    return undef
+	unless(ref($me) || ref($me = $me->new));
+
     my $fh  = ${*$me}[0];
     my $pid = $me->_doit(0, $fh, @_)
         if(@_);
@@ -97,6 +101,8 @@ sub reader {
     close ${*$me}[1];
     bless $me, ref($fh);
     *$me = *$fh;          # Alias self to handle
+    $me->fdopen($fh->fileno,"r")
+	unless defined($me->fileno);
     bless $fh;                  # Really wan't un-bless here
     ${*$me}{'io_pipe_pid'} = $pid
         if defined $pid;
@@ -105,8 +111,12 @@ sub reader {
 }
 
 sub writer {
-    @_ >= 1 or croak 'usage: $pipe->writer()';
+    @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
     my $me = shift;
+
+    return undef
+	unless(ref($me) || ref($me = $me->new));
+
     my $fh  = ${*$me}[1];
     my $pid = $me->_doit(1, $fh, @_)
         if(@_);
@@ -114,6 +124,8 @@ sub writer {
     close ${*$me}[0];
     bless $me, ref($fh);
     *$me = *$fh;          # Alias self to handle
+    $me->fdopen($fh->fileno,"w")
+	unless defined($me->fileno);
     bless $fh;                  # Really wan't un-bless here
     ${*$me}{'io_pipe_pid'} = $pid
         if defined $pid;
@@ -123,7 +135,7 @@ sub writer {
 
 package IO::Pipe::End;
 
-use vars qw(@ISA);
+our(@ISA);
 
 @ISA = qw(IO::Handle);
 
@@ -143,7 +155,7 @@ __END__
 
 =head1 NAME
 
-IO::pipe - supply object methods for pipes
+IO::Pipe - supply object methods for pipes
 
 =head1 SYNOPSIS
 
@@ -228,12 +240,13 @@ L<IO::Handle>
 
 =head1 AUTHOR
 
-Graham Barr <bodg@tiuk.ti.com>
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
 
 =head1 COPYRIGHT
 
-Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
 
 =cut
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
index 86154c5722d..e09d48b9bff 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Seekable.pm
@@ -19,16 +19,17 @@ be inherited by other C<IO::Handle> based objects. It provides methods
 which allow seeking of the file descriptors.
 
 If the C functions fgetpos() and fsetpos() are available, then
-C<IO::File::getpos> returns an opaque value that represents the
-current position of the IO::File, and C<IO::File::setpos> uses
+C<$io-E<lt>getpos> returns an opaque value that represents the
+current position of the IO::File, and C<$io-E<gt>setpos(POS)> uses
 that value to return to a previously visited position.
 
 See L<perlfunc> for complete descriptions of each of the following
 supported C<IO::Seekable> methods, which are just front ends for the
 corresponding built-in functions:
 
-    seek
-    tell
+  $io->seek( POS, WHENCE )
+  $io->sysseek( POS, WHENCE )
+  $io->tell
 
 =head1 SEE ALSO
 
@@ -39,29 +40,37 @@ L<IO::File>
 
 =head1 HISTORY
 
-Derived from FileHandle.pm by Graham Barr E<lt>bodg@tiuk.ti.comE<gt>
+Derived from FileHandle.pm by Graham Barr E<lt>gbarr@pobox.comE<gt>
 
 =cut
 
-require 5.000;
+require 5.005_64;
 use Carp;
 use strict;
-use vars qw($VERSION @EXPORT @ISA);
-use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+our($VERSION, @EXPORT, @ISA);
+use IO::Handle ();
+# XXX we can't get these from IO::Handle or we'll get prototype
+# mismatch warnings on C<use POSIX; use IO::File;> :-(
+use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END);
 require Exporter;
 
 @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
 @ISA = qw(Exporter);
 
-$VERSION = "1.06";
+$VERSION = "1.08";
 
 sub seek {
-    @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)';
+    @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
     seek($_[0], $_[1], $_[2]);
 }
 
+sub sysseek {
+    @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)';
+    sysseek($_[0], $_[1], $_[2]);
+}
+
 sub tell {
-    @_ == 1 or croak 'usage: $fh->tell()';
+    @_ == 1 or croak 'usage: $io->tell()';
     tell($_[0]);
 }
 
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Select.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Select.pm
index dea684a62ed..df92b04b74f 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Select.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Select.pm
@@ -1,163 +1,17 @@
 # IO::Select.pm
 #
-# Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-# software; you can redistribute it and/or modify it under the same terms
-# as Perl itself.
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
 
 package IO::Select;
 
-=head1 NAME
-
-IO::Select - OO interface to the select system call
-
-=head1 SYNOPSIS
-
-    use IO::Select;
-
-    $s = IO::Select->new();
-
-    $s->add(\*STDIN);
-    $s->add($some_handle);
-
-    @ready = $s->can_read($timeout);
-
-    @ready = IO::Select->new(@handles)->read(0);
-
-=head1 DESCRIPTION
-
-The C<IO::Select> package implements an object approach to the system C<select>
-function call. It allows the user to see what IO handles, see L<IO::Handle>,
-are ready for reading, writing or have an error condition pending.
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ HANDLES ] )
-
-The constructor creates a new object and optionally initialises it with a set
-of handles.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item add ( HANDLES )
-
-Add the list of handles to the C<IO::Select> object. It is these values that
-will be returned when an event occurs. C<IO::Select> keeps these values in a
-cache which is indexed by the C<fileno> of the handle, so if more than one
-handle with the same C<fileno> is specified then only the last one is cached.
-
-Each handle can be an C<IO::Handle> object, an integer or an array
-reference where the first element is a C<IO::Handle> or an integer.
-
-=item remove ( HANDLES )
-
-Remove all the given handles from the object. This method also works
-by the C<fileno> of the handles. So the exact handles that were added
-need not be passed, just handles that have an equivalent C<fileno>
-
-=item exists ( HANDLE )
-
-Returns a true value (actually the handle itself) if it is present.
-Returns undef otherwise.
-
-=item handles
-
-Return an array of all registered handles.
-
-=item can_read ( [ TIMEOUT ] )
-
-Return an array of handles that are ready for reading. C<TIMEOUT> is
-the maximum amount of time to wait before returning an empty list. If
-C<TIMEOUT> is not given and any handles are registered then the call
-will block.
-
-=item can_write ( [ TIMEOUT ] )
-
-Same as C<can_read> except check for handles that can be written to.
-
-=item has_error ( [ TIMEOUT ] )
-
-Same as C<can_read> except check for handles that have an error
-condition, for example EOF.
-
-=item count ()
-
-Returns the number of handles that the object will check for when
-one of the C<can_> methods is called or the object is passed to
-the C<select> static method.
-
-=item bits()
-
-Return the bit string suitable as argument to the core select() call.
-
-=item bits()
-
-Return the bit string suitable as argument to the core select() call.
-
-=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
-
-C<select> is a static method, that is you call it with the package
-name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
-or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
-effect as for the core select call.
-
-The result will be an array of 3 elements, each a reference to an array
-which will hold the handles that are ready for reading, writing and have
-error conditions respectively. Upon error an empty array is returned.
-
-=back
-
-=head1 EXAMPLE
-
-Here is a short example which shows how C<IO::Select> could be used
-to write a server which communicates with several sockets while also
-listening for more connections on a listen socket
-
-    use IO::Select;
-    use IO::Socket;
-
-    $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
-    $sel = new IO::Select( $lsn );
-    
-    while(@ready = $sel->can_read) {
-        foreach $fh (@ready) {
-            if($fh == $lsn) {
-                # Create a new socket
-                $new = $lsn->accept;
-                $sel->add($new);
-            }
-            else {
-                # Process socket
-
-                # Maybe we have finished with the socket
-                $sel->remove($fh);
-                $fh->close;
-            }
-        }
-    }
-
-=head1 AUTHOR
-
-Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
-
-=cut
-
 use     strict;
+use warnings::register;
 use     vars qw($VERSION @ISA);
 require Exporter;
 
-$VERSION = "1.10";
+$VERSION = "1.14";
 
 @ISA = qw(Exporter); # This is only so we can do version checking
 
@@ -193,7 +47,9 @@ sub remove
 sub exists
 {
  my $vec = shift;
- $vec->[$vec->_fileno(shift) + FIRST_FD];
+ my $fno = $vec->_fileno(shift);
+ return undef unless defined $fno;
+ $vec->[$fno + FIRST_FD];
 }
 
 
@@ -261,7 +117,7 @@ sub can_write
     : ();
 }
 
-sub has_error
+sub has_exception
 {
  my $vec = shift;
  my $timeout = shift;
@@ -272,6 +128,13 @@ sub has_error
     : ();
 }
 
+sub has_error
+{
+ warnings::warn("Call to depreciated method 'has_error', use 'has_exception'")
+	if warnings::enabled();
+ goto &has_exception;
+}
+
 sub count
 {
  my $vec = shift;
@@ -369,3 +232,149 @@ sub handles
 }
 
 1;
+__END__
+
+=head1 NAME
+
+IO::Select - OO interface to the select system call
+
+=head1 SYNOPSIS
+
+    use IO::Select;
+
+    $s = IO::Select->new();
+
+    $s->add(\*STDIN);
+    $s->add($some_handle);
+
+    @ready = $s->can_read($timeout);
+
+    @ready = IO::Select->new(@handles)->read(0);
+
+=head1 DESCRIPTION
+
+The C<IO::Select> package implements an object approach to the system C<select>
+function call. It allows the user to see what IO handles, see L<IO::Handle>,
+are ready for reading, writing or have an error condition pending.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HANDLES ] )
+
+The constructor creates a new object and optionally initialises it with a set
+of handles.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item add ( HANDLES )
+
+Add the list of handles to the C<IO::Select> object. It is these values that
+will be returned when an event occurs. C<IO::Select> keeps these values in a
+cache which is indexed by the C<fileno> of the handle, so if more than one
+handle with the same C<fileno> is specified then only the last one is cached.
+
+Each handle can be an C<IO::Handle> object, an integer or an array
+reference where the first element is a C<IO::Handle> or an integer.
+
+=item remove ( HANDLES )
+
+Remove all the given handles from the object. This method also works
+by the C<fileno> of the handles. So the exact handles that were added
+need not be passed, just handles that have an equivalent C<fileno>
+
+=item exists ( HANDLE )
+
+Returns a true value (actually the handle itself) if it is present.
+Returns undef otherwise.
+
+=item handles
+
+Return an array of all registered handles.
+
+=item can_read ( [ TIMEOUT ] )
+
+Return an array of handles that are ready for reading. C<TIMEOUT> is
+the maximum amount of time to wait before returning an empty list. If
+C<TIMEOUT> is not given and any handles are registered then the call
+will block.
+
+=item can_write ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that can be written to.
+
+=item has_exception ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that have an exception
+condition, for example pending out-of-band data.
+
+=item count ()
+
+Returns the number of handles that the object will check for when
+one of the C<can_> methods is called or the object is passed to
+the C<select> static method.
+
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
+=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
+
+C<select> is a static method, that is you call it with the package
+name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
+or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
+effect as for the core select call.
+
+The result will be an array of 3 elements, each a reference to an array
+which will hold the handles that are ready for reading, writing and have
+error conditions respectively. Upon error an empty array is returned.
+
+=back
+
+=head1 EXAMPLE
+
+Here is a short example which shows how C<IO::Select> could be used
+to write a server which communicates with several sockets while also
+listening for more connections on a listen socket
+
+    use IO::Select;
+    use IO::Socket;
+
+    $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
+    $sel = new IO::Select( $lsn );
+
+    while(@ready = $sel->can_read) {
+        foreach $fh (@ready) {
+            if($fh == $lsn) {
+                # Create a new socket
+                $new = $lsn->accept;
+                $sel->add($new);
+            }
+            else {
+                # Process socket
+
+                # Maybe we have finished with the socket
+                $sel->remove($fh);
+                $fh->close;
+            }
+        }
+    }
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
index 2b4bc49daf7..6884f02cf86 100644
--- a/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
+++ b/gnu/usr.bin/perl/ext/IO/lib/IO/Socket.pm
@@ -1,129 +1,29 @@
 # IO::Socket.pm
 #
-# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package IO::Socket;
 
-=head1 NAME
-
-IO::Socket - Object interface to socket communications
-
-=head1 SYNOPSIS
-
-    use IO::Socket;
-
-=head1 DESCRIPTION
-
-C<IO::Socket> provides an object interface to creating and using sockets. It
-is built upon the L<IO::Handle> interface and inherits all the methods defined
-by L<IO::Handle>.
-
-C<IO::Socket> only defines methods for those operations which are common to all
-types of socket. Operations which are specified to a socket in a particular 
-domain have methods defined in sub classes of C<IO::Socket>
-
-C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ARGS] )
-
-Creates an C<IO::Socket>, which is a reference to a
-newly created symbol (see the C<Symbol> package). C<new>
-optionally takes arguments, these arguments are in key-value pairs.
-C<new> only looks for one key C<Domain> which tells new which domain
-the socket will be in. All other arguments will be passed to the
-configuration method of the package for that domain, See below.
-
-C<IO::Socket>s will be in autoflush mode after creation.  Note that
-versions of IO::Socket prior to 1.1603 (as shipped with Perl 5.004_04)
-did not do this.   So if you need backward compatibility, you should
-set autoflush explicitly.
-
-=back
-
-=head1 METHODS
-
-See L<perlfunc> for complete descriptions of each of the following
-supported C<IO::Socket> methods, which are just front ends for the
-corresponding built-in functions:
-
-    socket
-    socketpair
-    bind
-    listen
-    accept
-    send
-    recv
-    peername (getpeername)
-    sockname (getsockname)
-
-Some methods take slightly different arguments to those defined in L<perlfunc>
-in attempt to make the interface more flexible. These are
-
-=over 4
-
-=item accept([PKG])
-
-perform the system call C<accept> on the socket and return a new object. The
-new object will be created in the same class as the listen socket, unless
-C<PKG> is specified. This object can be used to communicate with the client
-that was trying to connect. In a scalar context the new socket is returned,
-or undef upon failure. In an array context a two-element array is returned
-containing the new socket and the peer address, the list will
-be empty upon failure.
-
-Additional methods that are provided are
-
-=item timeout([VAL])
-
-Set or get the timeout value associated with this socket. If called without
-any arguments then the current setting is returned. If called with an argument
-the current setting is changed and the previous value returned.
-
-=item sockopt(OPT [, VAL])
-
-Unified method to both set and get options in the SOL_SOCKET level. If called
-with one argument then getsockopt is called, otherwise setsockopt is called.
-
-=item sockdomain
-
-Returns the numerical number for the socket domain type. For example, for
-a AF_INET socket the value of &AF_INET will be returned.
-
-=item socktype
+require 5.005_64;
 
-Returns the numerical number for the socket type. For example, for
-a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
-
-=item protocol
-
-Returns the numerical number for the protocol being used on the socket, if
-known. If the protocol is unknown, as with an AF_UNIX socket, zero
-is returned.
-
-=back
-
-=cut
-
-
-require 5.000;
-
-use Config;
 use IO::Handle;
 use Socket 1.3;
 use Carp;
 use strict;
-use vars qw(@ISA $VERSION);
+our(@ISA, $VERSION);
 use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc');
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.1603";
+$VERSION = "1.26";
 
 sub import {
     my $pkg = shift;
@@ -133,16 +33,17 @@ sub import {
 
 sub new {
     my($class,%arg) = @_;
-    my $fh = $class->SUPER::new();
-    $fh->autoflush;
+    my $sock = $class->SUPER::new();
 
-    ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
+    $sock->autoflush(1);
 
-    return scalar(%arg) ? $fh->configure(\%arg)
-			: $fh;
+    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+    return scalar(%arg) ? $sock->configure(\%arg)
+			: $sock;
 }
 
-my @domain2pkg = ();
+my @domain2pkg;
 
 sub register_domain {
     my($p,$d) = @_;
@@ -150,7 +51,7 @@ sub register_domain {
 }
 
 sub configure {
-    my($fh,$arg) = @_;
+    my($sock,$arg) = @_;
     my $domain = delete $arg->{Domain};
 
     croak 'IO::Socket: Cannot configure a generic socket'
@@ -160,150 +61,167 @@ sub configure {
 	unless defined $domain2pkg[$domain];
 
     croak "IO::Socket: Cannot configure socket in domain '$domain'"
-	unless ref($fh) eq "IO::Socket";
+	unless ref($sock) eq "IO::Socket";
 
-    bless($fh, $domain2pkg[$domain]);
-    $fh->configure($arg);
+    bless($sock, $domain2pkg[$domain]);
+    $sock->configure($arg);
 }
 
 sub socket {
-    @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
-    my($fh,$domain,$type,$protocol) = @_;
+    @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+    my($sock,$domain,$type,$protocol) = @_;
 
-    socket($fh,$domain,$type,$protocol) or
+    socket($sock,$domain,$type,$protocol) or
     	return undef;
 
-    ${*$fh}{'io_socket_domain'} = $domain;
-    ${*$fh}{'io_socket_type'}   = $type;
-    ${*$fh}{'io_socket_proto'}  = $protocol;
+    ${*$sock}{'io_socket_domain'} = $domain;
+    ${*$sock}{'io_socket_type'}   = $type;
+    ${*$sock}{'io_socket_proto'}  = $protocol;
 
-    $fh;
+    $sock;
 }
 
 sub socketpair {
-    @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+    @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
     my($class,$domain,$type,$protocol) = @_;
-    my $fh1 = $class->new();
-    my $fh2 = $class->new();
+    my $sock1 = $class->new();
+    my $sock2 = $class->new();
 
-    socketpair($fh1,$fh2,$domain,$type,$protocol) or
+    socketpair($sock1,$sock2,$domain,$type,$protocol) or
     	return ();
 
-    ${*$fh1}{'io_socket_type'}  = ${*$fh2}{'io_socket_type'}  = $type;
-    ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
+    ${*$sock1}{'io_socket_type'}  = ${*$sock2}{'io_socket_type'}  = $type;
+    ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
 
-    ($fh1,$fh2);
+    ($sock1,$sock2);
 }
 
 sub connect {
-    @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
-    my $fh = shift;
-    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
-    my $timeout = ${*$fh}{'io_socket_timeout'};
-    local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
-				 : $SIG{ALRM} || 'DEFAULT';
-
-     eval {
-    	croak 'connect: Bad address'
-    	    if(@_ == 2 && !defined $_[1]);
-
-    	if($timeout) {
-    	    defined $Config{d_alarm} && defined alarm($timeout) or
-    	    	$timeout = 0;
-    	}
-
-	my $ok = connect($fh, $addr);
-
-    	alarm(0)
-    	    if($timeout);
+    @_ == 2 or croak 'usage: $sock->connect(NAME)';
+    my $sock = shift;
+    my $addr = shift;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
+    my $err;
+    my $blocking;
+    $blocking = $sock->blocking(0) if $timeout;
+
+    if (!connect($sock, $addr)) {
+	if ($timeout && $!{EINPROGRESS}) {
+	    require IO::Select;
+
+	    my $sel = new IO::Select $sock;
+
+	    if (!$sel->can_write($timeout)) {
+		$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+		$@ = "connect: timeout";
+	    }
+	    elsif(!connect($sock,$addr) && not $!{EISCONN}) {
+		# Some systems refuse to re-connect() to
+		# an already open socket and set errno to EISCONN.
+		$err = $!;
+		$@ = "connect: $!";
+	    }
+	}
+	else {
+	    $err = $!;
+	    $@ = "connect: $!";
+	}
+    }
 
-	croak "connect: timeout"
-	    unless defined $fh;
+    $sock->blocking(1) if $blocking;
 
-	undef $fh unless $ok;
-    };
+    $! = $err if $err;
 
-    $fh;
+    $err ? undef : $sock;
 }
 
 sub bind {
-    @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
-    my $fh = shift;
-    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+    @_ == 2 or croak 'usage: $sock->bind(NAME)';
+    my $sock = shift;
+    my $addr = shift;
 
-    return bind($fh, $addr) ? $fh
-			    : undef;
+    return bind($sock, $addr) ? $sock
+			      : undef;
 }
 
 sub listen {
-    @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
-    my($fh,$queue) = @_;
+    @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+    my($sock,$queue) = @_;
     $queue = 5
 	unless $queue && $queue > 0;
 
-    return listen($fh, $queue) ? $fh
-			       : undef;
+    return listen($sock, $queue) ? $sock
+				 : undef;
 }
 
 sub accept {
-    @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
-    my $fh = shift;
-    my $pkg = shift || $fh;
-    my $timeout = ${*$fh}{'io_socket_timeout'};
+    @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+    my $sock = shift;
+    my $pkg = shift || $sock;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
     my $new = $pkg->new(Timeout => $timeout);
     my $peer = undef;
 
-    eval {
-    	if($timeout) {
-    	    my $fdset = "";
-    	    vec($fdset, $fh->fileno,1) = 1;
-    	    croak "accept: timeout"
-    	    	unless select($fdset,undef,undef,$timeout);
-    	}
-    	$peer = accept($new,$fh);
-    };
-
-    return wantarray ? defined $peer ? ($new, $peer)
-    	    	    	    	     : () 
-    	      	     : defined $peer ? $new
-    	    	    	    	     : undef;
+    if($timeout) {
+	require IO::Select;
+
+	my $sel = new IO::Select $sock;
+
+	unless ($sel->can_read($timeout)) {
+	    $@ = 'accept: timeout';
+	    $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+	    return;
+	}
+    }
+
+    $peer = accept($new,$sock)
+	or return;
+
+    return wantarray ? ($new, $peer)
+    	      	     : $new;
 }
 
 sub sockname {
-    @_ == 1 or croak 'usage: $fh->sockname()';
+    @_ == 1 or croak 'usage: $sock->sockname()';
     getsockname($_[0]);
 }
 
 sub peername {
-    @_ == 1 or croak 'usage: $fh->peername()';
-    my($fh) = @_;
-    getpeername($fh)
-      || ${*$fh}{'io_socket_peername'}
+    @_ == 1 or croak 'usage: $sock->peername()';
+    my($sock) = @_;
+    getpeername($sock)
+      || ${*$sock}{'io_socket_peername'}
       || undef;
 }
 
+sub connected {
+    @_ == 1 or croak 'usage: $sock->connected()';
+    my($sock) = @_;
+    getpeername($sock);
+}
+
 sub send {
-    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
-    my $fh    = $_[0];
+    @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+    my $sock  = $_[0];
     my $flags = $_[2] || 0;
-    my $peer  = $_[3] || $fh->peername;
+    my $peer  = $_[3] || $sock->peername;
 
     croak 'send: Cannot determine peer address'
 	 unless($peer);
 
-    my $r = defined(getpeername($fh))
-	? send($fh, $_[1], $flags)
-	: send($fh, $_[1], $flags, $peer);
+    my $r = defined(getpeername($sock))
+	? send($sock, $_[1], $flags)
+	: send($sock, $_[1], $flags, $peer);
 
     # remember who we send to, if it was sucessful
-    ${*$fh}{'io_socket_peername'} = $peer
+    ${*$sock}{'io_socket_peername'} = $peer
 	if(@_ == 4 && defined $r);
 
     $r;
 }
 
 sub recv {
-    @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
+    @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
     my $sock  = $_[0];
     my $len   = $_[2];
     my $flags = $_[3] || 0;
@@ -312,16 +230,21 @@ sub recv {
     ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
 }
 
+sub shutdown {
+    @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+    my($sock, $how) = @_;
+    shutdown($sock, $how);
+}
 
 sub setsockopt {
-    @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
+    @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
     setsockopt($_[0],$_[1],$_[2],$_[3]);
 }
 
 my $intsize = length(pack("i",0));
 
 sub getsockopt {
-    @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
+    @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
     my $r = getsockopt($_[0],$_[1],$_[2]);
     # Just a guess
     $r = unpack("i", $r)
@@ -330,399 +253,176 @@ sub getsockopt {
 }
 
 sub sockopt {
-    my $fh = shift;
-    @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
-	    : $fh->setsockopt(SOL_SOCKET,@_);
+    my $sock = shift;
+    @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+	    : $sock->setsockopt(SOL_SOCKET,@_);
 }
 
 sub timeout {
-    @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
-    my($fh,$val) = @_;
-    my $r = ${*$fh}{'io_socket_timeout'} || undef;
+    @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+    my($sock,$val) = @_;
+    my $r = ${*$sock}{'io_socket_timeout'} || undef;
 
-    ${*$fh}{'io_socket_timeout'} = 0 + $val
+    ${*$sock}{'io_socket_timeout'} = 0 + $val
 	if(@_ == 2);
 
     $r;
 }
 
 sub sockdomain {
-    @_ == 1 or croak 'usage: $fh->sockdomain()';
-    my $fh = shift;
-    ${*$fh}{'io_socket_domain'};
+    @_ == 1 or croak 'usage: $sock->sockdomain()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_domain'};
 }
 
 sub socktype {
-    @_ == 1 or croak 'usage: $fh->socktype()';
-    my $fh = shift;
-    ${*$fh}{'io_socket_type'}
+    @_ == 1 or croak 'usage: $sock->socktype()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_type'}
 }
 
 sub protocol {
-    @_ == 1 or croak 'usage: $fh->protocol()';
-    my($fh) = @_;
-    ${*$fh}{'io_socket_protocol'};
+    @_ == 1 or croak 'usage: $sock->protocol()';
+    my($sock) = @_;
+    ${*$sock}{'io_socket_proto'};
 }
 
-=head1 SUB-CLASSES
-
-=cut
-
-##
-## AF_INET
-##
-
-package IO::Socket::INET;
-
-use strict;
-use vars qw(@ISA);
-use Socket;
-use Carp;
-use Exporter;
-
-@ISA = qw(IO::Socket);
-
-IO::Socket::INET->register_domain( AF_INET );
-
-my %socket_type = ( tcp => SOCK_STREAM,
-		    udp => SOCK_DGRAM,
-		    icmp => SOCK_RAW,
-		  );
-
-=head2 IO::Socket::INET
-
-C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
-and some related methods. The constructor can take the following options
-
-    PeerAddr	Remote host address          <hostname>[:<port>]
-    PeerPort	Remote port or service       <service>[(<no>)] | <no>
-    LocalAddr	Local host bind	address      hostname[:port]
-    LocalPort	Local host bind	port         <service>[(<no>)] | <no>
-    Proto	Protocol name (or number)    "tcp" | "udp" | ...
-    Type	Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
-    Listen	Queue size for listen
-    Reuse	Set SO_REUSEADDR before binding
-    Timeout	Timeout	value for various operations
-
+1;
 
-If C<Listen> is defined then a listen socket is created, else if the
-socket type, which is derived from the protocol, is SOCK_STREAM then
-connect() is called.
+__END__
 
-The C<PeerAddr> can be a hostname or the IP-address on the
-"xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
-service name.  The service name might be followed by a number in
-parenthesis which is used if the service is not known by the system.
-The C<PeerPort> specification can also be embedded in the C<PeerAddr>
-by preceding it with a ":".
-
-If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
-then the constructor will try to derive C<Proto> from the service
-name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
-parameter will be deduced from C<Proto> if not specified.
+=head1 NAME
 
-If the constructor is only passed a single argument, it is assumed to
-be a C<PeerAddr> specification.
+IO::Socket - Object interface to socket communications
 
-Examples:
+=head1 SYNOPSIS
 
-   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
-                                 PeerPort => 'http(80)',
-                                 Proto    => 'tcp');
+    use IO::Socket;
 
-   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+=head1 DESCRIPTION
 
-   $sock = IO::Socket::INET->new(Listen    => 5,
-                                 LocalAddr => 'localhost',
-                                 LocalPort => 9000,
-                                 Proto     => 'tcp');
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
 
-   $sock = IO::Socket::INET->new('127.0.0.1:25');
+C<IO::Socket> only defines methods for those operations which are common to all
+types of socket. Operations which are specified to a socket in a particular 
+domain have methods defined in sub classes of C<IO::Socket>
 
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
 
-=head2 METHODS
+=head1 CONSTRUCTOR
 
 =over 4
 
-=item sockaddr ()
-
-Return the address part of the sockaddr structure for the socket
-
-=item sockport ()
-
-Return the port number that the socket is using on the local host
-
-=item sockhost ()
-
-Return the address part of the sockaddr structure for the socket in a
-text form xx.xx.xx.xx
-
-=item peeraddr ()
-
-Return the address part of the sockaddr structure for the socket on
-the peer host
+=item new ( [ARGS] )
 
-=item peerport ()
+Creates an C<IO::Socket>, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+C<new> only looks for one key C<Domain> which tells new which domain
+the socket will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
 
-Return the port number for the socket on the peer host.
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 
-=item peerhost ()
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
 
-Return the address part of the sockaddr structure for the socket on the
-peer host in a text form xx.xx.xx.xx
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 
 =back
 
-=cut
-
-sub new
-{
-  my $class = shift;
-  unshift(@_, "PeerAddr") if @_ == 1;
-  return $class->SUPER::new(@_);
-}
-
-sub _sock_info {
-  my($addr,$port,$proto) = @_;
-  my @proto = ();
-  my @serv = ();
-
-  $port = $1
-	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
-
-  if(defined $proto) {
-    @proto = $proto =~ m,\D, ? getprotobyname($proto)
-			     : getprotobynumber($proto);
-
-    $proto = $proto[2] || undef;
-  }
-
-  if(defined $port) {
-    $port =~ s,\((\d+)\)$,,;
-
-    my $defport = $1 || undef;
-    my $pnum = ($port =~ m,^(\d+)$,)[0];
-
-    @serv= getservbyname($port, $proto[0] || "")
-	if($port =~ m,\D,);
-
-    $port = $pnum || $serv[2] || $defport || undef;
-
-    $proto = (getprotobyname($serv[3]))[2] || undef
-	if @serv && !$proto;
-  }
-
- return ($addr || undef,
-	 $port || undef,
-	 $proto || undef
-	);
-}
-
-sub _error {
-    my $fh = shift;
-    $@ = join("",ref($fh),": ",@_);
-    carp $@ if $^W;
-    close($fh)
-	if(defined fileno($fh));
-    return undef;
-}
-
-sub configure {
-    my($fh,$arg) = @_;
-    my($lport,$rport,$laddr,$raddr,$proto,$type);
-
-
-    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
-					$arg->{LocalPort},
-					$arg->{Proto});
-
-    $laddr = defined $laddr ? inet_aton($laddr)
-			    : INADDR_ANY;
-
-    return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
-	unless(defined $laddr);
-
-    unless(exists $arg->{Listen}) {
-	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
-					    $arg->{PeerPort},
-					    $proto);
-    }
-
-    if(defined $raddr) {
-	$raddr = inet_aton($raddr);
-	return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
-		unless(defined $raddr);
-    }
-
-    $proto ||= (getprotobyname "tcp")[2];
-    return _error($fh,'Cannot determine protocol')
-	unless($proto);
-
-    my $pname = (getprotobynumber($proto))[0];
-    $type = $arg->{Type} || $socket_type{$pname};
-
-    $fh->socket(AF_INET, $type, $proto) or
-	return _error($fh,"$!");
-
-    if ($arg->{Reuse}) {
-	$fh->sockopt(SO_REUSEADDR,1) or
-		return _error($fh);
-    }
-
-    $fh->bind($lport || 0, $laddr) or
-	return _error($fh,"$!");
-
-    if(exists $arg->{Listen}) {
-	$fh->listen($arg->{Listen} || 5) or
-	    return _error($fh,"$!");
-    }
-    else {
-	return _error($fh,'Cannot determine remote port')
-		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
-
-	if($type == SOCK_STREAM || defined $raddr) {
-	    return _error($fh,'Bad peer address')
-	    	unless(defined $raddr);
-
-	    $fh->connect($rport,$raddr) or
-		return _error($fh,"$!");
-	}
-    }
-
-    $fh;
-}
-
-sub sockaddr {
-    @_ == 1 or croak 'usage: $fh->sockaddr()';
-    my($fh) = @_;
-    (sockaddr_in($fh->sockname))[1];
-}
-
-sub sockport {
-    @_ == 1 or croak 'usage: $fh->sockport()';
-    my($fh) = @_;
-    (sockaddr_in($fh->sockname))[0];
-}
-
-sub sockhost {
-    @_ == 1 or croak 'usage: $fh->sockhost()';
-    my($fh) = @_;
-    inet_ntoa($fh->sockaddr);
-}
-
-sub peeraddr {
-    @_ == 1 or croak 'usage: $fh->peeraddr()';
-    my($fh) = @_;
-    (sockaddr_in($fh->peername))[1];
-}
-
-sub peerport {
-    @_ == 1 or croak 'usage: $fh->peerport()';
-    my($fh) = @_;
-    (sockaddr_in($fh->peername))[0];
-}
+=head1 METHODS
 
-sub peerhost {
-    @_ == 1 or croak 'usage: $fh->peerhost()';
-    my($fh) = @_;
-    inet_ntoa($fh->peeraddr);
-}
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
 
-##
-## AF_UNIX
-##
+    socket
+    socketpair
+    bind
+    listen
+    accept
+    send
+    recv
+    peername (getpeername)
+    sockname (getsockname)
+    shutdown
 
-package IO::Socket::UNIX;
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
 
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
+=over 4
 
-@ISA = qw(IO::Socket);
+=item accept([PKG])
 
-IO::Socket::UNIX->register_domain( AF_UNIX );
+perform the system call C<accept> on the socket and return a new object. The
+new object will be created in the same class as the listen socket, unless
+C<PKG> is specified. This object can be used to communicate with the client
+that was trying to connect. In a scalar context the new socket is returned,
+or undef upon failure. In an array context a two-element array is returned
+containing the new socket and the peer address; the list will
+be empty upon failure.
 
-=head2 IO::Socket::UNIX
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
 
-C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
-and some related methods. The constructor can take the following options
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
 
-    Type    	Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
-    Local   	Path to local fifo
-    Peer    	Path to peer fifo
-    Listen  	Create a listen socket
+=back
 
-=head2 METHODS
+Additional methods that are provided are:
 
 =over 4
 
-=item hostpath()
+=item timeout([VAL])
 
-Returns the pathname to the fifo at the local end
+Set or get the timeout value associated with this socket. If called without
+any arguments then the current setting is returned. If called with an argument
+the current setting is changed and the previous value returned.
 
-=item peerpath()
+=item sockopt(OPT [, VAL])
 
-Returns the pathname to the fifo at the peer end
+Unified method to both set and get options in the SOL_SOCKET level. If called
+with one argument then getsockopt is called, otherwise setsockopt is called.
 
-=back
+=item sockdomain
 
-=cut
+Returns the numerical number for the socket domain type. For example, for
+a AF_INET socket the value of &AF_INET will be returned.
 
-sub configure {
-    my($fh,$arg) = @_;
-    my($bport,$cport);
+=item socktype
 
-    my $type = $arg->{Type} || SOCK_STREAM;
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
 
-    $fh->socket(AF_UNIX, $type, 0) or
-	return undef;
+=item protocol
 
-    if(exists $arg->{Local}) {
-	my $addr = sockaddr_un($arg->{Local});
-	$fh->bind($addr) or
-	    return undef;
-    }
-    if(exists $arg->{Listen}) {
-	$fh->listen($arg->{Listen} || 5) or
-	    return undef;
-    }
-    elsif(exists $arg->{Peer}) {
-	my $addr = sockaddr_un($arg->{Peer});
-	$fh->connect($addr) or
-	    return undef;
-    }
+Returns the numerical number for the protocol being used on the socket, if
+known. If the protocol is unknown, as with an AF_UNIX socket, zero
+is returned.
 
-    $fh;
-}
+=item connected
 
-sub hostpath {
-    @_ == 1 or croak 'usage: $fh->hostpath()';
-    my $n = $_[0]->sockname || return undef;
-    (sockaddr_un($n))[0];
-}
+If the socket is in a connected state the the peer address is returned.
+If the socket is not in a connected state then undef will be returned.
 
-sub peerpath {
-    @_ == 1 or croak 'usage: $fh->peerpath()';
-    my $n = $_[0]->peername || return undef;
-    (sockaddr_un($n))[0];
-}
+=back
 
 =head1 SEE ALSO
 
-L<Socket>, L<IO::Handle>
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
 
 =head1 AUTHOR
 
-Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
 
 =head1 COPYRIGHT
 
-Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
 
 =cut
-
-1; # Keep require happy