Move IO from ext/ to dist/

36 files changed, 6100 insertions, 0 deletions

diff --git a/dist/IO/.gitignore b/dist/IO/.gitignore
new file mode 100644
index 0000000000..577c726243
--- /dev/null
+++ b/dist/IO/.gitignore
@@ -0,0 +1 @@
+!/poll.c
diff --git a/dist/IO/ChangeLog b/dist/IO/ChangeLog
new file mode 100644
index 0000000000..6913c646e1
--- /dev/null
+++ b/dist/IO/ChangeLog
@@ -0,0 +1,364 @@
+IO 1.25 -- Wed May 13 18:37:33 CDT 2009
+  * Fix test warnings in io_dir
+  * skip tests known to cause a segfault 5.10.0
+
+IO 1.24 -- Mon May 11 14:15:51 CDT 2009
+
+  * Make Makefile.PL usable by core and CPAN
+  * Reorganize files to be under lib/ directory structure now matches core perl
+  * Update with following changes made to core perl distribution
+  * Silence Win32 compiler warning in IO.xs
+  * Make non-blocking mode work on Windows in IO::Socket::INET
+  * fix some missing parts of IO::Handle pod
+  * Implement IO::Handle::say the same way as the builtin say().
+  * Undo io_linenum.t part of #34148. It was io_multihomed.t that I meant (my mistake), and that is now covered by #34155.
+  * watchdog() some IO tests
+  * Some more missing isGV_with_GP()s
+  * IO::Dir destructor
+  * IO::Socket::INET unnecessarily resolves "udp"
+  * IO::Handle->say should ignore $\ (bug #49266)
+  * consting IO.xs
+  * Net::SMTP can't send large messages with bleadperl
+  * Fix for IO::Socket send method
+  * Fixes for the test suite on OS/2
+  * Silence VC++ compiler warnings
+  * IO::Socket's IO.xs fails to compile
+  * IO::Socket::connect returns wrong errno on timeout
+  * Coverity correctly reports that gv might (just) be NULL. So don't derefernece it if it is.
+  * Simplify tests for fork() capabilities
+  * Fix syntax error in io_pipe test
+  * Making IO::Socket pass test on Win32
+  * ext/IO/t/io_unix.t
+
+IO 1.23 -- Sat Mar 25 19:28:28 CST 2006
+
+ * Adjust the regression tests to use t/test.pl when $ENV{PERL_CORE} is defined
+ * Reduce number of calls to getpeername
+ * Call qualify on format name passed to format_write. Bug reported by Johan Vromans
+ * Reduce calls to getprotobyname/number. Patch from Gisle Aas
+ * Remove references to file TEST used in core so appropriate tests are skipped
+   during an install from CPAN
+ * Add method say to IO::Handle
+ * Performance improvement for IO::File::open
+ * Don't warn about a directory being closed in the DESTROY
+
+IO 1.22 -- Mon Sep  5 10:29:35 CDT 2005
+
+ * Update with changes made in perl core distribution
+
+Change 173 on 1998/07/14 by <gbarr@pobox.com> (Graham Barr)
+
+	IO::Socket
+	- Added method connected
+	
+	IO.xs
+	- Added check that file * is not null
+	
+	t/io_udp.t
+	- Added check for connected
+	- Made change to catch recv not returning the address, and added a fix to
+	  ensure test does not hang
+	
+	t/io_sock.t
+	- Added check for connected.
+
+Change 137 on 1998/05/21 by <gbarr@pobox.com> (Graham Barr)
+
+	IO::Socket::INET
+	- Added checks to all peer* and host* methods for undef
+
+Change 134 on 1998/05/09 by <gbarr@pobox.com> (Graham Barr)
+
+	t/io_sock.t
+	- fix race condition on Solaris & SunOS
+	
+	IO::Handle
+	- Applied patch from Gisle Aas <gisle@aas.no> for
+	    documentation update
+	- Applied patch from Kuma <tgy@chocobo.org>
+	    changed input_line_number to be on a per-handle basis.
+	
+	IO::File
+	- Applied patch from Gisle Aas <gisle@aas.no> for
+	    documentation update
+	
+	IO::Seekable
+	- Applied patch from Gisle Aas <gisle@aas.no> for
+	    documentation update
+	    added sysseek
+	
+	IO, IO::Socket::INET
+	- documentation update
+	
+	IO.xs
+	- Applied patch from Gisle Aas <gisle@aas.no> for
+	   blocking
+
+Change 133 on 1998/05/09 by <gbarr@pobox.com> (Graham Barr)
+
+	t/io_sock.t
+	- Added checks for blocking()
+
+Sun Apr 12 1998 <gbarr@pobox.com> (Graham Barr)
+
+	IO.xs
+	- enclosed newCONSTSUB in #ifdef as _64 now defines it.
+
+Thu Mar 19 1998 <gbarr@pobox.com> (Graham Barr)
+
+	All
+	- Changed copyright/distribution policy back to be the same as perl
+
+Sun Feb 15 1998 <gbarr@pobox.com> (Graham Barr)
+
+	IO::Socket
+	- Fix to ->accept, accept() returns false on error not undef.
+
+*** Release 1.19
+
+Thu Feb  5 1998 <gbarr@pobox.com> (Graham Barr)
+
+	All
+	- change copyright notice
+	
+	IO::Socket::INET
+	- changed configure to accept PeerHost and LocalHost as well as the
+	  PeerAddr and LocalAddr arguments.
+
+Mon Feb  2 1998 <gbarr@pobox.com> (Graham Barr)
+
+	IO::Handle
+	- Added printflush so that flush.pl can be depreciated
+
+	IO::Socket
+	- Remove C<use Config> statement as it was not needed
+
+Tue Jan 27 1998 <gbarr@pobox.com> (Graham Barr)
+
+	IO::Socket::INET
+	- removed carp if $^W
+
+*** Patch 1.1804
+
+Sat Jan 17 1998 <gbarr@pobox.com> (Graham Barr)
+
+	t/io_sock.t
+	- Replaced C<Listen => 0> with C<LocalAddr => 'localhost'>
+	
+	IO/Socket/INET.pm
+	- Modified the MultiHomed code. Now each address for a given host has
+	  a timeout of C<Timeout>.
+	- added _get_addr method for doing hostname lookups. Now Net::DNS can be
+	  use by sub-classing IO::Socket::INET, Thanks Gisle Aas
+	
+	t/io_multihomed.t
+	- new test added. Thanks Gisle Aas.
+
+*** Patch 1.1803
+
+Mon Nov 17 1997 <gbarr@pobox.com> (Graham Barr)
+
+	poll.c
+	- Added #ifdef I_* tests
+	
+	IO::Socket
+	- Changed initialization of @domain2pkg to fix problem of Domain option
+	  not working
+	- Added patch for multi-homed hosts, Thanks to Gisle Aas <gisle@aas.no>
+	
+	IO::Socket::INET
+	- Change default proto to getprotobyname instead of 'tcp' constant string
+	- Added patch for multi-homed hosts, Thanks to Gisle Aas <gisle@aas.no>
+	
+	t/io_sock.t
+	- Change to test fix for Domain problem fixed in IO::Socket and be
+	  more comprehensive, Thanks to Gisle Aas <gisle@aas.no>
+	
+	t/io_unix.t
+	- New test, Thanks to Gisle Aas <gisle@aas.no>
+
+*** Patch 1.1802
+
+Wed Nov 12 1997 <gbarr@pobox.com> (Graham Barr)
+
+	t/io_poll.t
+	- test 4 made an assumption that was not portable, fixed.
+
+*** Patch 1.1801
+
+Wed Oct 22 1997 <gbarr@pobox.com> (Graham Barr)
+
+	IO.xs
+	- change #ifdef's to allow compilation with 5.002
+	
+	IO::Socket
+	- Fix to ensure that socket is not returned as non-blocking
+	  unless the user asks for it
+
+	t/io_udp.t
+	- Fix to stop endless loop
+
+*** Release 1.18
+
+Mon Oct 13 1997 <gbarr@pobox.com> (Graham Barr)
+
+	IO.xs, IO::Handle
+	- 1.17 broke compatability with 5.003, small tweaks to restore
+	  compatability
+	
+	t/io_const.t
+	- Added new test to ensure backwards compatability with constants
+	  is not broken
+
+Wed Oct  8 1997 <gbarr@pobox.com> (Graham Barr)
+
+	IO.xs
+	- Added #define's to cope with argument changes to start_subparse
+	  from 5.003_22, _23 and _24
+	
+	IO::Select
+	- Renamed has_error to be has_exception which is more correct,
+	  has_error is a wrapper around has_exception with a warning if
+	  $^W is set.
+	
+	Makefile.PL
+	- Remove 'linkext' option to WriteMakefile so that static linking
+	  should work properly, cannot remember why I added it.
+
+Sun Oct  5 1997 <gbarr@pobox.com> (Graham Barr)
+
+	IO::Pipe
+	- GLOB assignment does not copy the fileno while under -T
+	  added checks for undefined fileno, and added fdopen
+	- reader and write can now be called as static methods
+
+	Makefile.PL
+	- Attempt to locate <poll.h> and define I_POLL if found
+
+*** Release 1.17
+
+Fri Sep 26 1997 <gbarr@pobox.com> (Graham Barr)
+
+	IO.xs
+	- Fix bug in _poll for ANSI C compilers
+	
+	IO::Socket
+	- Split IO::Socket::INET and IO::Socket::UNIX into separate files
+	
+	IO::File
+	- Patch to open() for when file is in current directory.
+
+*** Release 1.16
+
+Mon 15 Sep 1997 <gbarr@pobox.com> Graham Barr
+
+	o New modules
+	  - IO::Dir
+	  - IO::Poll
+
+	o IO::Socket
+	  - Changed new to call autoflush on the new socket
+	  - IO::Socket::INET->new now accepts a single argument
+	  - IO::Socket::INET default to protocol 'tcp'
+	
+	o IO::File
+	  - Added doc for new_tmpfile
+	
+	o IO::Handle
+	  - Removed use of AutoLoader for constants, constants are
+	    now defined as constant XS subs
+	  - Added fsync, but will not be avaliable for use
+	    unless HAS_FSYNC is defined, perls configure does not define
+	    this yet.
+	  - Moved bootstrap of IO.xs to IO.pm. IO::Handle no longer
+	    contains an AUTOLOAD sub in it's ISA hier
+
+	o IO::Seekable
+	  - Remove clearerr, as it is defined in IO.xs
+
+	o IO.xs
+	  - Patched IO.xs with patch from Chip for setvbuf warning
+	  - Added XS sub "constant" for backwards compatability
+
+	o Misc
+	  - Fixed IO::Socket::configure, it was not passing $arg to domain
+	    specific package
+	  - Changed all $fh variables in IO::Handle to $io and all $fh
+	    variables in IO::Socket to $sock as Chip suggested
+	  - Fixed usage messages to be consistant
+
+*** Release 1.15
+
+Sun 19 Jan 1997 <bodg@tiuk.ti.com> Graham Barr
+
+	o Updated PODs for IO::Handle and IO::File
+	o Modified IO.xs so that DESTROY gets called on IO::File
+	  objects that were created with IO::File->new_tmpfile
+	o Modified the domain2pkg code in IO::Socket so that it
+	  does not use blessd refs
+	o Created a new package IO::Pipe::End so that pipe specific
+	  stuff can be moved out of IO::Handle.
+	o Added Ilya's OS/2 changes to Pipe.pm and io_pipe.t
+
+	o These changes happened somtime before the release of 1.15
+	  - added shutdown to IO::Socket
+	  - modified connect to not use alarm
+	  - modified accept and connect to use IO::Select
+
+*** Release 1.14
+
+Tue 24 Dec 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o Updated to patches in perl core dist.
+	o Added C<use strict> to all modules
+	o Modified t/io_sock.t, hopefully the race condition has gone
+	o Added close statements to reader/writer in IO::Pipe
+	o IO::Handle::syswrite was calling sysread, fixed :-)
+
+*** Release 1.12
+
+Thu 19 Sep 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o Modified IO.xs so that it will compile with pre perlio version
+	  of perl (ie pre perl5.003_02)
+	o Modified IO::Socket::send so not to pass 4 arguments to send
+	  if the socket is connected
+
+*** Release 1.10
+
+Mon 11 Sep 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o Fixed a bug in IO::Socket which caused DESTROY to be called
+	  on a partly initialised connection
+	o Changed IO.xs to use Perlio
+	o Modified usage message to report correct package
+	o Added IO::File::new changes from Chip, to allow PERM to be passed
+	o Added sysread and syswrite methods to IO::Handle
+	o Updated documentation
+	o Fixed a bug in IO::Select that caused a hang if the last handle
+	  was removed.
+	o Added count method to IO::Select
+	o Renamed and modified tests so that they can be copied into the
+	  perl distribution
+	o Added fcntl and ioctl methods to IO::Handle
+
+Thu 25 Jul 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o It is now not necessary to call the domain sub-classes of
+	  IO::Socket. when connect is called it notes the domain.
+	  Domain specific methods, which are normally non-critical, are
+	  called via this note-ing.
+	o Added methods to IO::Socket to retrieve the domain, type and
+	  protocol of a given socket
+
+Tue 23 Jul 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o IO::Socket::connect changed how we do timeouts, as it did not work
+
+	o IO::Handle::new_from_fd removed method call to _ref_fd, which was
+	  a leftover from FileHandle
+
+Fri 28 Jun 1996 <bodg@tiuk.ti.com> Graham Barr
+
+	o Modified IO::Socket::UNIX::configure to default to using a socket
+	  type of SOCK_STREAM if no type is specified.
diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm
new file mode 100644
index 0000000000..a72e2243d7
--- /dev/null
+++ b/dist/IO/IO.pm
@@ -0,0 +1,68 @@
+#
+
+package IO;
+
+use XSLoader ();
+use Carp;
+use strict;
+use warnings;
+
+our $VERSION = "1.25";
+XSLoader::load 'IO', $VERSION;
+
+sub import {
+    shift;
+
+    warnings::warnif('deprecated', qq{Parameterless "use IO" deprecated})
+        if @_ == 0 ;
+    
+    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
+
+=head1 SYNOPSIS
+
+    use IO qw(Handle File);  # loads IO modules, here IO::Handle, IO::File
+    use IO;                  # DEPRECATED
+
+=head1 DESCRIPTION
+
+C<IO> provides a simple mechanism to load several of the IO modules
+in one go.  The IO modules belonging to the core are:
+
+      IO::Handle
+      IO::Seekable
+      IO::File
+      IO::Pipe
+      IO::Socket
+      IO::Dir
+      IO::Select
+      IO::Poll
+
+Some other IO modules don't belong to the perl core but can be loaded
+as well if they have been installed from CPAN.  You can discover which
+ones exist by searching for "^IO::" on http://search.cpan.org.
+
+For more information on any of these modules, please see its respective
+documentation.
+
+=head1 DEPRECATED
+
+    use IO;                # loads all the modules listed below
+
+The loaded modules are IO::Handle, IO::Seekable, IO::File, IO::Pipe,
+IO::Socket, IO::Dir.  You should instead explicitly import the IO
+modules you want.
+
+=cut
+
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
new file mode 100644
index 0000000000..d3dff557a2
--- /dev/null
+++ b/dist/IO/IO.xs
@@ -0,0 +1,541 @@
+/*
+ * 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_EXT_IO
+
+#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
+#if defined(I_FCNTL) || defined(HAS_FCNTL)
+#  include <fcntl.h>
+#endif
+
+#ifndef SIOCATMARK
+#   ifdef I_SYS_SOCKIO
+#       include <sys/sockio.h>
+#   endif
+#endif
+
+#ifdef PerlIO
+#if defined(MACOS_TRADITIONAL) && defined(USE_SFIO)
+#define PERLIO_IS_STDIO 1
+#undef setbuf
+#undef setvbuf
+#define setvbuf		_stdsetvbuf
+#define setbuf(f,b)	( __sf_setbuf(f,b) )
+#endif
+typedef int SysRet;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
+#else
+#define PERLIO_IS_STDIO 1
+typedef int SysRet;
+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
+
+#ifndef __attribute__noreturn__
+#  define __attribute__noreturn__
+#endif
+
+#ifndef NORETURN_FUNCTION_END
+# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
+#endif
+
+static int not_here(const char *s) __attribute__noreturn__;
+static int
+not_here(const char *s)
+{
+    croak("%s not implemented on this architecture", s);
+    NORETURN_FUNCTION_END;
+}
+
+
+#ifndef PerlIO
+#define PerlIO_fileno(f) fileno(f)
+#endif
+
+static int
+io_blocking(pTHX_ InputStream f, int block)
+{
+#if defined(HAS_FCNTL)
+    int RETVAL;
+    if(!f) {
+	errno = EBADF;
+	return -1;
+    }
+    RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+    if (RETVAL >= 0) {
+	int mode = RETVAL;
+	int newmode = mode;
+#ifdef O_NONBLOCK
+	/* POSIX style */
+
+# ifndef O_NDELAY
+#  define O_NDELAY O_NONBLOCK
+# endif
+	/* Note: 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) {
+	    newmode &= ~O_NDELAY;
+	    newmode |= O_NONBLOCK;
+	} else if (block > 0) {
+	    newmode &= ~(O_NDELAY|O_NONBLOCK);
+	}
+#else
+	/* 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) {
+	    newmode |= O_NDELAY;
+	} else if (block > 0) {
+	    newmode &= ~O_NDELAY;
+	}
+#endif
+	if (newmode != mode) {
+	    const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
+	    if (ret < 0)
+		RETVAL = ret;
+	}
+    }
+    return RETVAL;
+#else
+#   ifdef WIN32
+    char flags = (char)block;
+    return ioctl(PerlIO_fileno(f), FIONBIO, &flags);
+#   else
+    return -1;
+#   endif
+#endif
+}
+
+MODULE = IO	PACKAGE = IO::Seekable	PREFIX = f
+
+void
+fgetpos(handle)
+	InputStream	handle
+    CODE:
+	if (handle) {
+#ifdef PerlIO
+#if PERL_VERSION < 8
+	    Fpos_t pos;
+	    ST(0) = sv_newmortal();
+	    if (PerlIO_getpos(handle, &pos) != 0) {
+		ST(0) = &PL_sv_undef;
+	    }
+	    else {
+		sv_setpvn(ST(0), (char *)&pos, sizeof(Fpos_t));
+	    }
+#else
+	    ST(0) = sv_newmortal();
+	    if (PerlIO_getpos(handle, ST(0)) != 0) {
+		ST(0) = &PL_sv_undef;
+	    }
+#endif
+#else
+	    Fpos_t pos;
+	    if (fgetpos(handle, &pos)) {
+		ST(0) = &PL_sv_undef;
+	    } else {
+		ST(0) = sv_2mortal(newSVpvn((char*)&pos, sizeof(Fpos_t)));
+	    }
+#endif
+	}
+	else {
+	    errno = EINVAL;
+	    ST(0) = &PL_sv_undef;
+	}
+
+SysRet
+fsetpos(handle, pos)
+	InputStream	handle
+	SV *		pos
+    CODE:
+	if (handle) {
+#ifdef PerlIO
+#if PERL_VERSION < 8
+	    char *p;
+	    STRLEN len;
+	    if (SvOK(pos) && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
+		RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+	    }
+	    else {
+		RETVAL = -1;
+		errno = EINVAL;
+	    }
+#else
+	    RETVAL = PerlIO_setpos(handle, pos);
+#endif
+#else
+	    char *p;
+	    STRLEN len;
+	    if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
+		RETVAL = fsetpos(handle, (Fpos_t*)p);
+	    }
+	    else {
+		RETVAL = -1;
+		errno = EINVAL;
+	    }
+#endif
+	}
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+MODULE = IO	PACKAGE = IO::File	PREFIX = f
+
+void
+new_tmpfile(packname = "IO::File")
+    const char * packname
+    PREINIT:
+	OutputStream fp;
+	GV *gv;
+    CODE:
+#ifdef PerlIO
+	fp = PerlIO_tmpfile();
+#else
+	fp = tmpfile();
+#endif
+	gv = (GV*)SvREFCNT_inc(newGVgen(packname));
+	if (gv)
+	    hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
+	if (gv && 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() */
+	}
+	else {
+	    ST(0) = &PL_sv_undef;
+	    SvREFCNT_dec(gv);
+	}
+
+MODULE = IO	PACKAGE = IO::Poll
+
+void
+_poll(timeout,...)
+	int timeout;
+PPCODE:
+{
+#ifdef HAS_POLL
+    const 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 = (short)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:
+{
+    const int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0);
+    if(ret >= 0)
+	XSRETURN_IV(ret);
+    else
+	XSRETURN_UNDEF;
+}
+
+MODULE = IO	PACKAGE = IO::Handle	PREFIX = f
+
+int
+ungetc(handle, c)
+	InputStream	handle
+	int		c
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_ungetc(handle, c);
+#else
+	    RETVAL = ungetc(c, handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+ferror(handle)
+	InputStream	handle
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_error(handle);
+#else
+	    RETVAL = ferror(handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+clearerr(handle)
+	InputStream	handle
+    CODE:
+	if (handle) {
+#ifdef PerlIO
+	    PerlIO_clearerr(handle);
+#else
+	    clearerr(handle);
+#endif
+	    RETVAL = 0;
+	}
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+untaint(handle)
+       SV *	handle
+    CODE:
+#ifdef IOf_UNTAINT
+	IO * io;
+	io = sv_2io(handle);
+	if (io) {
+	    IoFLAGS(io) |= IOf_UNTAINT;
+	    RETVAL = 0;
+	}
+        else {
+#endif
+	    RETVAL = -1;
+	    errno = EINVAL;
+#ifdef IOf_UNTAINT
+	}
+#endif
+    OUTPUT:
+	RETVAL
+
+SysRet
+fflush(handle)
+	OutputStream	handle
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_flush(handle);
+#else
+	    RETVAL = Fflush(handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+void
+setbuf(handle, ...)
+	OutputStream	handle
+    CODE:
+	if (handle)
+#ifdef PERLIO_IS_STDIO
+        {
+	    char *buf = items == 2 && SvPOK(ST(1)) ?
+	      sv_grow(ST(1), BUFSIZ) : 0;
+	    setbuf(handle, buf);
+	}
+#else
+	    not_here("IO::Handle::setbuf");
+#endif
+
+SysRet
+setvbuf(...)
+    CODE:
+	if (items != 4)
+            Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)");
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
+    {
+        OutputStream	handle = 0;
+	char *		buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
+	int		type;
+	int		size;
+
+	if (items == 4) {
+	    handle = IoOFP(sv_2io(ST(0)));
+	    buf    = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
+	    type   = (int)SvIV(ST(2));
+	    size   = (int)SvIV(ST(3));
+	}
+	if (!handle)			/* Try input stream. */
+	    handle = IoIFP(sv_2io(ST(0)));
+	if (items == 4 && handle)
+	    RETVAL = setvbuf(handle, buf, type, size);
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    }
+#else
+	RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
+#endif
+    OUTPUT:
+	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
+
+
+MODULE = IO	PACKAGE = IO::Socket
+
+SysRet
+sockatmark (sock)
+   InputStream sock
+   PROTOTYPE: $
+   PREINIT:
+     int fd;
+   CODE:
+   {
+     fd = PerlIO_fileno(sock);
+#ifdef HAS_SOCKATMARK
+     RETVAL = sockatmark(fd);
+#else
+     {
+       int flag = 0;
+#   ifdef SIOCATMARK
+#     if defined(NETWARE) || defined(WIN32)
+       if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0)
+#     else
+       if (ioctl(fd, SIOCATMARK, &flag) != 0)
+#     endif
+	 XSRETURN_UNDEF;
+#   else
+       not_here("IO::Socket::atmark");
+#   endif
+       RETVAL = flag;
+     }
+#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/dist/IO/Makefile.PL b/dist/IO/Makefile.PL
new file mode 100644
index 0000000000..2159f43e49
--- /dev/null
+++ b/dist/IO/Makefile.PL
@@ -0,0 +1,45 @@
+# This -*- perl -*- script makes the Makefile
+
+BEGIN { require 5.006_001 }
+use ExtUtils::MakeMaker;
+use Config qw(%Config);
+my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV;
+
+#--- Attempt to find <poll.h>
+
+my $define = "";
+
+unless ($PERL_CORE or exists $Config{'i_poll'}) {
+  my @inc = split(/\s+/, join(" ", $Config{'usrinc'}, $Config{'incpth'}, $Config{'locincpth'}));
+  foreach $path (@inc) {
+    if (-f $path . "/poll.h") {
+      $define .= "-DI_POLL ";
+      last;
+    }
+  }
+}
+
+if ($] < 5.008 and !$PERL_CORE) {
+  open(FH,">typemap");
+  print FH "const char *            T_PV\n";
+  close(FH);
+}
+
+#--- Write the Makefile
+
+WriteMakefile(
+  VERSION_FROM => "IO.pm",
+  NAME         => "IO",
+  OBJECT       => '$(O_FILES)',
+  ABSTRACT     => 'Perl core IO modules',
+  AUTHOR       => 'Graham Barr <gbarr@cpan.org>',
+  ( $PERL_CORE
+    ? ()
+    : (
+      INSTALLDIRS => 'perl',
+      clean       => {FILES => 'typemap'},
+    )
+  ),
+  ($define                                    ? (DEFINE    => $define) : ()),
+  ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? ('LICENSE' => 'perl')  : ()),
+);
diff --git a/dist/IO/README b/dist/IO/README
new file mode 100644
index 0000000000..e4d9dfad55
--- /dev/null
+++ b/dist/IO/README
@@ -0,0 +1,27 @@
+This is the perl5 IO distribution.
+
+This distribution is included in the perl5 core distribution. You should
+only need to install this distribution if it is newer than your perl
+installation.
+
+To install this distribution you will need access rights to the perl
+install ation on your system, as it overwrites your currently installed
+version of IO.
+
+This distribution relies upon the Socket module (version 1.3), which is
+avaliable from CPAN. Although you should not need to get this if your
+version of perl is fairly recent, as Socket is also distributed in the
+core perl distribution.
+
+If you do not have the required modules, you will see a warning when 
+the Makefile is built.
+
+To build, test and install this distribution type:
+
+ perl Makefile.PL
+ make test
+ make install
+
+Share and Enjoy!
+Graham Barr <gbarr@pobox.com>
+
diff --git a/dist/IO/hints/sco.pl b/dist/IO/hints/sco.pl
new file mode 100644
index 0000000000..ddcf1551d1
--- /dev/null
+++ b/dist/IO/hints/sco.pl
@@ -0,0 +1,2 @@
+# SCO OSR5 needs to link with libc.so again to have C<fsync> defined
+$self->{LIBS} = ['-lc'];
diff --git a/dist/IO/lib/IO/Dir.pm b/dist/IO/lib/IO/Dir.pm
new file mode 100644
index 0000000000..cce392c2ce
--- /dev/null
+++ b/dist/IO/lib/IO/Dir.pm
@@ -0,0 +1,248 @@
+# IO::Dir.pm
+#
+# 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::Dir;
+
+use 5.006;
+
+use strict;
+use Carp;
+use Symbol;
+use Exporter;
+use IO::File;
+our(@ISA, $VERSION, @EXPORT_OK);
+use Tie::Hash;
+use File::stat;
+use File::Spec;
+
+@ISA = qw(Tie::Hash Exporter);
+$VERSION = "1.07";
+$VERSION = eval $VERSION;
+@EXPORT_OK = qw(DIR_UNLINK);
+
+sub DIR_UNLINK () { 1 }
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [DIRNAME]';
+    my $class = shift;
+    my $dh = gensym;
+    if (@_) {
+	IO::Dir::open($dh, $_[0])
+	    or return undef;
+    }
+    bless $dh, $class;
+}
+
+sub DESTROY {
+    my ($dh) = @_;
+    local($., $@, $!, $^E, $?);
+    no warnings 'io';
+    closedir($dh);
+}
+
+sub open {
+    @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
+    my ($dh, $dirname) = @_;
+    return undef
+	unless opendir($dh, $dirname);
+    # a dir name should always have a ":" in it; assume dirname is
+    # in current directory
+    $dirname = ':' .  $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) );
+    ${*$dh}{io_dir_path} = $dirname;
+    1;
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $dh->close()';
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub read {
+    @_ == 1 or croak 'usage: $dh->read()';
+    my ($dh) = @_;
+    readdir($dh);
+}
+
+sub seek {
+    @_ == 2 or croak 'usage: $dh->seek(POS)';
+    my ($dh,$pos) = @_;
+    seekdir($dh,$pos);
+}
+
+sub tell {
+    @_ == 1 or croak 'usage: $dh->tell()';
+    my ($dh) = @_;
+    telldir($dh);
+}
+
+sub rewind {
+    @_ == 1 or croak 'usage: $dh->rewind()';
+    my ($dh) = @_;
+    rewinddir($dh);
+}
+
+sub TIEHASH {
+    my($class,$dir,$options) = @_;
+
+    my $dh = $class->new($dir)
+	or return undef;
+
+    $options ||= 0;
+
+    ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK;
+    $dh;
+}
+
+sub FIRSTKEY {
+    my($dh) = @_;
+    $dh->rewind;
+    scalar $dh->read;
+}
+
+sub NEXTKEY {
+    my($dh) = @_;
+    scalar $dh->read;
+}
+
+sub EXISTS {
+    my($dh,$key) = @_;
+    -e File::Spec->catfile(${*$dh}{io_dir_path}, $key);
+}
+
+sub FETCH {
+    my($dh,$key) = @_;
+    &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key));
+}
+
+sub STORE {
+    my($dh,$key,$data) = @_;
+    my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
+    my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
+    unless(-e $file) {
+	my $io = IO::File->new($file,O_CREAT | O_RDWR);
+	$io->close if $io;
+    }
+    utime($atime,$mtime, $file);
+}
+
+sub DELETE {
+    my($dh,$key) = @_;
+
+    # Only unlink if unlink-ing is enabled
+    return 0
+	unless ${*$dh}{io_dir_unlink};
+
+    my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
+
+    -d $file
+	? rmdir($file)
+	: unlink($file);
+}
+
+1;
+
+__END__
+
+=head1 NAME 
+
+IO::Dir - supply object methods for directory handles
+
+=head1 SYNOPSIS
+
+    use IO::Dir;
+    $d = IO::Dir->new(".");
+    if (defined $d) {
+        while (defined($_ = $d->read)) { something($_); }
+        $d->rewind;
+        while (defined($_ = $d->read)) { something_else($_); }
+        undef $d;
+    }
+
+    tie %dir, 'IO::Dir', ".";
+    foreach (keys %dir) {
+	print $_, " " , $dir{$_}->size,"\n";
+    }
+
+=head1 DESCRIPTION
+
+The C<IO::Dir> package provides two interfaces to perl's directory reading
+routines.
+
+The first interface is an object approach. C<IO::Dir> provides an object
+constructor and methods, which are just wrappers around perl's built in
+directory reading routines.
+
+=over 4
+
+=item new ( [ DIRNAME ] )
+
+C<new> is the constructor for C<IO::Dir> objects. It accepts one optional
+argument which,  if given, C<new> will pass to C<open>
+
+=back
+
+The following methods are wrappers for the directory related functions built
+into perl (the trailing `dir' has been removed from the names). See L<perlfunc>
+for details of these functions.
+
+=over 4
+
+=item open ( DIRNAME )
+
+=item read ()
+
+=item seek ( POS )
+
+=item tell ()
+
+=item rewind ()
+
+=item close ()
+
+=back
+
+C<IO::Dir> also provides an interface to reading directories via a tied
+hash. The tied hash extends the interface beyond just the directory
+reading routines by the use of C<lstat>, from the C<File::stat> package,
+C<unlink>, C<rmdir> and C<utime>.
+
+=over 4
+
+=item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ]
+
+=back
+
+The keys of the hash will be the names of the entries in the directory. 
+Reading a value from the hash will be the result of calling
+C<File::stat::lstat>.  Deleting an element from the hash will 
+delete the corresponding file or subdirectory,
+provided that C<DIR_UNLINK> is included in the C<OPTIONS>.
+
+Assigning to an entry in the hash will cause the time stamps of the file
+to be modified. If the file does not exist then it will be created. Assigning
+a single integer to a hash element will cause both the access and 
+modification times to be changed to that value. Alternatively a reference to
+an array of two values can be passed. The first array element will be used to
+set the access time and the second element will be used to set the modification
+time.
+
+=head1 SEE ALSO
+
+L<File::stat>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-2003 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/dist/IO/lib/IO/File.pm b/dist/IO/lib/IO/File.pm
new file mode 100644
index 0000000000..d33d090d0b
--- /dev/null
+++ b/dist/IO/lib/IO/File.pm
@@ -0,0 +1,204 @@
+#
+
+package IO::File;
+
+=head1 NAME
+
+IO::File - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use IO::File;
+
+    $fh = new IO::File;
+    if ($fh->open("< file")) {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new IO::File "> file";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new IO::File "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new IO::File "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+
+        $pos = $fh->getpos;
+        $fh->setpos($pos);
+
+        undef $fh;       # automatically closes the file
+    }
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
+these classes with methods that are specific to file handles.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( FILENAME [,MODE [,PERMS]] )
+
+Creates an 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,
+it is returned to the caller.
+
+=item new_tmpfile
+
+Creates an C<IO::File> opened for read/write on a newly created temporary
+file.  On systems where this is possible, the temporary file is anonymous
+(i.e. it is unlinked after creation, but held open).  If the temporary
+file cannot be created or opened, the C<IO::File> object is destroyed.
+Otherwise, it is returned to the caller.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item open( FILENAME [,MODE [,PERMS]] )
+
+=item open( FILENAME, IOLAYERS )
+
+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 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 an 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.
+The permissions default to 0666.
+
+If C<IO::File::open> is given a mode that includes the C<:> character,
+it passes all the three arguments to the three-argument C<open> operator.
+
+For convenience, C<IO::File> exports the O_XXX constants from the
+Fcntl module, if this module is available.
+
+=item binmode( [LAYER] )
+
+C<binmode> sets C<binmode> on the underlying C<IO> object, as documented
+in C<perldoc -f binmode>.
+
+C<binmode> accepts one optional parameter, which is the layer to be
+passed on to the C<binmode> call.
+
+=back
+
+=head1 NOTE
+
+Some operating systems may perform  C<IO::File::new()> or C<IO::File::open()>
+on a directory without errors.  This behavior is not portable and not
+suggested for use.  Using C<opendir()> and C<readdir()> or C<IO::Dir> are
+suggested instead.
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>,
+L<IO::Seekable>,
+L<IO::Dir>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>.
+
+=cut
+
+use 5.006_001;
+use strict;
+our($VERSION, @EXPORT, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO::Seekable;
+use File::Spec;
+
+require Exporter;
+
+@ISA = qw(IO::Handle IO::Seekable Exporter);
+
+$VERSION = "1.14";
+
+@EXPORT = @IO::Seekable::EXPORT;
+
+eval {
+    # Make all Fcntl O_XXX constants available for importing
+    require Fcntl;
+    my @O = grep /^O_/, @Fcntl::EXPORT;
+    Fcntl->import(@O);  # first we import what we want to export
+    push(@EXPORT, @O);
+};
+
+################################################
+## Constructor
+##
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::File";
+    @_ >= 0 && @_ <= 3
+	or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
+    my $fh = $class->SUPER::new();
+    if (@_) {
+	$fh->open(@_)
+	    or return undef;
+    }
+    $fh;
+}
+
+################################################
+## Open
+##
+
+sub open {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
+    my ($fh, $file) = @_;
+    if (@_ > 2) {
+	my ($mode, $perms) = @_[2, 3];
+	if ($mode =~ /^\d+$/) {
+	    defined $perms or $perms = 0666;
+	    return sysopen($fh, $file, $mode, $perms);
+	} elsif ($mode =~ /:/) {
+	    return open($fh, $mode, $file) if @_ == 3;
+	    croak 'usage: $fh->open(FILENAME, IOLAYERS)';
+	} else {
+            return open($fh, IO::Handle::_open_mode_string($mode), $file);
+        }
+    }
+    open($fh, $file);
+}
+
+################################################
+## Binmode
+##
+
+sub binmode {
+    ( @_ == 1 or @_ == 2 ) or croak 'usage $fh->binmode([LAYER])';
+
+    my($fh, $layer) = @_;
+
+    return binmode $$fh unless $layer;
+    return binmode $$fh, $layer;
+}
+
+1;
diff --git a/dist/IO/lib/IO/Handle.pm b/dist/IO/lib/IO/Handle.pm
new file mode 100644
index 0000000000..2f1f1b423b
--- /dev/null
+++ b/dist/IO/lib/IO/Handle.pm
@@ -0,0 +1,635 @@
+package IO::Handle;
+
+=head1 NAME
+
+IO::Handle - supply object methods for I/O handles
+
+=head1 SYNOPSIS
+
+    use IO::Handle;
+
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDIN),"r")) {
+        print $io->getline;
+        $io->close;
+    }
+
+    $io = new IO::Handle;
+    if ($io->fdopen(fileno(STDOUT),"w")) {
+        $io->print("Some text\n");
+    }
+
+    # setvbuf is not available by default on Perls 5.8.0 and later.
+    use IO::Handle '_IOLBF';
+    $io->setvbuf($buffer_var, _IOLBF, 1024);
+
+    undef $io;       # automatically closes the file if it's open
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+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> too.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ()
+
+Creates a new C<IO::Handle> object.
+
+=item new_from_fd ( FD, MODE )
+
+Creates an 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
+
+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:
+
+    $io->close
+    $io->eof
+    $io->fcntl( FUNCTION, SCALAR )
+    $io->fileno
+    $io->format_write( [FORMAT_NAME] )
+    $io->getc
+    $io->ioctl( FUNCTION, SCALAR )
+    $io->read ( BUF, LEN, [OFFSET] )
+    $io->print ( ARGS )
+    $io->printf ( FMT, [ARGS] )
+    $io->say ( 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.  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).
+
+    $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 4
+
+=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, an IO::Handle object,
+or a file descriptor number.  (For the documentation of the C<open>
+method, see L<IO::File>.)
+
+=item $io->opened
+
+Returns true if the object is currently a valid file descriptor, false
+otherwise.
+
+=item $io->getline
+
+This works like <$io> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in a
+list context but still returns just one line.  If used as the conditional
++within a C<while> or C-style C<for> loop, however, you will need to
++emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
+
+=item $io->getlines
+
+This works like <$io> when called in a list 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 $io->ungetc ( ORD )
+
+Pushes a character with the given ordinal value back onto the given
+handle's input stream.  Only one character of pushback per handle is
+guaranteed.
+
+=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 $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>, or if the
+handle is invalid. It only returns false for a valid handle with no
+outstanding errors.
+
+=item $io->clearerr
+
+Clear the given handle's error indicator. Returns -1 if the handle is
+invalid, 0 otherwise.
+
+=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 (similar to sysread, sysseek and
+systell). 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. Returns "0 but true" on success, C<undef> on error, C<undef>
+for an invalid handle. 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. Returns "0 but true"
+on success, C<undef> on error.
+
+=item $io->printflush ( ARGS )
+
+Turns on autoflush, print ARGS and then restores the autoflush status of the
+C<IO::Handle> object. Returns the return value from print.
+
+=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
+are the same as their C counterparts--including the constants C<_IOFBF>,
+C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
+specifies a scalar variable to use as a buffer. You should only
+change the buffer before any I/O, or immediately after calling flush.
+
+WARNING: The IO::Handle::setvbuf() is not available by default on
+Perls 5.8.0 and later because setvbuf() is rather specific to using
+the stdio library, while Perl prefers the new perlio subsystem instead.
+
+WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<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! Remember that
+the order of global destruction is undefined, so even if your buffer
+variable remains in scope until program termination, it may be undefined
+before the file IO::Handle is closed. Note that you need to import the
+constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
+returns nothing. setvbuf returns "0 but true", on success, C<undef> on
+failure.
+
+Lastly, there is a special method for working under B<-T> and setuid/gid
+scripts:
+
+=over 4
+
+=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
+take, and appropriate consideration for the data source and potential
+vulnerability should be kept in mind. Returns 0 on success, -1 if setting
+the taint-clean flag failed. (eg invalid handle)
+
+=back
+
+=head1 NOTE
+
+An 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
+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<IO::File>
+
+=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<gbarr@pobox.com>E<gt>
+
+=cut
+
+use 5.006_001;
+use strict;
+our($VERSION, @EXPORT_OK, @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO ();	# Load the XS module
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = "1.28";
+$VERSION = eval $VERSION;
+
+@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
+    say
+    getline
+    getlines
+
+    printflush
+    flush
+
+    SEEK_SET
+    SEEK_CUR
+    SEEK_END
+    _IOFBF
+    _IOLBF
+    _IONBF
+);
+
+################################################
+## Constructors, destructors.
+##
+
+sub new {
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 1 or croak "usage: new $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 $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
+# select
+
+sub 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 say {
+    @_ or croak 'usage: $io->say(ARGS)';
+    my $this = shift;
+    local $\ = "\n";
+    print $this @_;
+}
+
+sub getline {
+    @_ == 1 or croak 'usage: $io->getline()';
+    my $this = shift;
+    return scalar <$this>;
+} 
+
+*gets = \&getline;  # deprecated
+
+sub 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 $.;
+    () = tell qualify($_[0], caller) if ref($_[0]);
+    my $prev = $.;
+    $. = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_page_number {
+    my $old;
+    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $%;
+    $% = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_per_page {
+    my $old;
+    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $=;
+    $= = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_left {
+    my $old;
+    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $-;
+    $- = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_name {
+    my $old;
+    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $~;
+    $~ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_top_name {
+    my $old;
+    $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(qualify($fmt,caller));
+	CORE::write($io);
+	$io->format_name($oldfmt);
+    } else {
+	CORE::write($_[0]);
+    }
+}
+
+sub fcntl {
+    @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
+    my ($io, $op) = @_;
+    return fcntl($io, $op, $_[2]);
+}
+
+sub 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 deprecated
+
+sub printflush {
+    my $io = shift;
+    my $old;
+    $old = new SelectSaver qualify($io, caller) if ref($io);
+    local $| = 1;
+    if(ref($io)) {
+        print $io @_;
+    }
+    else {
+	print @_;
+    }
+}
+
+1;
diff --git a/dist/IO/lib/IO/Pipe.pm b/dist/IO/lib/IO/Pipe.pm
new file mode 100644
index 0000000000..827cc48bfc
--- /dev/null
+++ b/dist/IO/lib/IO/Pipe.pm
@@ -0,0 +1,257 @@
+# IO::Pipe.pm
+#
+# 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;
+
+use 5.006_001;
+
+use IO::Handle;
+use strict;
+our($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.13";
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::Pipe";
+    @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+    my $me = bless gensym(), $class;
+
+    my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+    pipe($readfh, $writefh)
+	or return undef;
+
+    @{*$me} = ($readfh, $writefh);
+
+    $me;
+}
+
+sub handles {
+    @_ == 1 or croak 'usage: $pipe->handles()';
+    (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
+
+sub _doit {
+    my $me = shift;
+    my $rw = shift;
+
+    my $pid = $do_spawn ? 0 : fork();
+
+    if($pid) { # Parent
+        return $pid;
+    }
+    elsif(defined $pid) { # Child or spawn
+        my $fh;
+        my $io = $rw ? \*STDIN : \*STDOUT;
+        my ($mode, $save) = $rw ? "r" : "w";
+        if ($do_spawn) {
+          require Fcntl;
+          $save = IO::Handle->new_from_fd($io, $mode);
+	  my $handle = shift;
+          # Close in child:
+	  unless ($^O eq 'MSWin32') {
+            fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+	  }
+          $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+        } else {
+          shift;
+          $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+        }
+        bless $io, "IO::Handle";
+        $io->fdopen($fh, $mode);
+	$fh->close;
+
+        if ($do_spawn) {
+          $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+          my $err = $!;
+    
+          $io->fdopen($save, $mode);
+          $save->close or croak "Cannot close $!";
+          croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+          return $pid;
+        } else {
+          exec @_ or
+            croak "IO::Pipe: Cannot exec: $!";
+        }
+    }
+    else {
+        croak "IO::Pipe: Cannot fork: $!";
+    }
+
+    # NOT Reached
+}
+
+sub 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;
+    $pid = $me->_doit(0, $fh, @_)
+        if(@_);
+
+    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;
+
+    $me;
+}
+
+sub 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;
+    $pid = $me->_doit(1, $fh, @_)
+        if(@_);
+
+    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;
+
+    $me;
+}
+
+package IO::Pipe::End;
+
+our(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+    my $fh = shift;
+    my $r = $fh->SUPER::close(@_);
+
+    waitpid(${*$fh}{'io_pipe_pid'},0)
+	if(defined ${*$fh}{'io_pipe_pid'});
+
+    $r;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Pipe - supply object methods for pipes
+
+=head1 SYNOPSIS
+
+	use IO::Pipe;
+
+	$pipe = new IO::Pipe;
+
+	if($pid = fork()) { # Parent
+	    $pipe->reader();
+
+	    while(<$pipe>) {
+		...
+	    }
+
+	}
+	elsif(defined $pid) { # Child
+	    $pipe->writer();
+
+	    print $pipe ...
+	}
+
+	or
+
+	$pipe = new IO::Pipe;
+
+	$pipe->reader(qw(ls -l));
+
+	while(<$pipe>) {
+	    ...
+	}
+
+=head1 DESCRIPTION
+
+C<IO::Pipe> provides an interface to creating pipes between
+processes.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [READER, WRITER] )
+
+Creates an C<IO::Pipe>, which is a reference to a newly created symbol
+(see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
+arguments, which should be objects blessed into C<IO::Handle>, or a
+subclass thereof. These two objects will be used for the system call
+to C<pipe>. If no arguments are given then method C<handles> is called
+on the new C<IO::Pipe> object.
+
+These two handles are held in the array part of the GLOB until either
+C<reader> or C<writer> is called.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item reader ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item writer ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item handles ()
+
+This method is called during construction by C<IO::Pipe::new>
+on the newly created C<IO::Pipe> object. It returns an array of two objects
+blessed into C<IO::Pipe::End>, or a subclass thereof.
+
+=back
+
+=head1 SEE ALSO
+
+L<IO::Handle>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+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/dist/IO/lib/IO/Poll.pm b/dist/IO/lib/IO/Poll.pm
new file mode 100644
index 0000000000..e7fb013506
--- /dev/null
+++ b/dist/IO/lib/IO/Poll.pm
@@ -0,0 +1,209 @@
+
+# IO::Poll.pm
+#
+# 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::Poll;
+
+use strict;
+use IO::Handle;
+use Exporter ();
+our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
+
+@ISA = qw(Exporter);
+$VERSION = "0.07";
+
+@EXPORT = qw( POLLIN
+	      POLLOUT
+	      POLLERR
+	      POLLHUP
+	      POLLNVAL
+	    );
+
+@EXPORT_OK = qw(
+ POLLPRI   
+ POLLRDNORM
+ POLLWRNORM
+ POLLRDBAND
+ POLLWRBAND
+ POLLNORM  
+	       );
+
+# [0] maps fd's to requested masks
+# [1] maps fd's to returned  masks
+# [2] maps fd's to handles
+sub new {
+    my $class = shift;
+
+    my $self = bless [{},{},{}], $class;
+
+    $self;
+}
+
+sub mask {
+    my $self = shift;
+    my $io = shift;
+    my $fd = fileno($io);
+    return unless defined $fd;
+    if (@_) {
+	my $mask = shift;
+	if($mask) {
+	  $self->[0]{$fd}{$io} = $mask; # the error events are always returned
+	  $self->[1]{$fd}      = 0;     # output mask
+	  $self->[2]{$io}      = $io;   # remember handle
+	} else {
+          delete $self->[0]{$fd}{$io};
+          unless(%{$self->[0]{$fd}}) {
+            # We no longer have any handles for this FD
+            delete $self->[1]{$fd};
+            delete $self->[0]{$fd};
+          }
+          delete $self->[2]{$io};
+	}
+    }
+    
+    return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
+	return $self->[0]{$fd}{$io};
+}
+
+
+sub poll {
+    my($self,$timeout) = @_;
+
+    $self->[1] = {};
+
+    my($fd,$mask,$iom);
+    my @poll = ();
+
+    while(($fd,$iom) = each %{$self->[0]}) {
+	$mask   = 0;
+	$mask  |= $_ for values(%$iom);
+	push(@poll,$fd => $mask);
+    }
+
+    my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
+
+    return $ret
+	unless $ret > 0;
+
+    while(@poll) {
+	my($fd,$got) = splice(@poll,0,2);
+	$self->[1]{$fd} = $got if $got;
+    }
+
+    return $ret;  
+}
+
+sub events {
+    my $self = shift;
+    my $io = shift;
+    my $fd = fileno($io);
+    exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} 
+                ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
+	: 0;
+}
+
+sub remove {
+    my $self = shift;
+    my $io = shift;
+    $self->mask($io,0);
+}
+
+sub handles {
+    my $self = shift;
+    return values %{$self->[2]} unless @_;
+
+    my $events = shift || 0;
+    my($fd,$ev,$io,$mask);
+    my @handles = ();
+
+    while(($fd,$ev) = each %{$self->[1]}) {
+	while (($io,$mask) = each %{$self->[0]{$fd}}) {
+	    $mask |= POLLHUP|POLLERR|POLLNVAL;  # must allow these
+	    push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
+	}
+    }
+    return @handles;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Poll - Object interface to system poll call
+
+=head1 SYNOPSIS
+
+    use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP);
+
+    $poll = new IO::Poll;
+
+    $poll->mask($input_handle => POLLIN);
+    $poll->mask($output_handle => POLLOUT);
+
+    $poll->poll($timeout);
+
+    $ev = $poll->events($input);
+
+=head1 DESCRIPTION
+
+C<IO::Poll> is a simple interface to the system level poll routine.
+
+=head1 METHODS
+
+=over 4
+
+=item mask ( IO [, EVENT_MASK ] )
+
+If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
+list of file descriptors and the next call to poll will check for
+any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
+removed from the list of file descriptors.
+
+If EVENT_MASK is not given then the return value will be the current
+event mask value for IO.
+
+=item poll ( [ TIMEOUT ] )
+
+Call the system level poll routine. If TIMEOUT is not specified then the
+call will block. Returns the number of handles which had events
+happen, or -1 on error.
+
+=item events ( IO )
+
+Returns the event mask which represents the events that happened on IO
+during the last call to C<poll>.
+
+=item remove ( IO )
+
+Remove IO from the list of file descriptors for the next poll.
+
+=item handles( [ EVENT_MASK ] )
+
+Returns a list of handles. If EVENT_MASK is not given then a list of all
+handles known will be returned. If EVENT_MASK is given then a list
+of handles will be returned which had one of the events specified by
+EVENT_MASK happen during the last call ti C<poll>
+
+=back
+
+=head1 SEE ALSO
+
+L<poll(2)>, L<IO::Handle>, L<IO::Select>
+
+=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/dist/IO/lib/IO/Seekable.pm b/dist/IO/lib/IO/Seekable.pm
new file mode 100644
index 0000000000..db1effda28
--- /dev/null
+++ b/dist/IO/lib/IO/Seekable.pm
@@ -0,0 +1,128 @@
+#
+
+package IO::Seekable;
+
+=head1 NAME
+
+IO::Seekable - supply seek based methods for I/O objects
+
+=head1 SYNOPSIS
+
+    use IO::Seekable;
+    package IO::Something;
+    @ISA = qw(IO::Seekable);
+
+=head1 DESCRIPTION
+
+C<IO::Seekable> does not have a constructor of its own as it is intended to
+be inherited by other C<IO::Handle> based objects. It provides methods
+which allow seeking of the file descriptors.
+
+=over 4
+
+=item $io->getpos
+
+Returns an opaque value that represents the current position of the
+IO::File, or C<undef> if this is not possible (eg an unseekable stream such
+as a terminal, pipe or socket). If the fgetpos() function is available in
+your C library it is used to implements getpos, else perl emulates getpos
+using C's ftell() function.
+
+=item $io->setpos
+
+Uses the value of a previous getpos call to return to a previously visited
+position. Returns "0 but true" on success, C<undef> on failure.
+
+=back
+
+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:
+
+=over 4
+
+=item $io->seek ( POS, WHENCE )
+
+Seek the IO::File to position POS, relative to WHENCE:
+
+=over 8
+
+=item WHENCE=0 (SEEK_SET)
+
+POS is absolute position. (Seek relative to the start of the file)
+
+=item WHENCE=1 (SEEK_CUR)
+
+POS is an offset from the current position. (Seek relative to current)
+
+=item WHENCE=2 (SEEK_END)
+
+POS is an offset from the end of the file. (Seek relative to end)
+
+=back
+
+The SEEK_* constants can be imported from the C<Fcntl> module if you
+don't wish to use the numbers C<0> C<1> or C<2> in your code.
+
+Returns C<1> upon success, C<0> otherwise.
+
+=item $io->sysseek( POS, WHENCE )
+
+Similar to $io->seek, but sets the IO::File's position using the system
+call lseek(2) directly, so will confuse most perl IO operators except
+sysread and syswrite (see L<perlfunc> for full details)
+
+Returns the new position, or C<undef> on failure.  A position
+of zero is returned as the string C<"0 but true">
+
+=item $io->tell
+
+Returns the IO::File's current position, or -1 on error.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>
+L<IO::File>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>gbarr@pobox.comE<gt>
+
+=cut
+
+use 5.006_001;
+use Carp;
+use strict;
+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.10";
+$VERSION = eval $VERSION;
+
+sub seek {
+    @_ == 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: $io->tell()';
+    tell($_[0]);
+}
+
+1;
diff --git a/dist/IO/lib/IO/Select.pm b/dist/IO/lib/IO/Select.pm
new file mode 100644
index 0000000000..fc05fe70e9
--- /dev/null
+++ b/dist/IO/lib/IO/Select.pm
@@ -0,0 +1,381 @@
+# IO::Select.pm
+#
+# 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;
+
+use     strict;
+use warnings::register;
+use     vars qw($VERSION @ISA);
+require Exporter;
+
+$VERSION = "1.17";
+
+@ISA = qw(Exporter); # This is only so we can do version checking
+
+sub VEC_BITS () {0}
+sub FD_COUNT () {1}
+sub FIRST_FD () {2}
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ my $vec = bless [undef,0], $type;
+
+ $vec->add(@_)
+    if @_;
+
+ $vec;
+}
+
+sub add
+{
+ shift->_update('add', @_);
+}
+
+
+sub remove
+{
+ shift->_update('remove', @_);
+}
+
+
+sub exists
+{
+ my $vec = shift;
+ my $fno = $vec->_fileno(shift);
+ return undef unless defined $fno;
+ $vec->[$fno + FIRST_FD];
+}
+
+
+sub _fileno
+{
+ my($self, $f) = @_;
+ return unless defined $f;
+ $f = $f->[0] if ref($f) eq 'ARRAY';
+ ($f =~ /^\d+$/) ? $f : fileno($f);
+}
+
+sub _update
+{
+ my $vec = shift;
+ my $add = shift eq 'add';
+
+ my $bits = $vec->[VEC_BITS];
+ $bits = '' unless defined $bits;
+
+ my $count = 0;
+ my $f;
+ foreach $f (@_)
+  {
+   my $fn = $vec->_fileno($f);
+   next unless defined $fn;
+   my $i = $fn + FIRST_FD;
+   if ($add) {
+     if (defined $vec->[$i]) {
+	 $vec->[$i] = $f;  # if array rest might be different, so we update
+	 next;
+     }
+     $vec->[FD_COUNT]++;
+     vec($bits, $fn, 1) = 1;
+     $vec->[$i] = $f;
+   } else {      # remove
+     next unless defined $vec->[$i];
+     $vec->[FD_COUNT]--;
+     vec($bits, $fn, 1) = 0;
+     $vec->[$i] = undef;
+   }
+   $count++;
+  }
+ $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
+ $count;
+}
+
+sub can_read
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $r = $vec->[VEC_BITS];
+
+ defined($r) && (select($r,undef,undef,$timeout) > 0)
+    ? handles($vec, $r)
+    : ();
+}
+
+sub can_write
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $w = $vec->[VEC_BITS];
+
+ defined($w) && (select(undef,$w,undef,$timeout) > 0)
+    ? handles($vec, $w)
+    : ();
+}
+
+sub has_exception
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $e = $vec->[VEC_BITS];
+
+ defined($e) && (select(undef,undef,$e,$timeout) > 0)
+    ? handles($vec, $e)
+    : ();
+}
+
+sub has_error
+{
+ warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
+	if warnings::enabled();
+ goto &has_exception;
+}
+
+sub count
+{
+ my $vec = shift;
+ $vec->[FD_COUNT];
+}
+
+sub bits
+{
+ my $vec = shift;
+ $vec->[VEC_BITS];
+}
+
+sub as_string  # for debugging
+{
+ my $vec = shift;
+ my $str = ref($vec) . ": ";
+ my $bits = $vec->bits;
+ my $count = $vec->count;
+ $str .= defined($bits) ? unpack("b*", $bits) : "undef";
+ $str .= " $count";
+ my @handles = @$vec;
+ splice(@handles, 0, FIRST_FD);
+ for (@handles) {
+     $str .= " " . (defined($_) ? "$_" : "-");
+ }
+ $str;
+}
+
+sub _max
+{
+ my($a,$b,$c) = @_;
+ $a > $b
+    ? $a > $c
+        ? $a
+        : $c
+    : $b > $c
+        ? $b
+        : $c;
+}
+
+sub select
+{
+ shift
+   if defined $_[0] && !ref($_[0]);
+
+ my($r,$w,$e,$t) = @_;
+ my @result = ();
+
+ my $rb = defined $r ? $r->[VEC_BITS] : undef;
+ my $wb = defined $w ? $w->[VEC_BITS] : undef;
+ my $eb = defined $e ? $e->[VEC_BITS] : undef;
+
+ if(select($rb,$wb,$eb,$t) > 0)
+  {
+   my @r = ();
+   my @w = ();
+   my @e = ();
+   my $i = _max(defined $r ? scalar(@$r)-1 : 0,
+                defined $w ? scalar(@$w)-1 : 0,
+                defined $e ? scalar(@$e)-1 : 0);
+
+   for( ; $i >= FIRST_FD ; $i--)
+    {
+     my $j = $i - FIRST_FD;
+     push(@r, $r->[$i])
+        if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
+     push(@w, $w->[$i])
+        if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
+     push(@e, $e->[$i])
+        if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
+    }
+
+   @result = (\@r, \@w, \@e);
+  }
+ @result;
+}
+
+
+sub handles
+{
+ my $vec = shift;
+ my $bits = shift;
+ my @h = ();
+ my $i;
+ my $max = scalar(@$vec) - 1;
+
+ for ($i = FIRST_FD; $i <= $max; $i++)
+  {
+   next unless defined $vec->[$i];
+   push(@h, $vec->[$i])
+      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
+  }
+ 
+ @h;
+}
+
+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)->can_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 exception 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 an 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, in
+seconds, possibly fractional. 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, EXCEPTION [, 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<EXCEPTION> 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
+exceptions respectively. Upon error an empty list 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/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
new file mode 100644
index 0000000000..9938c7807a
--- /dev/null
+++ b/dist/IO/lib/IO/Socket.pm
@@ -0,0 +1,530 @@
+# IO::Socket.pm
+#
+# 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;
+
+require 5.006;
+
+use IO::Handle;
+use Socket 1.3;
+use Carp;
+use strict;
+our(@ISA, $VERSION, @EXPORT_OK);
+use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
+
+@ISA = qw(IO::Handle);
+
+$VERSION = "1.31";
+
+@EXPORT_OK = qw(sockatmark);
+
+sub import {
+    my $pkg = shift;
+    if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
+	Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
+    } else {
+	my $callpkg = caller;
+	Exporter::export 'Socket', $callpkg, @_;
+    }
+}
+
+sub new {
+    my($class,%arg) = @_;
+    my $sock = $class->SUPER::new();
+
+    $sock->autoflush(1);
+
+    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+    return scalar(%arg) ? $sock->configure(\%arg)
+			: $sock;
+}
+
+my @domain2pkg;
+
+sub register_domain {
+    my($p,$d) = @_;
+    $domain2pkg[$d] = $p;
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my $domain = delete $arg->{Domain};
+
+    croak 'IO::Socket: Cannot configure a generic socket'
+	unless defined $domain;
+
+    croak "IO::Socket: Unsupported socket domain"
+	unless defined $domain2pkg[$domain];
+
+    croak "IO::Socket: Cannot configure socket in domain '$domain'"
+	unless ref($sock) eq "IO::Socket";
+
+    bless($sock, $domain2pkg[$domain]);
+    $sock->configure($arg);
+}
+
+sub socket {
+    @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+    my($sock,$domain,$type,$protocol) = @_;
+
+    socket($sock,$domain,$type,$protocol) or
+    	return undef;
+
+    ${*$sock}{'io_socket_domain'} = $domain;
+    ${*$sock}{'io_socket_type'}   = $type;
+    ${*$sock}{'io_socket_proto'}  = $protocol;
+
+    $sock;
+}
+
+sub socketpair {
+    @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
+    my($class,$domain,$type,$protocol) = @_;
+    my $sock1 = $class->new();
+    my $sock2 = $class->new();
+
+    socketpair($sock1,$sock2,$domain,$type,$protocol) or
+    	return ();
+
+    ${*$sock1}{'io_socket_type'}  = ${*$sock2}{'io_socket_type'}  = $type;
+    ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
+
+    ($sock1,$sock2);
+}
+
+sub connect {
+    @_ == 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 (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
+	    require IO::Select;
+
+	    my $sel = new IO::Select $sock;
+
+	    undef $!;
+	    if (!$sel->can_write($timeout)) {
+		$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+		$@ = "connect: timeout";
+	    }
+	    elsif (!connect($sock,$addr) &&
+                not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
+            ) {
+		# Some systems refuse to re-connect() to
+		# an already open socket and set errno to EISCONN.
+		# Windows sets errno to WSAEINVAL (10022)
+		$err = $!;
+		$@ = "connect: $!";
+	    }
+	}
+        elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK}))  {
+	    $err = $!;
+	    $@ = "connect: $!";
+	}
+    }
+
+    $sock->blocking(1) if $blocking;
+
+    $! = $err if $err;
+
+    $err ? undef : $sock;
+}
+
+# Enable/disable blocking IO on sockets.
+# Without args return the current status of blocking,
+# with args change the mode as appropriate, returning the
+# old setting, or in case of error during the mode change
+# undef.
+
+sub blocking {
+    my $sock = shift;
+
+    return $sock->SUPER::blocking(@_)
+        if $^O ne 'MSWin32';
+
+    # Windows handles blocking differently
+    #
+    # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
+    # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
+    #
+    # 0x8004667e is FIONBIO
+    #
+    # which is used to set blocking behaviour.
+
+    # NOTE: 
+    # This is a little confusing, the perl keyword for this is
+    # 'blocking' but the OS level behaviour is 'non-blocking', probably
+    # because sockets are blocking by default.
+    # Therefore internally we have to reverse the semantics.
+
+    my $orig= !${*$sock}{io_sock_nonblocking};
+        
+    return $orig unless @_;
+
+    my $block = shift;
+    
+    if ( !$block != !$orig ) {
+        ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
+        ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
+            or return undef;
+    }
+    
+    return $orig;        
+}
+
+
+sub close {
+    @_ == 1 or croak 'usage: $sock->close()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_peername'} = undef;
+    $sock->SUPER::close();
+}
+
+sub bind {
+    @_ == 2 or croak 'usage: $sock->bind(NAME)';
+    my $sock = shift;
+    my $addr = shift;
+
+    return bind($sock, $addr) ? $sock
+			      : undef;
+}
+
+sub listen {
+    @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+    my($sock,$queue) = @_;
+    $queue = 5
+	unless $queue && $queue > 0;
+
+    return listen($sock, $queue) ? $sock
+				 : undef;
+}
+
+sub accept {
+    @_ == 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;
+
+    if(defined $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: $sock->sockname()';
+    getsockname($_[0]);
+}
+
+sub peername {
+    @_ == 1 or croak 'usage: $sock->peername()';
+    my($sock) = @_;
+    ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
+}
+
+sub connected {
+    @_ == 1 or croak 'usage: $sock->connected()';
+    my($sock) = @_;
+    getpeername($sock);
+}
+
+sub send {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+    my $sock  = $_[0];
+    my $flags = $_[2] || 0;
+    my $peer  = $_[3] || $sock->peername;
+
+    croak 'send: Cannot determine peer address'
+	 unless(defined $peer);
+
+    my $r = defined(getpeername($sock))
+	? send($sock, $_[1], $flags)
+	: send($sock, $_[1], $flags, $peer);
+
+    # remember who we send to, if it was successful
+    ${*$sock}{'io_socket_peername'} = $peer
+	if(@_ == 4 && defined $r);
+
+    $r;
+}
+
+sub recv {
+    @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
+    my $sock  = $_[0];
+    my $len   = $_[2];
+    my $flags = $_[3] || 0;
+
+    # remember who we recv'd from
+    ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
+}
+
+sub shutdown {
+    @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+    my($sock, $how) = @_;
+    ${*$sock}{'io_socket_peername'} = undef;
+    shutdown($sock, $how);
+}
+
+sub setsockopt {
+    @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
+    setsockopt($_[0],$_[1],$_[2],$_[3]);
+}
+
+my $intsize = length(pack("i",0));
+
+sub getsockopt {
+    @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
+    my $r = getsockopt($_[0],$_[1],$_[2]);
+    # Just a guess
+    $r = unpack("i", $r)
+	if(defined $r && length($r) == $intsize);
+    $r;
+}
+
+sub sockopt {
+    my $sock = shift;
+    @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+	    : $sock->setsockopt(SOL_SOCKET,@_);
+}
+
+sub atmark {
+    @_ == 1 or croak 'usage: $sock->atmark()';
+    my($sock) = @_;
+    sockatmark($sock);
+}
+
+sub timeout {
+    @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+    my($sock,$val) = @_;
+    my $r = ${*$sock}{'io_socket_timeout'};
+
+    ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
+	if(@_ == 2);
+
+    $r;
+}
+
+sub sockdomain {
+    @_ == 1 or croak 'usage: $sock->sockdomain()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_domain'};
+}
+
+sub socktype {
+    @_ == 1 or croak 'usage: $sock->socktype()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_type'}
+}
+
+sub protocol {
+    @_ == 1 or croak 'usage: $sock->protocol()';
+    my($sock) = @_;
+    ${*$sock}{'io_socket_proto'};
+}
+
+1;
+
+__END__
+
+=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.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=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)
+    shutdown
+
+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 a list context a two-element array is returned containing
+the new socket and the peer address; the list will be empty upon
+failure.
+
+The timeout in the [PKG] can be specified as zero to effect a "poll",
+but you shouldn't do that because a new IO::Select object will be
+created behind the scenes just to do the single poll.  This is
+horrendously inefficient.  Use rather true select() with a zero
+timeout on the handle, or non-blocking IO.
+
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
+
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
+
+=back
+
+Additional methods that are provided are:
+
+=over 4
+
+=item atmark
+
+True if the socket is currently positioned at the urgent data mark,
+false otherwise.
+
+    use IO::Socket;
+
+    my $sock = IO::Socket::INET->new('some_server');
+    $sock->read($data, 1024) until $sock->atmark;
+
+Note: this is a reasonably new addition to the family of socket
+functions, so all systems may not support this yet.  If it is
+unsupported by the system, an attempt to use this method will
+abort the program.
+
+The atmark() functionality is also exportable as sockatmark() function:
+
+	use IO::Socket 'sockatmark';
+
+This allows for a more traditional use of sockatmark() as a procedural
+socket function.  If your system does not support sockatmark(), the
+C<use> declaration will fail at compile time.
+
+=item connected
+
+If the socket is in a connected state the peer address is returned.
+If the socket is not in a connected state then undef 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.
+
+=item sockdomain
+
+Returns the numerical number for the socket domain type. For example, for
+an AF_INET socket the value of &AF_INET will be 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 socktype
+
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
+
+=item timeout([VAL])
+
+Set or get the timeout value (in seconds) 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.
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
+
+=head1 AUTHOR
+
+Graham Barr.  atmark() by Lincoln Stein.  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.
+
+The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>.
+This module is distributed under the same terms as Perl itself.
+Feel free to use, modify and redistribute it as long as you retain
+the correct attribution.
+
+=cut
diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm
new file mode 100644
index 0000000000..2f0e5d1d7a
--- /dev/null
+++ b/dist/IO/lib/IO/Socket/INET.pm
@@ -0,0 +1,464 @@
+# IO::Socket::INET.pm
+#
+# 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::INET;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Socket;
+use Carp;
+use Exporter;
+use Errno;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.31";
+
+my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
+
+IO::Socket::INET->register_domain( AF_INET );
+
+my %socket_type = ( tcp  => SOCK_STREAM,
+		    udp  => SOCK_DGRAM,
+		    icmp => SOCK_RAW
+		  );
+my %proto_number;
+$proto_number{tcp}  = Socket::IPPROTO_TCP()  if defined &Socket::IPPROTO_TCP;
+$proto_number{udp}  = Socket::IPPROTO_UDP()  if defined &Socket::IPPROTO_UDP;
+$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
+my %proto_name = reverse %proto_number;
+
+sub new {
+    my $class = shift;
+    unshift(@_, "PeerAddr") if @_ == 1;
+    return $class->SUPER::new(@_);
+}
+
+sub _cache_proto {
+    my @proto = @_;
+    for (map lc($_), $proto[0], split(' ', $proto[1])) {
+	$proto_number{$_} = $proto[2];
+    }
+    $proto_name{$proto[2]} = $proto[0];
+}
+
+sub _get_proto_number {
+    my $name = lc(shift);
+    return undef unless defined $name;
+    return $proto_number{$name} if exists $proto_number{$name};
+
+    my @proto = getprotobyname($name);
+    return undef unless @proto;
+    _cache_proto(@proto);
+
+    return $proto[2];
+}
+
+sub _get_proto_name {
+    my $num = shift;
+    return undef unless defined $num;
+    return $proto_name{$num} if exists $proto_name{$num};
+
+    my @proto = getprotobynumber($num);
+    return undef unless @proto;
+    _cache_proto(@proto);
+
+    return $proto[0];
+}
+
+sub _sock_info {
+  my($addr,$port,$proto) = @_;
+  my $origport = $port;
+  my @serv = ();
+
+  $port = $1
+	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
+
+  if(defined $proto  && $proto =~ /\D/) {
+    my $num = _get_proto_number($proto);
+    unless (defined $num) {
+      $@ = "Bad protocol '$proto'";
+      return;
+    }
+    $proto = $num;
+  }
+
+  if(defined $port) {
+    my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
+    my $pnum = ($port =~ m,^(\d+)$,)[0];
+
+    @serv = getservbyname($port, _get_proto_name($proto) || "")
+	if ($port =~ m,\D,);
+
+    $port = $serv[2] || $defport || $pnum;
+    unless (defined $port) {
+	$@ = "Bad service '$origport'";
+	return;
+    }
+
+    $proto = _get_proto_number($serv[3]) if @serv && !$proto;
+  }
+
+ return ($addr || undef,
+	 $port || undef,
+	 $proto || undef
+	);
+}
+
+sub _error {
+    my $sock = shift;
+    my $err = shift;
+    {
+      local($!);
+      my $title = ref($sock).": ";
+      $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
+      $sock->close()
+	if(defined fileno($sock));
+    }
+    $! = $err;
+    return undef;
+}
+
+sub _get_addr {
+    my($sock,$addr_str, $multi) = @_;
+    my @addr;
+    if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
+	(undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
+    } else {
+	my $h = inet_aton($addr_str);
+	push(@addr, $h) if defined $h;
+    }
+    @addr;
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my($lport,$rport,$laddr,$raddr,$proto,$type);
+
+
+    $arg->{LocalAddr} = $arg->{LocalHost}
+	if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
+
+    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
+					$arg->{LocalPort},
+					$arg->{Proto})
+			or return _error($sock, $!, $@);
+
+    $laddr = defined $laddr ? inet_aton($laddr)
+			    : INADDR_ANY;
+
+    return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
+	unless(defined $laddr);
+
+    $arg->{PeerAddr} = $arg->{PeerHost}
+	if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
+
+    unless(exists $arg->{Listen}) {
+	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
+					    $arg->{PeerPort},
+					    $proto)
+			or return _error($sock, $!, $@);
+    }
+
+    $proto ||= _get_proto_number('tcp');
+
+    $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};
+
+    my @raddr = ();
+
+    if(defined $raddr) {
+	@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
+	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+	    unless @raddr;
+    }
+
+    while(1) {
+
+	$sock->socket(AF_INET, $type, $proto) or
+	    return _error($sock, $!, "$!");
+
+        if (defined $arg->{Blocking}) {
+	    defined $sock->blocking($arg->{Blocking})
+		or return _error($sock, $!, "$!");
+	}
+
+	if ($arg->{Reuse} || $arg->{ReuseAddr}) {
+	    $sock->sockopt(SO_REUSEADDR,1) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if ($arg->{ReusePort}) {
+	    $sock->sockopt(SO_REUSEPORT,1) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if ($arg->{Broadcast}) {
+		$sock->sockopt(SO_BROADCAST,1) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
+	    $sock->bind($lport || 0, $laddr) or
+		    return _error($sock, $!, "$!");
+	}
+
+	if(exists $arg->{Listen}) {
+	    $sock->listen($arg->{Listen} || 5) or
+		return _error($sock, $!, "$!");
+	    last;
+	}
+
+ 	# don't try to connect unless we're given a PeerAddr
+ 	last unless exists($arg->{PeerAddr});
+ 
+        $raddr = shift @raddr;
+
+	return _error($sock, $EINVAL, 'Cannot determine remote port')
+		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
+
+	last
+	    unless($type == SOCK_STREAM || defined $raddr);
+
+	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
+	    unless defined $raddr;
+
+#        my $timeout = ${*$sock}{'io_socket_timeout'};
+#        my $before = time() if $timeout;
+
+	undef $@;
+        if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
+#            ${*$sock}{'io_socket_timeout'} = $timeout;
+            return $sock;
+        }
+
+	return _error($sock, $!, $@ || "Timeout")
+	    unless @raddr;
+
+#	if ($timeout) {
+#	    my $new_timeout = $timeout - (time() - $before);
+#	    return _error($sock,
+#                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
+#                         "Timeout") if $new_timeout <= 0;
+#	    ${*$sock}{'io_socket_timeout'} = $new_timeout;
+#        }
+
+    }
+
+    $sock;
+}
+
+sub connect {
+    @_ == 2 || @_ == 3 or
+       croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
+    my $sock = shift;
+    return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
+}
+
+sub bind {
+    @_ == 2 || @_ == 3 or
+       croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
+    my $sock = shift;
+    return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
+}
+
+sub sockaddr {
+    @_ == 1 or croak 'usage: $sock->sockaddr()';
+    my($sock) = @_;
+    my $name = $sock->sockname;
+    $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub sockport {
+    @_ == 1 or croak 'usage: $sock->sockport()';
+    my($sock) = @_;
+    my $name = $sock->sockname;
+    $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub sockhost {
+    @_ == 1 or croak 'usage: $sock->sockhost()';
+    my($sock) = @_;
+    my $addr = $sock->sockaddr;
+    $addr ? inet_ntoa($addr) : undef;
+}
+
+sub peeraddr {
+    @_ == 1 or croak 'usage: $sock->peeraddr()';
+    my($sock) = @_;
+    my $name = $sock->peername;
+    $name ? (sockaddr_in($name))[1] : undef;
+}
+
+sub peerport {
+    @_ == 1 or croak 'usage: $sock->peerport()';
+    my($sock) = @_;
+    my $name = $sock->peername;
+    $name ? (sockaddr_in($name))[0] : undef;
+}
+
+sub peerhost {
+    @_ == 1 or croak 'usage: $sock->peerhost()';
+    my($sock) = @_;
+    my $addr = $sock->peeraddr;
+    $addr ? inet_ntoa($addr) : undef;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::Socket::INET - Object interface for AF_INET domain sockets
+
+=head1 SYNOPSIS
+
+    use IO::Socket::INET;
+
+=head1 DESCRIPTION
+
+C<IO::Socket::INET> provides an object interface to creating and using sockets
+in the AF_INET domain. It is built upon the L<IO::Socket> interface and
+inherits all the methods defined by L<IO::Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket::INET> object, 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.
+
+In addition to the key-value pairs accepted by L<IO::Socket>,
+C<IO::Socket::INET> provides.
+
+
+    PeerAddr	Remote host address          <hostname>[:<port>]
+    PeerHost	Synonym for PeerAddr
+    PeerPort	Remote port or service       <service>[(<no>)] | <no>
+    LocalAddr	Local host bind	address      hostname[:port]
+    LocalHost	Synonym for LocalAddr
+    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
+    ReuseAddr	Set SO_REUSEADDR before binding
+    Reuse	Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
+    ReusePort	Set SO_REUSEPORT before binding
+    Broadcast	Set SO_BROADCAST before binding
+    Timeout	Timeout	value for various operations
+    MultiHomed  Try all addresses for multi-homed hosts
+    Blocking    Determine if connection will be blocking mode
+
+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.
+
+Although it is not illegal, the use of C<MultiHomed> on a socket
+which is in non-blocking mode is of little use. This is because the
+first connect will never fail with a timeout as the connect call
+will not block.
+
+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.
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<PeerAddr> specification.
+
+If C<Blocking> is set to 0, the connection will be in nonblocking mode.
+If not specified it defaults to 1 (blocking mode).
+
+Examples:
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
+                                 PeerPort => 'http(80)',
+                                 Proto    => 'tcp');
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+
+   $sock = IO::Socket::INET->new(Listen    => 5,
+                                 LocalAddr => 'localhost',
+                                 LocalPort => 9000,
+                                 Proto     => 'tcp');
+
+   $sock = IO::Socket::INET->new('127.0.0.1:25');
+
+   $sock = IO::Socket::INET->new(PeerPort  => 9999,
+                                 PeerAddr  => inet_ntoa(INADDR_BROADCAST),
+                                 Proto     => udp,    
+                                 LocalAddr => 'localhost',
+                                 Broadcast => 1 ) 
+                             or die "Can't bind : $@\n";
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=back
+
+=head2 METHODS
+
+=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 peerport ()
+
+Return the port number for the socket on the peer host.
+
+=item peerhost ()
+
+Return the address part of the sockaddr structure for the socket on the
+peer host in a text form xx.xx.xx.xx
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Socket>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+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/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
new file mode 100644
index 0000000000..baa092ba1f
--- /dev/null
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
@@ -0,0 +1,143 @@
+# IO::Socket::UNIX.pm
+#
+# 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::UNIX;
+
+use strict;
+our(@ISA, $VERSION);
+use IO::Socket;
+use Carp;
+
+@ISA = qw(IO::Socket);
+$VERSION = "1.23";
+$VERSION = eval $VERSION;
+
+IO::Socket::UNIX->register_domain( AF_UNIX );
+
+sub new {
+    my $class = shift;
+    unshift(@_, "Peer") if @_ == 1;
+    return $class->SUPER::new(@_);
+}
+
+sub configure {
+    my($sock,$arg) = @_;
+    my($bport,$cport);
+
+    my $type = $arg->{Type} || SOCK_STREAM;
+
+    $sock->socket(AF_UNIX, $type, 0) or
+	return undef;
+
+    if(exists $arg->{Local}) {
+	my $addr = sockaddr_un($arg->{Local});
+	$sock->bind($addr) or
+	    return undef;
+    }
+    if(exists $arg->{Listen} && $type != SOCK_DGRAM) {
+	$sock->listen($arg->{Listen} || 5) or
+	    return undef;
+    }
+    elsif(exists $arg->{Peer}) {
+	my $addr = sockaddr_un($arg->{Peer});
+	$sock->connect($addr) or
+	    return undef;
+    }
+
+    $sock;
+}
+
+sub hostpath {
+    @_ == 1 or croak 'usage: $sock->hostpath()';
+    my $n = $_[0]->sockname || return undef;
+    (sockaddr_un($n))[0];
+}
+
+sub peerpath {
+    @_ == 1 or croak 'usage: $sock->peerpath()';
+    my $n = $_[0]->peername || return undef;
+    (sockaddr_un($n))[0];
+}
+
+1; # Keep require happy
+
+__END__
+
+=head1 NAME
+
+IO::Socket::UNIX - Object interface for AF_UNIX domain sockets
+
+=head1 SYNOPSIS
+
+    use IO::Socket::UNIX;
+
+=head1 DESCRIPTION
+
+C<IO::Socket::UNIX> provides an object interface to creating and using sockets
+in the AF_UNIX domain. It is built upon the L<IO::Socket> interface and
+inherits all the methods defined by L<IO::Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket::UNIX> object, 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.
+
+In addition to the key-value pairs accepted by L<IO::Socket>,
+C<IO::Socket::UNIX> provides.
+
+    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
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<Peer> specification.
+
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
+
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item hostpath()
+
+Returns the pathname to the fifo at the local end
+
+=item peerpath()
+
+Returns the pathanme to the fifo at the peer end
+
+=back
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Socket>
+
+=head1 AUTHOR
+
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
+
+=head1 COPYRIGHT
+
+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/dist/IO/poll.c b/dist/IO/poll.c
new file mode 100644
index 0000000000..9d39d57f2f
--- /dev/null
+++ b/dist/IO/poll.c
@@ -0,0 +1,146 @@
+/*
+ * poll.c
+ *
+ * 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.
+ *
+ * For systems that do not have the poll() system call (for example Linux
+ * kernels < v2.1.23) try to emulate it as closely as possible using select()
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "poll.h"
+#ifdef I_SYS_TIME
+# include <sys/time.h>
+#endif
+#ifdef I_TIME
+# include <time.h>
+#endif
+#include <sys/types.h>
+#if defined(HAS_SOCKET) && !defined(VMS) && !defined(ultrix) /* VMS handles sockets via vmsish.h, ULTRIX dies of socket struct redefinitions */
+#  include <sys/socket.h>
+#endif
+#include <sys/stat.h>
+#include <errno.h>
+
+#ifdef HAS_SELECT
+#ifdef I_SYS_SELECT
+#include <sys/select.h>
+#endif
+#endif
+
+#ifdef EMULATE_POLL_WITH_SELECT
+
+# define POLL_CAN_READ	(POLLIN | POLLRDNORM )
+# define POLL_CAN_WRITE	(POLLOUT | POLLWRNORM | POLLWRBAND )
+# define POLL_HAS_EXCP	(POLLRDBAND | POLLPRI )
+
+# define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP)
+
+int
+poll(struct pollfd *fds, unsigned long nfds, int timeout)
+{
+    int i,err;
+    fd_set rfd,wfd,efd,ifd;
+    struct timeval timebuf;
+    struct timeval *tbuf = (struct timeval *)0;
+    int n = 0;
+    int count;
+
+    FD_ZERO(&ifd);
+
+again:
+
+    FD_ZERO(&rfd);
+    FD_ZERO(&wfd);
+    FD_ZERO(&efd);
+
+    for(i = 0 ; i < (int)nfds ; i++) {
+	int events = fds[i].events;
+	int fd = fds[i].fd;
+
+	fds[i].revents = 0;
+
+	if(fd < 0 || FD_ISSET(fd, &ifd))
+	    continue;
+
+	if(fd > n)
+	    n = fd;
+
+	if(events & POLL_CAN_READ)
+	    FD_SET(fd, &rfd);
+
+	if(events & POLL_CAN_WRITE)
+	    FD_SET(fd, &wfd);
+
+	if(events & POLL_HAS_EXCP)
+	    FD_SET(fd, &efd);
+    }
+
+    if(timeout >= 0) {
+	timebuf.tv_sec = timeout / 1000;
+	timebuf.tv_usec = (timeout % 1000) * 1000;
+	tbuf = &timebuf;
+    }
+
+    err = select(n+1,&rfd,&wfd,&efd,tbuf);
+
+    if(err < 0) {
+#ifdef HAS_FSTAT
+	if(errno == EBADF) {
+	    for(i = 0 ; i < nfds ; i++) {
+		struct stat buf;
+		if((fstat(fds[i].fd,&buf) < 0) && (errno == EBADF)) {
+		    FD_SET(fds[i].fd, &ifd);
+		    goto again;
+		}
+	    }
+	}
+#endif /* HAS_FSTAT */
+	return err;
+    }
+
+    count = 0;
+
+    for(i = 0 ; i < (int)nfds ; i++) {
+	int revents = (fds[i].events & POLL_EVENTS_MASK);
+	int fd = fds[i].fd;
+
+	if(fd < 0)
+	    continue;
+
+	if(FD_ISSET(fd, &ifd))
+	    revents = POLLNVAL;
+	else {
+	    if(!FD_ISSET(fd, &rfd))
+	        revents &= ~POLL_CAN_READ;
+
+	    if(!FD_ISSET(fd, &wfd))
+	        revents &= ~POLL_CAN_WRITE;
+
+	    if(!FD_ISSET(fd, &efd))
+	        revents &= ~POLL_HAS_EXCP;
+	}
+
+	if((fds[i].revents = revents) != 0)
+	    count++;
+    }
+
+    return count; 
+}
+
+#endif /* EMULATE_POLL_WITH_SELECT */
+
+/* gcc for SunOS 4 produces code from an empty (code/symbolwise)
+ * source code file that makes the SunOS 4.x /usr/bin/ld fail with
+ * ld: poll.o: premature EOF
+ * To avoid this, have at least something in here.  */
+#if defined(__sun) && !defined(__SVR4) && defined(__GNUC__)
+static int dummy;
+#endif
+
diff --git a/dist/IO/poll.h b/dist/IO/poll.h
new file mode 100644
index 0000000000..634bcddd15
--- /dev/null
+++ b/dist/IO/poll.h
@@ -0,0 +1,60 @@
+/*
+ * poll.h
+ *
+ * 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.
+ *
+ */
+
+#ifndef POLL_H
+#  define POLL_H
+
+#if (defined(HAS_POLL) && defined(I_POLL)) || defined(POLLWRBAND)
+#  include <poll.h>
+#else
+#ifdef HAS_SELECT
+
+
+/* We shall emulate poll using select */
+
+#define EMULATE_POLL_WITH_SELECT
+
+#ifdef poll
+# undef poll
+#endif
+#define poll Perl_my_poll
+
+typedef struct pollfd {
+    int fd;
+    short events;
+    short revents;
+} pollfd_t;
+
+#define	POLLIN		0x0001
+#define	POLLPRI		0x0002
+#define	POLLOUT		0x0004
+#define	POLLRDNORM	0x0040
+#define	POLLWRNORM	POLLOUT
+#define	POLLRDBAND	0x0080
+#define	POLLWRBAND	0x0100
+#define	POLLNORM	POLLRDNORM
+
+/* Return ONLY events (NON testable) */
+
+#define	POLLERR		0x0008
+#define	POLLHUP		0x0010
+#define	POLLNVAL	0x0020
+
+int poll (struct pollfd *, unsigned long, int);
+
+#ifndef HAS_POLL
+#  define HAS_POLL
+#endif
+
+#endif /* HAS_SELECT */
+
+#endif /* I_POLL */
+
+#endif /* POLL_H */
+
diff --git a/dist/IO/t/IO.t b/dist/IO/t/IO.t
new file mode 100644
index 0000000000..effd414a4c
--- /dev/null
+++ b/dist/IO/t/IO.t
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	require Config;
+	if ($Config::Config{'extensions'} !~ /\bSocket\b/) {
+		print "1..0 # Skip: Socket not built - IO.pm uses Socket";
+		exit 0;
+	}
+    }
+}
+
+use strict;
+use File::Path;
+use File::Spec;
+require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
+plan(tests => 18);
+
+{
+	require XSLoader;
+
+	my @load;
+	local $^W;
+	local *XSLoader::load = sub {
+		push @load, \@_;
+	};
+
+	# use_ok() calls import, which we do not want to do
+	require_ok( 'IO' );
+	ok( @load, 'IO should call XSLoader::load()' );
+	is( $load[0][0], 'IO', '... loading the IO library' );
+	is( $load[0][1], $IO::VERSION, '... with the current .pm version' );
+}
+
+my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir );
+delete @INC{ @default };
+
+my $warn = '' ;
+local $SIG{__WARN__} = sub { $warn = "@_" } ;
+
+{
+    no warnings ;
+    IO->import();
+    is( $warn, '', "... import default, should not warn");
+    $warn = '' ;
+}
+
+{
+    local $^W = 0;
+    IO->import();
+    is( $warn, '', "... import default, should not warn");
+    $warn = '' ;
+}
+
+{
+    local $^W = 1;
+    IO->import();
+    like( $warn, qr/^Parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
+{
+    use warnings 'deprecated' ;
+    IO->import(); 
+    like( $warn, qr/^Parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
+{
+    use warnings ;
+    IO->import();
+    like( $warn, qr/^Parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
+foreach my $default (@default)
+{
+	ok( exists $INC{ $default }, "... import should default load $default" );
+}
+
+eval { IO->import( 'nothere' ) };
+like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' );
+
+my $fakedir = File::Spec->catdir( 'lib', 'IO' );
+my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' );
+
+my $flag;
+if ( -d $fakedir or mkpath( $fakedir ))
+{
+	if (open( OUT, ">$fakemod"))
+	{
+		(my $package = <<'		END_HERE') =~ tr/\t//d;
+		package IO::fakemod;
+
+		sub import { die "Do not import!\n" }
+
+		sub exists { 1 }
+
+		1;
+		END_HERE
+
+		print OUT $package;
+	}
+
+	if (close OUT)
+	{
+		$flag = 1;
+		push @INC, 'lib';
+	}
+}
+
+SKIP:
+{
+	skip("Could not write to disk", 2 ) unless $flag;
+	eval { IO->import( 'fakemod' ) };
+	ok( IO::fakemod::exists(), 'import() should import IO:: modules by name' );
+	is( $@, '', '... and should not call import() on imported modules' );
+}
+
+END
+{
+	1 while unlink $fakemod;
+	rmdir $fakedir;
+}
diff --git a/dist/IO/t/io_const.t b/dist/IO/t/io_const.t
new file mode 100644
index 0000000000..f6f83c1956
--- /dev/null
+++ b/dist/IO/t/io_const.t
@@ -0,0 +1,25 @@
+use Config;
+
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        if ($Config{'extensions'} !~ /\bIO\b/) {
+            print "1..0 # Skip: IO extension not compiled\n";
+            exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+
+print "1..6\n";
+my $i = 1;
+foreach (qw(SEEK_SET SEEK_CUR SEEK_END     _IOFBF    _IOLBF    _IONBF)) {
+    my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0;
+    my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef;
+    my $v2 = IO::Handle::constant($_);
+    my $d2 = defined($v2);
+
+    print "not "
+	if($d1 != $d2 || ($d1 && ($v1 != $v2)));
+    print "ok ",$i++,"\n";
+}
diff --git a/dist/IO/t/io_dir.t b/dist/IO/t/io_dir.t
new file mode 100644
index 0000000000..5472daa9b9
--- /dev/null
+++ b/dist/IO/t/io_dir.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	require Config; import Config;
+	if ($] < 5.00326 || not $Config{'d_readdir'}) {
+	    print "1..0 # Skip: readdir() not available\n";
+	    exit 0;
+	}
+    }
+
+    require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
+    plan(16);
+
+    use_ok('IO::Dir');
+    IO::Dir->import(DIR_UNLINK);
+}
+
+use strict;
+
+my $DIR = $^O eq 'MacOS' ? ":" : ".";
+
+my $CLASS = "IO::Dir";
+my $dot = $CLASS->new($DIR);
+ok(defined($dot));
+
+my @a = sort <*>;
+my $first;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+ok(+(grep { $_ eq $first } @a));
+
+my @b = sort($first, (grep {/^[^.]/} $dot->read));
+ok(+(join("\0", @a) eq join("\0", @b)));
+
+ok($dot->rewind,'rewind');
+my @c = sort grep {/^[^.]/} $dot->read;
+ok(+(join("\0", @b) eq join("\0", @c)));
+
+ok($dot->close,'close');
+{ local $^W; # avoid warnings on invalid dirhandle
+ok(!$dot->rewind, "rewind on closed");
+ok(!defined($dot->read));
+}
+
+open(FH,'>X') || die "Can't create x";
+print FH "X";
+close(FH) or die "Can't close: $!";
+
+my %dir;
+tie %dir, $CLASS, $DIR;
+my @files = keys %dir;
+
+# I hope we do not have an empty dir :-)
+ok(scalar @files);
+
+my $stat = $dir{'X'};
+isa_ok($stat,'File::stat');
+ok(defined($stat) && $stat->size == 1);
+
+delete $dir{'X'};
+
+ok(-f 'X');
+
+my %dirx;
+tie %dirx, $CLASS, $DIR, DIR_UNLINK;
+
+my $statx = $dirx{'X'};
+isa_ok($statx,'File::stat');
+ok(defined($statx) && $statx->size == 1);
+
+delete $dirx{'X'};
+
+ok(!(-f 'X'));
diff --git a/dist/IO/t/io_dup.t b/dist/IO/t/io_dup.t
new file mode 100644
index 0000000000..6afc96a272
--- /dev/null
+++ b/dist/IO/t/io_dup.t
@@ -0,0 +1,57 @@
+#!./perl
+
+use Config;
+
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        if ($Config{'extensions'} !~ /\bIO\b/) {
+	    print "1..0 # Skip: IO extension not compiled\n";
+	    exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+use IO::File;
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..6\n";
+
+print "ok 1\n";
+
+$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
+$duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
+
+$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
+$stderr = \*STDERR; bless $stderr, "IO::Handle";
+
+$stdout->open( "Io.dup","w") || die "Can't open stdout";
+$stderr->fdopen($stdout,"w");
+
+print $stdout "ok 2\n";
+print $stderr "ok 3\n";
+
+# Since some systems don't have echo, we use Perl.
+$echo = qq{$^X -le "print q(ok %d)"};
+
+$cmd = sprintf $echo, 4;
+print `$cmd`;
+
+$cmd = sprintf "$echo 1>&2", 5;
+$cmd = sprintf $echo, 5 if $^O eq 'MacOS';
+print `$cmd`;
+
+$stderr->close;
+$stdout->close;
+
+$stdout->fdopen($dupout,"w");
+$stderr->fdopen($duperr,"w");
+
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { print `type Io.dup` }
+elsif ($^O eq 'MacOS') { system 'Catenate Io.dup' }
+else                   { system 'cat Io.dup' }
+unlink 'Io.dup';
+
+print STDOUT "ok 6\n";
diff --git a/dist/IO/t/io_file.t b/dist/IO/t/io_file.t
new file mode 100644
index 0000000000..1cf60f5441
--- /dev/null
+++ b/dist/IO/t/io_file.t
@@ -0,0 +1,48 @@
+#!./perl -w
+
+use strict;
+require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
+plan(tests => ($^O =~ /MSWin32/ ? 9 : 6));
+
+my $Class       = 'IO::File';
+my $All_Chars   = join '', "\r\n", map( chr, 1..255 ), "zzz\n\r";
+my $File        = 'bin.'.$$;
+my $Expect      = quotemeta $All_Chars;
+
+use_ok( $Class );
+can_ok( $Class,                 "binmode" );
+
+### file the file with binary data;
+### use standard open to make sure we can compare binmodes
+### on both.
+{   my $tmp;
+    open $tmp, ">$File" or die "Could not open '$File': $!";
+    binmode $tmp;
+    print $tmp $All_Chars; 
+    close $tmp;
+}
+
+### now read in the file, once without binmode, once with.
+### without binmode should fail at least on win32...
+if( $^O =~ /MSWin32/ ) {
+    my $fh = $Class->new;
+
+    isa_ok( $fh,                $Class );
+    ok( $fh->open($File),       "   Opened '$File'" );
+    
+    my $cont = do { local $/; <$fh> };
+    unlike( $cont, qr/$Expect/, "   Content match fails without binmode" );
+}    
+
+### now with binmode, it must pass 
+{   my $fh = $Class->new;
+
+    isa_ok( $fh,                $Class );
+    ok( $fh->open($File),       "   Opened '$File' $!" );
+    ok( $fh->binmode,           "   binmode enabled" );
+    
+    my $cont = do { local $/; <$fh> };
+    like( $cont, qr/$Expect/,   "   Content match passes with binmode" );
+}
+    
+unlink $File;    
diff --git a/dist/IO/t/io_linenum.t b/dist/IO/t/io_linenum.t
new file mode 100644
index 0000000000..259f73631a
--- /dev/null
+++ b/dist/IO/t/io_linenum.t
@@ -0,0 +1,73 @@
+#!./perl
+
+# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
+# updated    28th May   1999 by Paul Johnson
+
+my $File;
+
+BEGIN {
+    $File = __FILE__;
+    require strict; import strict;
+}
+
+use Test;
+
+BEGIN { plan tests => 12 }
+
+use IO::File;
+
+sub lineno
+{
+  my ($f) = @_;
+  my $l;
+  $l .= "$. ";
+  $l .= $f->input_line_number;
+  $l .= " $.";                     # check $. before and after input_line_number
+  $l;
+}
+
+my $t;
+
+open (F, $File) or die $!;
+my $io = IO::File->new($File) or die $!;
+
+<F> for (1 .. 10);
+ok(lineno($io), "10 0 10");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "5 5 5");
+
+<F>;
+ok(lineno($io), "11 5 11");
+
+$io->getline;
+ok(lineno($io), "6 6 6");
+
+$t = tell F;                                        # tell F; provokes a warning
+ok(lineno($io), "11 6 11");
+
+<F>;
+ok(lineno($io), "12 6 12");
+
+select F;
+ok(lineno($io), "12 6 12");
+
+<F> for (1 .. 10);
+ok(lineno($io), "22 6 22");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "11 11 11");
+
+$t = tell F;
+# We used to have problems here before local $. worked.
+# input_line_number() used to use select and tell.  When we did the
+# same, that mechanism broke.  It should work now.
+ok(lineno($io), "22 11 22");
+
+{
+  local $.;
+  $io->getline for (1 .. 5);
+  ok(lineno($io), "16 16 16");
+}
+
+ok(lineno($io), "22 16 22");
diff --git a/dist/IO/t/io_multihomed.t b/dist/IO/t/io_multihomed.t
new file mode 100644
index 0000000000..f1bd5b9df9
--- /dev/null
+++ b/dist/IO/t/io_multihomed.t
@@ -0,0 +1,118 @@
+#!./perl
+
+BEGIN {
+    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
+
+    use Config;
+    my $can_fork = $Config{d_fork} ||
+		    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+		     $Config{useithreads} and 
+		     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+		    );
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+	$reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+	$reason = 'IO extension unavailable';
+    }
+    elsif (!$can_fork) {
+        $reason = 'no fork';
+    }
+    skip_all($reason) if $reason;
+}
+
+$| = 1;
+
+print "1..8\n";
+watchdog(15);
+
+package Multi;
+require IO::Socket::INET;
+@ISA=qw(IO::Socket::INET);
+
+use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
+
+sub _get_addr
+{
+    my($sock,$addr_str, $multi) = @_;
+    #print "_get_addr($sock, $addr_str, $multi)\n";
+
+    print "not " unless $multi;
+    print "ok 2\n";
+
+    (
+     # private IP-addresses which I hope does not work anywhere :-)
+     inet_aton("10.250.230.10"),
+     inet_aton("10.250.230.12"),
+     inet_aton("127.0.0.1")        # loopback
+    )
+}
+
+sub connect
+{
+    my $self = shift;
+    if (@_ == 1) {
+	my($port, $addr) = unpack_sockaddr_in($_[0]);
+	$addr = inet_ntoa($addr);
+	#print "connect($self, $port, $addr)\n";
+	if($addr eq "10.250.230.10") {
+	    print "ok 3\n";
+	    return 0;
+	}
+	if($addr eq "10.250.230.12") {
+	    print "ok 4\n";
+	    return 0;
+	}
+    }
+    $self->SUPER::connect(@_);
+}
+
+
+
+package main;
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+				Proto => 'tcp',
+				Timeout => 5,
+			       ) or die "$!";
+
+print "ok 1\n";
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept() or die "$!";
+    print "ok 5\n";
+
+    print $sock->getline();
+    print $sock "ok 7\n";
+
+    waitpid($pid,0);
+
+    $sock->close;
+
+    print "ok 8\n";
+
+} elsif(defined $pid) {
+
+    $sock = Multi->new(PeerPort => $port,
+		       Proto => 'tcp',
+		       PeerAddr => 'localhost',
+		       MultiHomed => 1,
+		       Timeout => 1,
+		      ) or die "$!";
+
+    print $sock "ok 6\n";
+    sleep(1); # race condition
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+    die;
+}
diff --git a/dist/IO/t/io_pipe.t b/dist/IO/t/io_pipe.t
new file mode 100644
index 0000000000..b7897bb2df
--- /dev/null
+++ b/dist/IO/t/io_pipe.t
@@ -0,0 +1,136 @@
+#!./perl
+
+my $perl;
+
+BEGIN {
+    $perl = $^X;
+}
+
+use Config;
+
+BEGIN {
+    my $can_fork = $Config{d_fork} ||
+		    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+		     $Config{useithreads} and 
+		     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+		    );
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+	$reason = 'IO extension unavailable';
+    }
+    elsif (!$can_fork) {
+        $reason = 'no fork';
+    }
+    elsif ($^O eq 'MSWin32' && !$ENV{TEST_IO_PIPE}) {
+	$reason = 'Win32 testing environment not set';
+    }
+    if ($reason) {
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+use IO::Pipe;
+
+my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : "";
+
+$| = 1;
+print "1..10\n";
+
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 1..4;
+} else {
+    $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1\n)');
+    while (<$pipe>) {
+      s/^not //;
+      print;
+    }
+    $pipe->close or print "# \$!=$!\nnot ";
+    print "ok 2\n";
+    $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
+    $pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
+    print $pipe "not ok 3\n" ;
+    $pipe->close or print "# \$!=$!\nnot ";
+    print "ok 4\n";
+}
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 5..10;
+    exit 0;
+}
+
+$pipe = new IO::Pipe;
+
+$pid = fork();
+
+if($pid)
+ {
+  $pipe->writer;
+  print $pipe "Xk 5\n";
+  print $pipe "oY 6\n";
+  $pipe->close;
+  wait;
+ }
+elsif(defined $pid)
+ {
+  $pipe->reader;
+  $stdin = bless \*STDIN, "IO::Handle";
+  $stdin->fdopen($pipe,"r");
+  exec $^X, '-pne', 'tr/YX/ko/';
+ }
+else
+ {
+  die "# error = $!";
+ }
+
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 7..8;
+} else {
+    $pipe = new IO::Pipe;
+    $pid = fork();
+
+    if($pid)
+ {
+  $pipe->reader;
+  while(<$pipe>) {
+      s/^not //;
+      print;
+  }
+  $pipe->close;
+  wait;
+ }
+    elsif(defined $pid)
+ {
+  $pipe->writer;
+
+  $stdout = bless \*STDOUT, "IO::Handle";
+  $stdout->fdopen($pipe,"w");
+  print STDOUT "not ok 7\n";
+  exec 'echo', 'not ok 8';
+ }
+    else
+ {
+  die;
+ }
+}
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 9;
+} else {
+    $pipe = new IO::Pipe;
+    $pipe->writer;
+
+    $SIG{'PIPE'} = 'broken_pipe';
+
+    sub broken_pipe {
+    print "ok 9\n";
+    }
+
+    print $pipe "not ok 9\n";
+    $pipe->close;
+
+    sleep 1;
+}
+print "ok 10\n";
+
diff --git a/dist/IO/t/io_poll.t b/dist/IO/t/io_poll.t
new file mode 100644
index 0000000000..364d346ace
--- /dev/null
+++ b/dist/IO/t/io_poll.t
@@ -0,0 +1,83 @@
+#!./perl
+
+if ($^O eq 'mpeix') {
+    print "1..0 # Skip: broken on MPE/iX\n";
+    exit 0;
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..10\n";
+
+use IO::Handle;
+use IO::Poll qw(/POLL/);
+
+my $poll = new IO::Poll;
+
+my $stdout = \*STDOUT;
+my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
+
+$poll->mask($stdout => POLLOUT);
+
+print "not "
+	unless $poll->mask($stdout) == POLLOUT;
+print "ok 1\n";
+
+$poll->mask($dupout => POLLPRI);
+
+print "not "
+	unless $poll->mask($dupout) == POLLPRI;
+print "ok 2\n";
+
+$poll->poll(0.1);
+
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'beos') {
+print "ok 3 # skipped, doesn't work on non-socket fds\n";
+print "ok 4 # skipped, doesn't work on non-socket fds\n";
+}
+else {
+print "not "
+	unless $poll->events($stdout) == POLLOUT;
+print "ok 3\n";
+
+print "not "
+	if $poll->events($dupout);
+print "ok 4\n";
+}
+
+my @h = $poll->handles;
+print "not "
+	unless @h == 2;
+print "ok 5\n";
+
+$poll->remove($stdout);
+
+@h = $poll->handles;
+
+print "not "
+	unless @h == 1;
+print "ok 6\n";
+
+print "not "
+	if $poll->mask($stdout);
+print "ok 7\n";
+
+$poll->poll(0.1);
+
+print "not "
+	if $poll->events($stdout);
+print "ok 8\n";
+
+$poll->remove($dupout);
+print "not "
+    if $poll->handles;
+print "ok 9\n";
+
+my $stdin = \*STDIN;
+$poll->mask($stdin => POLLIN);
+$poll->remove($stdin);
+close STDIN;
+print "not "
+    if $poll->poll(0.1);
+print "ok 10\n";
diff --git a/dist/IO/t/io_sel.t b/dist/IO/t/io_sel.t
new file mode 100644
index 0000000000..260ca439e7
--- /dev/null
+++ b/dist/IO/t/io_sel.t
@@ -0,0 +1,131 @@
+#!./perl -w
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..23\n";
+
+use IO::Select 1.09;
+
+my $sel = new IO::Select(\*STDIN);
+$sel->add(4, 5) == 2 or print "not ";
+print "ok 1\n";
+
+$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
+print "ok 2\n";
+
+@handles = $sel->handles;
+print "not " unless $sel->count == 4 && @handles == 4;
+print "ok 3\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(\*STDIN) == 1 or print "not ";
+print "ok 4\n",
+;
+$sel->remove(\*STDIN, 5, 6) == 1  # two of there are not present
+  or print "not ";
+print "ok 5\n";
+
+print "not " unless $sel->count == 2;
+print "ok 6\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(1, 4);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 7\n";
+
+$sel = new IO::Select;
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 8\n";
+
+$sel->remove([\*STDOUT, 5]);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 9\n";
+
+if ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) {
+    for (10 .. 15) { 
+        print "ok $_ # skip: 4-arg select is only valid on sockets\n"
+    }
+    $sel->add(\*STDOUT);  # update
+    goto POST_SOCKET;
+}
+
+@a = $sel->can_read();  # should return imediately
+print "not " unless @a == 0;
+print "ok 10\n";
+
+# we assume that we can write to STDOUT :-)
+$sel->add([\*STDOUT, "ok 12\n"]);
+
+@a = $sel->can_write;
+print "not " unless @a == 1;
+print "ok 11\n";
+
+my($fd, $msg) = @{shift @a};
+print $fd $msg;
+
+$sel->add(\*STDOUT);  # update
+
+@a = IO::Select::select(undef, $sel, undef, 1);
+print "not " unless @a == 3;
+print "ok 13\n";
+
+($r, $w, $e) = @a;
+
+print "not " unless @$r == 0 && @$w == 1 && @$e == 0;
+print "ok 14\n";
+
+$fd = $w->[0];
+print $fd "ok 15\n";
+
+POST_SOCKET:
+# Test new exists() method
+$sel->exists(\*STDIN) and print "not ";
+print "ok 16\n";
+
+($sel->exists(0) || $sel->exists([\*STDERR])) and print "not ";
+print "ok 17\n";
+
+$fd = $sel->exists(\*STDOUT);
+if ($fd) {
+    print $fd "ok 18\n";
+} else {
+    print "not ok 18\n";
+}
+
+$fd = $sel->exists([1, 'foo']);
+if ($fd) {
+    print $fd "ok 19\n";
+} else {
+    print "not ok 19\n";
+}
+
+# Try self clearing
+$sel->add(5,6,7,8,9,10);
+print "not " unless $sel->count == 7;
+print "ok 20\n";
+
+$sel->remove($sel->handles);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 21\n";
+
+# check warnings
+$SIG{__WARN__} = sub { 
+    ++ $w 
+      if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/ ;
+    } ;
+$w = 0 ;
+{
+no warnings 'IO::Select' ;
+IO::Select::has_error();
+}
+print "not " unless $w == 0 ;
+$w = 0 ;
+print "ok 22\n" ;
+{
+use warnings 'IO::Select' ;
+IO::Select::has_error();
+}
+print "not " unless $w == 1 ;
+$w = 0 ;
+print "ok 23\n" ;
diff --git a/dist/IO/t/io_sock.t b/dist/IO/t/io_sock.t
new file mode 100644
index 0000000000..38aefeeb53
--- /dev/null
+++ b/dist/IO/t/io_sock.t
@@ -0,0 +1,396 @@
+#!./perl -w
+
+use Config;
+
+BEGIN {
+    my $can_fork = $Config{d_fork} ||
+		    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+		     $Config{useithreads} and 
+		     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+		    );
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+	$reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+	$reason = 'IO extension unavailable';
+    }
+    elsif (!$can_fork) {
+        $reason = 'no fork';
+    }
+    if ($reason) {
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+my $has_perlio = $] >= 5.008 && find PerlIO::Layer 'perlio';
+
+$| = 1;
+print "1..26\n";
+
+eval {
+    $SIG{ALRM} = sub { die; };
+    alarm 120;
+};
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+				Proto => 'tcp',
+				# some systems seem to need as much as 10,
+				# so be generous with the timeout
+				Timeout => 15,
+			       ) or die "$!";
+
+print "ok 1\n";
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 2..5;
+    exit 0;
+}
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept() or die "accept failed: $!";
+    print "ok 2\n";
+
+    $sock->autoflush(1);
+    print $sock->getline();
+
+    print $sock "ok 4\n";
+
+    $sock->close;
+
+    waitpid($pid,0);
+
+    print "ok 5\n";
+
+} elsif(defined $pid) {
+
+    $sock = IO::Socket::INET->new(PeerPort => $port,
+				  Proto => 'tcp',
+				  PeerAddr => 'localhost'
+				 )
+         || IO::Socket::INET->new(PeerPort => $port,
+				  Proto => 'tcp',
+				  PeerAddr => '127.0.0.1'
+				 )
+	or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+
+    $sock->autoflush(1);
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}
+
+# Test various other ways to create INET sockets that should
+# also work.
+$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
+$port = $listen->sockport;
+
+if($pid = fork()) {
+  SERVER_LOOP:
+    while (1) {
+       last SERVER_LOOP unless $sock = $listen->accept;
+       while (<$sock>) {
+           last SERVER_LOOP if /^quit/;
+           last if /^done/;
+           print;
+       }
+       $sock = undef;
+    }
+    $listen->close;
+} elsif (defined $pid) {
+    # child, try various ways to connect
+    $sock = IO::Socket::INET->new("localhost:$port")
+         || IO::Socket::INET->new("127.0.0.1:$port");
+    if ($sock) {
+	print "not " unless $sock->connected;
+	print "ok 6\n";
+       $sock->print("ok 7\n");
+       sleep(1);
+       print "ok 8\n";
+       $sock->print("ok 9\n");
+       $sock->print("done\n");
+       $sock->close;
+    }
+    else {
+	print "# $@\n";
+	print "not ok 6\n";
+	print "not ok 7\n";
+	print "not ok 8\n";
+	print "not ok 9\n";
+    }
+
+    # some machines seem to suffer from a race condition here
+    sleep(2);
+
+    $sock = IO::Socket::INET->new("127.0.0.1:$port");
+    if ($sock) {
+       $sock->print("ok 10\n");
+       $sock->print("done\n");
+       $sock->close;
+    }
+    else {
+	print "# $@\n";
+	print "not ok 10\n";
+    }
+
+    # some machines seem to suffer from a race condition here
+    sleep(1);
+
+    $sock = IO::Socket->new(Domain => AF_INET,
+                            PeerAddr => "localhost:$port")
+         || IO::Socket->new(Domain => AF_INET,
+                            PeerAddr => "127.0.0.1:$port");
+    if ($sock) {
+       $sock->print("ok 11\n");
+       $sock->print("quit\n");
+    } else {
+       print "not ok 11\n";
+    }
+    $sock = undef;
+    sleep(1);
+    exit;
+} else {
+    die;
+}
+
+# Then test UDP sockets
+$server = IO::Socket->new(Domain => AF_INET,
+                          Proto  => 'udp',
+                          LocalAddr => 'localhost')
+       || IO::Socket->new(Domain => AF_INET,
+                          Proto  => 'udp',
+                          LocalAddr => '127.0.0.1');
+$port = $server->sockport;
+
+if ($pid = fork()) {
+    my $buf;
+    $server->recv($buf, 100);
+    print $buf;
+} elsif (defined($pid)) {
+    #child
+    $sock = IO::Socket::INET->new(Proto => 'udp',
+                                  PeerAddr => "localhost:$port")
+         || IO::Socket::INET->new(Proto => 'udp',
+                                  PeerAddr => "127.0.0.1:$port");
+    $sock->send("ok 12\n");
+    sleep(1);
+    $sock->send("ok 12\n");  # send another one to be sure
+    exit;
+} else {
+    die;
+}
+
+print "not " unless $server->blocking;
+print "ok 13\n";
+
+if ( $^O eq 'qnx' ) {
+  # QNX4 library bug: Can set non-blocking on socket, but
+  # cannot return that status.
+  print "ok 14 # skipped on QNX4\n";
+} else {
+  $server->blocking(0);
+  print "not " if $server->blocking;
+  print "ok 14\n";
+}
+
+### TEST 15
+### Set up some data to be transfered between the server and
+### the client. We'll use own source code ...
+#
+local @data;
+if( !open( SRC, "< $0")) {
+    print "not ok 15 - $!\n";
+} else {
+    @data = <SRC>;
+    close(SRC);
+    print "ok 15\n";
+}
+
+### TEST 16
+### Start the server
+#
+my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
+    print "not ";
+print "ok 16\n";
+die if( !defined( $listen));
+my $serverport = $listen->sockport;
+my $server_pid = fork();
+if( $server_pid) {
+
+    ### TEST 17 Client/Server establishment
+    #
+    print "ok 17\n";
+
+    ### TEST 18
+    ### Get data from the server using a single stream
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+	$sock->print("send\n");
+
+	my @array = ();
+	while( <$sock>) {
+	    push( @array, $_);
+	}
+
+	$sock->print("done\n");
+	$sock->close;
+
+	print "not " if( @array != @data);
+    } else {
+	print "not ";
+    }
+    print "ok 18\n";
+
+    ### TEST 21
+    ### Get data from the server using a stream, which is
+    ### interrupted by eof calls.
+    ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
+    ### did an getc followed by an ungetc in order to check for the streams
+    ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
+    ### a recv(2) call on the socket, while ungetc(3) put back a character
+    ### to an IO buffer, which never again was read.
+    #
+    ### TESTS 19,20,21,22
+    ### Try to ping-pong some Unicode.
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($has_perlio) {
+	print binmode($sock, ":utf8") ? "ok 19\n" : "not ok 19\n";
+    } else {
+	print "ok 19 - Skip: no perlio\n";
+    }
+
+    if ($sock) {
+
+	if ($has_perlio) {
+	    $sock->print("ping \x{100}\n");
+	    chomp(my $pong = scalar <$sock>);
+	    print $pong =~ /^pong (.+)$/ && $1 eq "\x{100}" ?
+		"ok 20\n" : "not ok 20\n";
+
+	    $sock->print("ord \x{100}\n");
+	    chomp(my $ord = scalar <$sock>);
+	    print $ord == 0x100 ?
+		"ok 21\n" : "not ok 21\n";
+
+	    $sock->print("chr 0x100\n");
+	    chomp(my $chr = scalar <$sock>);
+	    print $chr eq "\x{100}" ?
+		"ok 22\n" : "not ok 22\n";
+	} else {
+	    print "ok $_ - Skip: no perlio\n" for 20..22;
+	}
+
+	$sock->print("send\n");
+
+	my @array = ();
+	while( !eof( $sock ) ){
+	    while( <$sock>) {
+		push( @array, $_);
+		last;
+	    }
+	}
+
+	$sock->print("done\n");
+	$sock->close;
+
+	print "not " if( @array != @data);
+    } else {
+	print "not ";
+    }
+    print "ok 23\n";
+
+    ### TEST 24
+    ### Stop the server
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+	$sock->print("done\n");
+	$sock->close;
+
+	print "not " if( 1 != kill 0, $server_pid);
+    } else {
+	print "not ";
+    }
+    print "ok 24\n";
+
+} elsif (defined($server_pid)) {
+   
+    ### Child
+    #
+    SERVER_LOOP: while (1) {
+	last SERVER_LOOP unless $sock = $listen->accept;
+	# Do not print ok/not ok for this binmode() since there's
+	# a race condition with our client, just die if we fail.
+	if ($has_perlio) { binmode($sock, ":utf8") or die }
+	while (<$sock>) {
+	    last SERVER_LOOP if /^quit/;
+	    last if /^done/;
+	    if (/^ping (.+)/) {
+		print $sock "pong $1\n";
+		next;
+	    }
+	    if (/^ord (.+)/) {
+		print $sock ord($1), "\n";
+		next;
+	    }
+	    if (/^chr (.+)/) {
+		print $sock chr(hex($1)), "\n";
+		next;
+	    }
+	    if (/^send/) {
+		print $sock @data;
+		last;
+	    }
+	    print;
+	}
+	$sock = undef;
+    }
+    $listen->close;
+    exit 0;
+
+} else {
+
+    ### Fork failed
+    #
+    print "not ok 17\n";
+    die;
+}
+
+# test Blocking option in constructor
+
+$sock = IO::Socket::INET->new(Blocking => 0)
+    or print "not ";
+print "ok 25\n";
+
+if ( $^O eq 'qnx' ) {
+  print "ok 26 # skipped on QNX4\n";
+  # QNX4 library bug: Can set non-blocking on socket, but
+  # cannot return that status.
+} else {
+  my $status = $sock->blocking;
+  print "not " unless defined $status && !$status;
+  print "ok 26\n";
+}
diff --git a/dist/IO/t/io_taint.t b/dist/IO/t/io_taint.t
new file mode 100644
index 0000000000..3cbe30345f
--- /dev/null
+++ b/dist/IO/t/io_taint.t
@@ -0,0 +1,62 @@
+#!./perl -T
+
+use Config;
+
+BEGIN {
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use strict;
+if ($ENV{PERL_CORE}) {
+  require("../../t/test.pl");
+}
+else {
+  require("./t/test.pl");
+}
+plan(tests => 5);
+
+END { unlink "./__taint__$$" }
+
+use IO::File;
+my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+print $x "$$\n";
+$x->close;
+
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+chop(my $unsafe = <$x>);
+eval { kill 0 * $unsafe };
+SKIP: {
+  skip($^O) if $^O eq 'MSWin32' or $^O eq 'NetWare';
+  like($@, '^Insecure');
+}
+$x->close;
+
+# We could have just done a seek on $x, but technically we haven't tested
+# seek yet...
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+$x->untaint;
+ok(!$?); # Calling the method worked
+chop($unsafe = <$x>);
+eval { kill 0 * $unsafe };
+unlike($@,'^Insecure');
+$x->close;
+
+TODO: {
+  todo_skip("Known bug in 5.10.0",2) if $] >= 5.010 and $] < 5.010_001;
+
+  # this will segfault if it fails
+
+  sub PVBM () { 'foo' }
+  { my $dummy = index 'foo', PVBM }
+
+  eval { IO::Handle::untaint(PVBM) };
+  pass();
+
+  eval { IO::Handle::untaint(\PVBM) };
+  pass();
+}
+
+exit 0;
diff --git a/dist/IO/t/io_tell.t b/dist/IO/t/io_tell.t
new file mode 100644
index 0000000000..3f8ad30b9f
--- /dev/null
+++ b/dist/IO/t/io_tell.t
@@ -0,0 +1,55 @@
+#!./perl
+
+BEGIN {
+    $tell_file = "Makefile.PL";
+}
+
+use Config;
+
+BEGIN {
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+print "1..13\n";
+
+use IO::File;
+
+$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
+binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos');
+if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
+
+$firstline = <$tst>;
+$secondpos = tell;
+
+$x = 0;
+while (<$tst>) {
+    if (eof) {$x++;}
+}
+if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+$lastpos = tell;
+
+unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
+
+if ($tst->seek(0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
+
+if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
+
+if ($firstline eq <$tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
+
+if ($tst->seek(0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+if ($tst->eof) { print "not ok 9\n"; } else { print "ok 9\n"; }
+
+if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
+
+if ($tst->seek(0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
+
+if ($lastpos == $tst->tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
+
+unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
new file mode 100644
index 0000000000..6b139dd83f
--- /dev/null
+++ b/dist/IO/t/io_udp.t
@@ -0,0 +1,79 @@
+#!./perl
+
+BEGIN {
+    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
+
+    use Config;
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+      $reason = 'Socket was not built';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+      $reason = 'IO was not built';
+    }
+    elsif ($^O eq 'apollo') {
+      $reason = "unknown *FIXME*";
+    }
+    undef $reason if $^O eq 'VMS' and $Config{d_socket};
+    skip_all($reason) if $reason;
+}
+
+sub compare_addr {
+    no utf8;
+    my $a = shift;
+    my $b = shift;
+    if (length($a) != length $b) {
+	my $min = (length($a) < length $b) ? length($a) : length $b;
+	if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) {
+	    printf "# Apparently: %d bytes junk at the end of %s\n# %s\n",
+		abs(length($a) - length ($b)),
+		$_[length($a) < length ($b) ? 1 : 0],
+		"consider decreasing bufsize of recfrom.";
+	    substr($a, $min) = "";
+	    substr($b, $min) = "";
+	}
+	return 0;
+    }
+    my @a = unpack_sockaddr_in($a);
+    my @b = unpack_sockaddr_in($b);
+    "$a[0]$a[1]" eq "$b[0]$b[1]";
+}
+
+plan(7);
+watchdog(15);
+
+use Socket;
+use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
+
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+ok(1);
+
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+     || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+    or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+ok(1);
+
+$udpa->send('BORK', 0, $udpb->sockname);
+
+ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'));
+
+my $where = $udpb->recv($buf="", 4);
+is($buf, 'BORK');
+
+my @xtra = ();
+
+if (! ok(compare_addr($where,$udpa->sockname, 'recv name', 'sockname'))) {
+    @xtra = (0, $udpa->sockname);
+}
+
+$udpb->send('FOObar', @xtra);
+$udpa->recv($buf="", 6);
+is($buf, 'FOObar');
+
+ok(! $udpa->connected);
+
+exit(0);
+
+# EOF
diff --git a/dist/IO/t/io_unix.t b/dist/IO/t/io_unix.t
new file mode 100644
index 0000000000..61ba3635f8
--- /dev/null
+++ b/dist/IO/t/io_unix.t
@@ -0,0 +1,113 @@
+#!./perl
+
+use Config;
+
+BEGIN {
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+	$reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+	$reason = 'IO extension unavailable';
+    }
+    elsif ($^O eq 'os2') {
+	require IO::Socket;
+
+	eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
+	  or $@ !~ /not implemented/ or
+	    $reason = 'compiled without TCP/IP stack v4';
+    }
+    elsif ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/ ) {
+	$reason = "UNIX domain sockets not implemented on $^O";
+    }
+    elsif (! $Config{'d_fork'}) {
+	$reason = 'no fork';
+    }
+    if ($reason) {
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+$PATH = "sock-$$";
+
+if ($^O eq 'os2') {	# Can't create sockets with relative path...
+  require Cwd;
+  my $d = Cwd::cwd();
+  $d =~ s/^[a-z]://i;
+  $PATH = "$d/$PATH";
+}
+
+# Test if we can create the file within the tmp directory
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+    print "1..0 # Skip: cannot open '$PATH' for write\n";
+    exit 0;
+}
+close(TEST);
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
+
+# Start testing
+$| = 1;
+print "1..5\n";
+
+use IO::Socket;
+
+$listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0);
+
+# Sometimes UNIX filesystems are mounted for security reasons
+# with "nodev" option which spells out "no" for creating UNIX
+# local sockets.  Therefore we will retry with a File::Temp
+# generated filename from a temp directory.
+unless (defined $listen) {
+    eval { require File::Temp };
+    unless ($@) {
+	import File::Temp 'mktemp';
+	for my $TMPDIR ($ENV{TMPDIR}, "/tmp") {
+	    if (defined $TMPDIR && -d $TMPDIR && -w $TMPDIR) {
+		$PATH = mktemp("$TMPDIR/sXXXXXXXX");
+		last if $listen = IO::Socket::UNIX->new(Local => $PATH,
+							Listen => 0);
+	    }
+	}
+    }
+    defined $listen or die "$PATH: $!";
+}
+print "ok 1\n";
+
+if($pid = fork()) {
+
+    $sock = $listen->accept();
+
+    if (defined $sock) {
+	print "ok 2\n";
+
+	print $sock->getline();
+
+	print $sock "ok 4\n";
+
+	$sock->close;
+
+	waitpid($pid,0);
+	unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
+
+	print "ok 5\n";
+    } else {
+	print "# accept() failed: $!\n";
+	for (2..5) {
+	    print "not ok $_ # accept failed\n";
+	}
+    }
+} elsif(defined $pid) {
+
+    $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}
diff --git a/dist/IO/t/io_utf8.t b/dist/IO/t/io_utf8.t
new file mode 100644
index 0000000000..53c209d4b8
--- /dev/null
+++ b/dist/IO/t/io_utf8.t
@@ -0,0 +1,31 @@
+#!./perl
+
+BEGIN {
+    unless ($] >= 5.008 and find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: not perlio\n";
+	exit 0;
+    }
+}
+
+require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
+
+plan(tests => 5);
+
+my $io;
+
+use_ok('IO::File');
+
+$io = IO::File->new;
+
+ok($io->open("io_utf8", ">:utf8"), "open >:utf8");
+ok((print $io chr(256)), "print chr(256)");
+undef $io;
+
+$io = IO::File->new;
+ok($io->open("io_utf8", "<:utf8"), "open <:utf8");
+is(ord(<$io>), 256, "readline chr(256)");
+undef $io;
+
+END {
+  1 while unlink "io_utf8";
+}
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
new file mode 100644
index 0000000000..585eed84b2
--- /dev/null
+++ b/dist/IO/t/io_xs.t
@@ -0,0 +1,40 @@
+#!./perl
+
+use Config;
+
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        if ($Config{'extensions'} !~ /\bIO\b/) {
+	    print "1..0 # Skip: IO extension not built\n";
+	    exit 0;
+        }
+    }
+    if( $^O eq 'VMS' && $Config{'vms_cc_type'} ne 'decc' ) {
+        print "1..0 # Skip: not compatible with the VAXCRTL\n";
+        exit 0;
+    }
+}
+
+use IO::File;
+use IO::Seekable;
+
+print "1..4\n";
+
+$x = new_tmpfile IO::File or print "not ";
+print "ok 1\n";
+print $x "ok 2\n";
+$x->seek(0,SEEK_SET);
+print <$x>;
+
+$x->seek(0,SEEK_SET);
+print $x "not ok 3\n";
+$p = $x->getpos;
+print $x "ok 3\n";
+$x->flush;
+$x->setpos($p);
+print scalar <$x>;
+
+$! = 0;
+$x->setpos(undef);
+print $! ? "ok 4 # $!\n" : "not ok 4\n";
+