Beginings of PerlIO_dup support (unstable)

p4raw-id: //depot/perlio@12447

2 files changed, 184 insertions, 113 deletions

diff --git a/perlio.c b/perlio.c
index eb32a045e9..c849dd2ccc 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,13 +1,13 @@
 /*
- * perlio.c Copyright (c) 1996-2001, Nick Ing-Simmons You may distribute 
+ * perlio.c Copyright (c) 1996-2001, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
- * Artistic License, as specified in the README file. 
+ * Artistic License, as specified in the README file.
  */
 
 /*
- * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get 
+ * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
  * at the dispatch tables, even when we do not need it for other reasons.
- * Invent a dSYS macro to abstract this out 
+ * Invent a dSYS macro to abstract this out
  */
 #ifdef PERL_IMPLICIT_SYS
 #define dSYS dTHX
@@ -25,7 +25,7 @@
 #define PERLIO_NOT_STDIO 0
 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
 /*
- * #define PerlIO FILE 
+ * #define PerlIO FILE
  */
 #endif
 /*
@@ -49,7 +49,7 @@ int
 perlsio_binmode(FILE *fp, int iotype, int mode)
 {
     /*
-     * This used to be contents of do_binmode in doio.c 
+     * This used to be contents of do_binmode in doio.c
      */
 #ifdef DOSISH
 #  if defined(atarist) || defined(__MINT__)
@@ -70,11 +70,11 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
 #endif
 #    if defined(WIN32) && defined(__BORLANDC__)
 	/*
-	 * The translation mode of the stream is maintained independent of 
+	 * The translation mode of the stream is maintained independent of
 	 * the translation mode of the fd in the Borland RTL (heavy
-	 * digging through their runtime sources reveal).  User has to set 
+	 * digging through their runtime sources reveal).  User has to set
 	 * the mode explicitly for the stream (though they don't document
-	 * this anywhere). GSAR 97-5-24 
+	 * this anywhere). GSAR 97-5-24
 	 */
 	fseek(fp, 0L, 0);
 	if (mode & O_BINARY)
@@ -108,7 +108,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
     }
     Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names);
     /*
-     * NOTREACHED 
+     * NOTREACHED
      */
     return -1;
 }
@@ -129,7 +129,7 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 }
 
 /*
- * De-mux PerlIO_openn() into fdopen, freopen and fopen type entries 
+ * De-mux PerlIO_openn() into fdopen, freopen and fopen type entries
  */
 
 PerlIO *
@@ -190,9 +190,9 @@ PerlIO_init(void)
 {
     /*
      * Does nothing (yet) except force this file to be included in perl
-     * binary. That allows this file to force inclusion of other functions 
+     * binary. That allows this file to force inclusion of other functions
      * that may be required by loadable extensions e.g. for
-     * FileHandle::tmpfile 
+     * FileHandle::tmpfile
      */
 }
 
@@ -212,7 +212,7 @@ PerlIO_tmpfile(void)
 
 /*
  * This section is just to make sure these functions get pulled in from
- * libsfio.a 
+ * libsfio.a
  */
 
 #undef PerlIO_tmpfile
@@ -228,13 +228,13 @@ PerlIO_init(void)
     /*
      * Force this file to be included in perl binary. Which allows this
      * file to force inclusion of other functions that may be required by
-     * loadable extensions e.g. for FileHandle::tmpfile 
+     * loadable extensions e.g. for FileHandle::tmpfile
      */
 
     /*
-     * Hack sfio does its own 'autoflush' on stdout in common cases. Flush 
+     * Hack sfio does its own 'autoflush' on stdout in common cases. Flush
      * results in a lot of lseek()s to regular files and lot of small
-     * writes to pipes. 
+     * writes to pipes.
      */
     sfset(sfstdout, SF_SHARE, 0);
 }
@@ -264,14 +264,14 @@ PerlIO_findFILE(PerlIO *pio)
 #else				/* USE_SFIO */
 /*======================================================================================*/
 /*
- * Implement all the PerlIO interface ourselves. 
+ * Implement all the PerlIO interface ourselves.
  */
 
 #include "perliol.h"
 
 /*
  * We _MUST_ have <unistd.h> if we are using lseek() and may have large
- * files 
+ * files
  */
 #ifdef I_UNISTD
 #include <unistd.h>
@@ -320,11 +320,11 @@ PerlIO_debug(const char *fmt, ...)
 /*--------------------------------------------------------------------------------------*/
 
 /*
- * Inner level routines 
+ * Inner level routines
  */
 
 /*
- * Table of pointers to the PerlIO structs (malloc'ed) 
+ * Table of pointers to the PerlIO structs (malloc'ed)
  */
 PerlIO *_perlio = NULL;
 #define PERLIO_TABLE_SIZE 64
@@ -335,7 +335,7 @@ PerlIO *
 PerlIO_allocate(pTHX)
 {
     /*
-     * Find a free slot in the table, allocating new table as necessary 
+     * Find a free slot in the table, allocating new table as necessary
      */
     PerlIO **last;
     PerlIO *f;
@@ -478,7 +478,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
 	    /*
 	     * If popped returns non-zero do not free its layer structure
 	     * it has either done so itself, or it is shared and still in
-	     * use 
+	     * use
 	     */
 	    if ((*l->tab->Popped) (f) != 0)
 		return;
@@ -490,7 +490,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * XS Interface for perl code 
+ * XS Interface for perl code
  */
 
 PerlIO_funcs *
@@ -512,7 +512,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	SV *layer = newSVpvn(name, len);
 	ENTER;
 	/*
-	 * The two SVs are magically freed by load_module 
+	 * The two SVs are magically freed by load_module
 	 */
 	Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
 	LEAVE;
@@ -653,7 +653,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    /*
 		     * Message is consistent with how attribute lists are
 		     * passed. Even though this means "foo : : bar" is
-		     * seen as an invalid separator character.  
+		     * seen as an invalid separator character.
 		     */
 		    char q = ((*s == '\'') ? '"' : '\'');
 		    Perl_warn(aTHX_
@@ -681,13 +681,13 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 			    /*
 			     * It's a nul terminated string, not allowed
 			     * to \ the terminating null. Anything other
-			     * character is passed over.  
+			     * character is passed over.
 			     */
 			    if (*e++) {
 				break;
 			    }
 			    /*
-			     * Drop through 
+			     * Drop through
 			     */
 			case '\0':
 			    e--;
@@ -697,7 +697,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 			    return -1;
 			default:
 			    /*
-			     * boring.  
+			     * boring.
 			     */
 			    break;
 			}
@@ -870,12 +870,12 @@ IV
 PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg)
 {
     /*
-     * Remove the dummy layer 
+     * Remove the dummy layer
      */
     dTHX;
     PerlIO_pop(aTHX_ f);
     /*
-     * Pop back to bottom layer 
+     * Pop back to bottom layer
      */
     if (f && *f) {
 	PerlIO_flush(f);
@@ -885,7 +885,7 @@ PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg)
 	    }
 	    else {
 		/*
-		 * Nothing bellow - push unix on top then remove it 
+		 * Nothing bellow - push unix on top then remove it
 		 */
 		if (PerlIO_push(aTHX_ f, PerlIO_default_btm(), mode, arg)) {
 		    PerlIO_pop(aTHX_ PerlIONext(f));
@@ -936,7 +936,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * Given the abstraction above the public API functions 
+ * Given the abstraction above the public API functions
  */
 
 int
@@ -1024,7 +1024,7 @@ PerlIO_context_layers(pTHX_ const char *mode)
 {
     const char *type = NULL;
     /*
-     * Need to supply default layer info from open.pm 
+     * Need to supply default layer info from open.pm
      */
     if (PL_curcop) {
 	SV *layers = PL_curcop->cop_io;
@@ -1033,7 +1033,7 @@ PerlIO_context_layers(pTHX_ const char *mode)
 	    type = SvPV(layers, len);
 	    if (type && mode[0] != 'r') {
 		/*
-		 * Skip to write part 
+		 * Skip to write part
 		 */
 		const char *s = strchr(type, 0);
 		if (s && (s - type) < len) {
@@ -1049,13 +1049,13 @@ static PerlIO_funcs *
 PerlIO_layer_from_ref(pTHX_ SV *sv)
 {
     /*
-     * For any scalar type load the handler which is bundled with perl 
+     * For any scalar type load the handler which is bundled with perl
      */
     if (SvTYPE(sv) < SVt_PVAV)
 	return PerlIO_find_layer(aTHX_ "Scalar", 6, 1);
 
     /*
-     * For other types allow if layer is known but don't try and load it 
+     * For other types allow if layer is known but don't try and load it
      */
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
@@ -1081,8 +1081,8 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
     if (narg) {
 	SV *arg = *args;
 	/*
-	 * If it is a reference but not an object see if we have a handler 
-	 * for it 
+	 * If it is a reference but not an object see if we have a handler
+	 * for it
 	 */
 	if (SvROK(arg) && !sv_isobject(arg)) {
 	    PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
@@ -1092,9 +1092,9 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 		incdef = 0;
 	    }
 	    /*
-	     * Don't fail if handler cannot be found :Via(...) etc. may do 
+	     * Don't fail if handler cannot be found :Via(...) etc. may do
 	     * something sensible else we will just stringfy and open
-	     * resulting string. 
+	     * resulting string.
 	     */
 	}
     }
@@ -1141,8 +1141,8 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	PerlIO_funcs *tab = NULL;
 	if (f && *f) {
 	    /*
-	     * This is "reopen" - it is not tested as perl does not use it 
-	     * yet 
+	     * This is "reopen" - it is not tested as perl does not use it
+	     * yet
 	     */
 	    PerlIOl *l = *f;
 	    layera = PerlIO_list_alloc();
@@ -1158,7 +1158,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args);
 	}
 	/*
-	 * Start at "top" of layer stack 
+	 * Start at "top" of layer stack
 	 */
 	n = layera->cur - 1;
 	while (n >= 0) {
@@ -1171,7 +1171,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	}
 	if (tab) {
 	    /*
-	     * Found that layer 'n' can do opens - call it 
+	     * Found that layer 'n' can do opens - call it
 	     */
 	    PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
 			 tab->name, layers, mode, fd, imode, perm, f, narg,
@@ -1182,7 +1182,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 		if (n + 1 < layera->cur) {
 		    /*
 		     * More layers above the one that we used to open -
-		     * apply them now 
+		     * apply them now
 		     */
 		    if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1)
 			!= 0) {
@@ -1311,7 +1311,7 @@ PerlIO_flush(PerlIO *f)
 	 * errorneous input? Maybe some magical value (PerlIO*
 	 * PERLIO_FLUSH_ALL = (PerlIO*)-1;)? Yes, stdio does similar
 	 * things on fflush(NULL), but should we be bound by their design
-	 * decisions? --jhi 
+	 * decisions? --jhi
 	 */
 	PerlIO **table = &_perlio;
 	int code = 0;
@@ -1517,7 +1517,7 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR * ptr, int cnt)
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * utf8 and raw dummy layers 
+ * utf8 and raw dummy layers
  */
 
 IV
@@ -1632,7 +1632,7 @@ PerlIO_funcs PerlIO_raw = {
 /*--------------------------------------------------------------------------------------*/
 /*--------------------------------------------------------------------------------------*/
 /*
- * "Methods" of the "base class" 
+ * "Methods" of the "base class"
  */
 
 IV
@@ -1744,7 +1744,7 @@ PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
 {
     dTHX;
     /*
-     * Save the position as current head considers it 
+     * Save the position as current head considers it
      */
     Off_t old = PerlIO_tell(f);
     SSize_t done;
@@ -1848,7 +1848,7 @@ PerlIOBase_setlinebuf(PerlIO *f)
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * Bottom-most level for UNIX-like case 
+ * Bottom-most level for UNIX-like case
  */
 
 typedef struct {
@@ -1903,7 +1903,7 @@ PerlIOUnix_oflags(const char *mode)
 	mode++;
     }
     /*
-     * Always open in binary mode 
+     * Always open in binary mode
      */
     oflags |= O_BINARY;
     if (*mode || oflags == -1) {
@@ -1927,9 +1927,9 @@ PerlIOUnix_pushed(PerlIO *f, const char *mode, SV *arg)
 	PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
 	s->fd = PerlIO_fileno(PerlIONext(f));
 	/*
-	 * XXX could (or should) we retrieve the oflags from the open file 
+	 * XXX could (or should) we retrieve the oflags from the open file
 	 * handle rather than believing the "mode" we are passed in? XXX
-	 * Should the value on NULL mode be 0 or -1? 
+	 * Should the value on NULL mode be 0 or -1?
 	 */
 	s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
     }
@@ -1977,13 +1977,55 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
 	if (f) {
 	    /*
-	     * FIXME: pop layers ??? 
+	     * FIXME: pop layers ???
 	     */
 	}
 	return NULL;
     }
 }
 
+PerlIO *
+PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+    PerlIO_funcs *self = PerlIOBase(o)->tab;
+    SV *arg = Nullsv;
+    char buf[8];
+    if (self->Getarg) {
+	arg = (*self->Getarg)(o);
+#ifdef sv_dup
+	if (arg) {
+	    arg = sv_dup(arg, param);
+	}
+#endif
+    }
+    if (!f) {
+	f = PerlIO_allocate(aTHX);
+    }
+    f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+    return f;
+}
+
+PerlIO *
+PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+    PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
+    int fd = PerlLIO_dup(os->fd);
+    if (fd >= 0) {
+	f = PerlIOBase_dup(aTHX_ f, o, param);
+	if (f) {
+	    /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
+	    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+	    s->fd = fd;
+	    return f;
+	}
+	else {
+	    PerlLIO_close(fd);
+	}
+    }
+    return NULL;
+}
+
+
 SSize_t
 PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
 {
@@ -2037,6 +2079,7 @@ PerlIOUnix_tell(PerlIO *f)
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
+
 IV
 PerlIOUnix_close(PerlIO *f)
 {
@@ -2065,6 +2108,7 @@ PerlIO_funcs PerlIO_unix = {
     PerlIOUnix_open,
     NULL,
     PerlIOUnix_fileno,
+    PerlIOUnix_dup,
     PerlIOUnix_read,
     PerlIOBase_unread,
     PerlIOUnix_write,
@@ -2086,7 +2130,7 @@ PerlIO_funcs PerlIO_unix = {
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * stdio as a layer 
+ * stdio as a layer
  */
 
 typedef struct {
@@ -2116,7 +2160,7 @@ PerlIOStdio_mode(const char *mode, char *tmode)
 }
 
 /*
- * This isn't used yet ... 
+ * This isn't used yet ...
  */
 IV
 PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg)
@@ -2237,7 +2281,7 @@ PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
 	STDCHAR *buf = (STDCHAR *) vbuf;
 	/*
 	 * Perl is expecting PerlIO_getc() to fill the buffer Linux's
-	 * stdio does not do that for fread() 
+	 * stdio does not do that for fread()
 	 */
 	int ch = PerlSIO_fgetc(s);
 	if (ch != EOF) {
@@ -2325,12 +2369,12 @@ PerlIOStdio_flush(PerlIO *f)
 #if 0
 	/*
 	 * FIXME: This discards ungetc() and pre-read stuff which is not
-	 * right if this is just a "sync" from a layer above Suspect right 
+	 * right if this is just a "sync" from a layer above Suspect right
 	 * design is to do _this_ but not have layer above flush this
-	 * layer read-to-read 
+	 * layer read-to-read
 	 */
 	/*
-	 * Not writeable - sync by attempting a seek 
+	 * Not writeable - sync by attempting a seek
 	 */
 	int err = errno;
 	if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
@@ -2347,7 +2391,7 @@ PerlIOStdio_fill(PerlIO *f)
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     int c;
     /*
-     * fflush()ing read-only streams can cause trouble on some stdio-s 
+     * fflush()ing read-only streams can cause trouble on some stdio-s
      */
     if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) {
 	if (PerlSIO_fflush(stdio) != 0)
@@ -2442,7 +2486,7 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 #endif
 #if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
 	/*
-	 * Setting ptr _does_ change cnt - we are done 
+	 * Setting ptr _does_ change cnt - we are done
 	 */
 	return;
 #endif
@@ -2451,7 +2495,7 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 #endif				/* STDIO_PTR_LVALUE */
     }
     /*
-     * Now (or only) set cnt 
+     * Now (or only) set cnt
      */
 #ifdef STDIO_CNT_LVALUE
     PerlSIO_set_cnt(stdio, cnt);
@@ -2468,6 +2512,12 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 
 #endif
 
+PerlIO *
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
 PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
@@ -2477,6 +2527,7 @@ PerlIO_funcs PerlIO_stdio = {
     PerlIOStdio_open,
     NULL,
     PerlIOStdio_fileno,
+    PerlIOStdio_dup,
     PerlIOStdio_read,
     PerlIOStdio_unread,
     PerlIOStdio_write,
@@ -2551,7 +2602,7 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * perlio buffer layer 
+ * perlio buffer layer
  */
 
 IV
@@ -2595,7 +2646,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	if (*mode == 'I') {
 	    init = 1;
 	    /*
-	     * mode++; 
+	     * mode++;
 	     */
 	}
 	f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
@@ -2605,13 +2656,13 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	    fd = PerlIO_fileno(f);
 #if O_BINARY != O_TEXT
 	    /*
-	     * do something about failing setmode()? --jhi 
+	     * do something about failing setmode()? --jhi
 	     */
 	    PerlLIO_setmode(fd, O_BINARY);
 #endif
 	    if (init && fd == 2) {
 		/*
-		 * Initial stderr is unbuffered 
+		 * Initial stderr is unbuffered
 		 */
 		PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
 	    }
@@ -2622,7 +2673,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 
 /*
  * This "flush" is akin to sfio's sync in that it handles files in either
- * read or write state 
+ * read or write state
  */
 IV
 PerlIOBuf_flush(PerlIO *f)
@@ -2631,7 +2682,7 @@ PerlIOBuf_flush(PerlIO *f)
     int code = 0;
     if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
 	/*
-	 * write() the buffer 
+	 * write() the buffer
 	 */
 	STDCHAR *buf = b->buf;
 	STDCHAR *p = buf;
@@ -2652,12 +2703,12 @@ PerlIOBuf_flush(PerlIO *f)
     else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
 	STDCHAR *buf = PerlIO_get_base(f);
 	/*
-	 * Note position change 
+	 * Note position change
 	 */
 	b->posn += (b->ptr - buf);
 	if (b->ptr < b->end) {
 	    /*
-	     * We did not consume all of it 
+	     * We did not consume all of it
 	     */
 	    if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) == 0) {
 		b->posn = PerlIO_tell(PerlIONext(f));
@@ -2667,7 +2718,7 @@ PerlIOBuf_flush(PerlIO *f)
     b->ptr = b->end = b->buf;
     PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
     /*
-     * FIXME: Is this right for read case ? 
+     * FIXME: Is this right for read case ?
      */
     if (PerlIO_flush(PerlIONext(f)) != 0)
 	code = -1;
@@ -2684,7 +2735,7 @@ PerlIOBuf_fill(PerlIO *f)
      * FIXME: doing the down-stream flush is a bad idea if it causes
      * pre-read data in stdio buffer to be discarded but this is too
      * simplistic - as it skips _our_ hosekeeping and breaks tell tests.
-     * if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { } 
+     * if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { }
      */
     if (PerlIO_flush(f) != 0)
 	return -1;
@@ -2700,7 +2751,7 @@ PerlIOBuf_fill(PerlIO *f)
 	 * Layer below is also buffered We do _NOT_ want to call its
 	 * ->Read() because that will loop till it gets what we asked for
 	 * which may hang on a pipe etc. Instead take anything it has to
-	 * hand, or ask it to fill _once_. 
+	 * hand, or ask it to fill _once_.
 	 */
 	avail = PerlIO_get_cnt(n);
 	if (avail <= 0) {
@@ -2763,27 +2814,27 @@ PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
 	if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
 	    /*
 	     * Buffer is already a read buffer, we can overwrite any chars
-	     * which have been read back to buffer start 
+	     * which have been read back to buffer start
 	     */
 	    avail = (b->ptr - b->buf);
 	}
 	else {
 	    /*
 	     * Buffer is idle, set it up so whole buffer is available for
-	     * unread 
+	     * unread
 	     */
 	    avail = b->bufsiz;
 	    b->end = b->buf + avail;
 	    b->ptr = b->end;
 	    PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
 	    /*
-	     * Buffer extends _back_ from where we are now 
+	     * Buffer extends _back_ from where we are now
 	     */
 	    b->posn -= b->bufsiz;
 	}
 	if (avail > (SSize_t) count) {
 	    /*
-	     * If we have space for more than count, just move count 
+	     * If we have space for more than count, just move count
 	     */
 	    avail = count;
 	}
@@ -2792,7 +2843,7 @@ PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
 	    buf -= avail;
 	    /*
 	     * In simple stdio-like ungetc() case chars will be already
-	     * there 
+	     * there
 	     */
 	    if (buf != b->ptr) {
 		Copy(buf, b->ptr, avail, STDCHAR);
@@ -2870,12 +2921,12 @@ PerlIOBuf_tell(PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     /*
-     * b->posn is file position where b->buf was read, or will be written 
+     * b->posn is file position where b->buf was read, or will be written
      */
     Off_t posn = b->posn;
     if (b->buf) {
 	/*
-	 * If buffer is valid adjust position by amount in buffer 
+	 * If buffer is valid adjust position by amount in buffer
 	 */
 	posn += (b->ptr - b->buf);
     }
@@ -2958,6 +3009,14 @@ PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
 }
 
+PerlIO *
+PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
+
+
 PerlIO_funcs PerlIO_perlio = {
     "perlio",
     sizeof(PerlIOBuf),
@@ -2967,6 +3026,7 @@ PerlIO_funcs PerlIO_perlio = {
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,
+    PerlIOBuf_dup,
     PerlIOBuf_read,
     PerlIOBuf_unread,
     PerlIOBuf_write,
@@ -2988,14 +3048,14 @@ PerlIO_funcs PerlIO_perlio = {
 
 /*--------------------------------------------------------------------------------------*/
 /*
- * Temp layer to hold unread chars when cannot do it any other way 
+ * Temp layer to hold unread chars when cannot do it any other way
  */
 
 IV
 PerlIOPending_fill(PerlIO *f)
 {
     /*
-     * Should never happen 
+     * Should never happen
      */
     PerlIO_flush(f);
     return 0;
@@ -3005,7 +3065,7 @@ IV
 PerlIOPending_close(PerlIO *f)
 {
     /*
-     * A tad tricky - flush pops us, then we close new top 
+     * A tad tricky - flush pops us, then we close new top
      */
     PerlIO_flush(f);
     return PerlIO_close(f);
@@ -3015,7 +3075,7 @@ IV
 PerlIOPending_seek(PerlIO *f, Off_t offset, int whence)
 {
     /*
-     * A tad tricky - flush pops us, then we seek new top 
+     * A tad tricky - flush pops us, then we seek new top
      */
     PerlIO_flush(f);
     return PerlIO_seek(f, offset, whence);
@@ -3052,8 +3112,8 @@ PerlIOPending_pushed(PerlIO *f, const char *mode, SV *arg)
     IV code = PerlIOBase_pushed(f, mode, arg);
     PerlIOl *l = PerlIOBase(f);
     /*
-     * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets() 
-     * etc. get muddled when it changes mid-string when we auto-pop. 
+     * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
+     * etc. get muddled when it changes mid-string when we auto-pop.
      */
     l->flags = (l->flags & ~(PERLIO_F_FASTGETS | PERLIO_F_UTF8)) |
 	(PerlIOBase(PerlIONext(f))->
@@ -3088,6 +3148,7 @@ PerlIO_funcs PerlIO_pending = {
     NULL,
     NULL,
     PerlIOBase_fileno,
+    PerlIOBuf_dup,
     PerlIOPending_read,
     PerlIOBuf_unread,
     PerlIOBuf_write,
@@ -3113,12 +3174,12 @@ PerlIO_funcs PerlIO_pending = {
 /*
  * crlf - translation On read translate CR,LF to "\n" we do this by
  * overriding ptr/cnt entries to hand back a line at a time and keeping a
- * record of which nl we "lied" about. On write translate "\n" to CR,LF 
+ * record of which nl we "lied" about. On write translate "\n" to CR,LF
  */
 
 typedef struct {
     PerlIOBuf base;		/* PerlIOBuf stuff */
-    STDCHAR *nl;		/* Position of crlf we "lied" about in the 
+    STDCHAR *nl;		/* Position of crlf we "lied" about in the
 				 * buffer */
 } PerlIOCrlf;
 
@@ -3208,7 +3269,7 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 		    }
 		    else {
 			/*
-			 * Not CR,LF but just CR 
+			 * Not CR,LF but just CR
 			 */
 			nl++;
 			goto scan;
@@ -3216,12 +3277,12 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 		}
 		else {
 		    /*
-		     * Blast - found CR as last char in buffer 
+		     * Blast - found CR as last char in buffer
 		     */
 		    if (b->ptr < nl) {
 			/*
 			 * They may not care, defer work as long as
-			 * possible 
+			 * possible
 			 */
 			return (nl - b->ptr);
 		    }
@@ -3241,7 +3302,7 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 			if (code == 0)
 			    goto test;	/* fill() call worked */
 			/*
-			 * CR at EOF - just fall through 
+			 * CR at EOF - just fall through
 			 */
 		    }
 		}
@@ -3272,7 +3333,7 @@ PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     }
     else {
 	/*
-	 * Test code - delete when it works ... 
+	 * Test code - delete when it works ...
 	 */
 	STDCHAR *chk;
 	if (c->nl)
@@ -3294,7 +3355,7 @@ PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     if (c->nl) {
 	if (ptr > c->nl) {
 	    /*
-	     * They have taken what we lied about 
+	     * They have taken what we lied about
 	     */
 	    *(c->nl) = 0xd;
 	    c->nl = NULL;
@@ -3325,7 +3386,7 @@ PerlIOCrlf_write(PerlIO *f, const void *vbuf, Size_t count)
 		if (*buf == '\n') {
 		    if ((b->ptr + 2) > eptr) {
 			/*
-			 * Not room for both 
+			 * Not room for both
 			 */
 			PerlIO_flush(f);
 			break;
@@ -3376,6 +3437,7 @@ PerlIO_funcs PerlIO_crlf = {
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,
+    PerlIOBuf_dup,
     PerlIOBuf_read,		/* generic read works with ptr/cnt lies
 				 * ... */
     PerlIOCrlf_unread,		/* Put CR,LF in buffer for each '\n' */
@@ -3399,7 +3461,7 @@ PerlIO_funcs PerlIO_crlf = {
 #ifdef HAS_MMAP
 /*--------------------------------------------------------------------------------------*/
 /*
- * mmap as "buffer" layer 
+ * mmap as "buffer" layer
  */
 
 typedef struct {
@@ -3469,7 +3531,7 @@ PerlIOMmap_map(PerlIO *f)
 		if (b->posn < 0) {
 		    /*
 		     * This is a hack - should never happen - open should
-		     * have set it ! 
+		     * have set it !
 		     */
 		    b->posn = PerlIO_tell(PerlIONext(f));
 		}
@@ -3534,13 +3596,13 @@ PerlIOMmap_get_base(PerlIO *f)
     PerlIOBuf *b = &m->base;
     if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
 	/*
-	 * Already have a readbuffer in progress 
+	 * Already have a readbuffer in progress
 	 */
 	return b->buf;
     }
     if (b->buf) {
 	/*
-	 * We have a write buffer or flushed PerlIOBuf read buffer 
+	 * We have a write buffer or flushed PerlIOBuf read buffer
 	 */
 	m->bbuf = b->buf;	/* save it in case we need it again */
 	b->buf = NULL;		/* Clear to trigger below */
@@ -3549,7 +3611,7 @@ PerlIOMmap_get_base(PerlIO *f)
 	PerlIOMmap_map(f);	/* Try and map it */
 	if (!b->buf) {
 	    /*
-	     * Map did not work - recover PerlIOBuf buffer if we have one 
+	     * Map did not work - recover PerlIOBuf buffer if we have one
 	     */
 	    b->buf = m->bbuf;
 	}
@@ -3575,11 +3637,11 @@ PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
     }
     if (m->len) {
 	/*
-	 * Loose the unwritable mapped buffer 
+	 * Loose the unwritable mapped buffer
 	 */
 	PerlIO_flush(f);
 	/*
-	 * If flush took the "buffer" see if we have one from before 
+	 * If flush took the "buffer" see if we have one from before
 	 */
 	if (!b->buf && m->bbuf)
 	    b->buf = m->bbuf;
@@ -3598,14 +3660,14 @@ PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
     PerlIOBuf *b = &m->base;
     if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
 	/*
-	 * No, or wrong sort of, buffer 
+	 * No, or wrong sort of, buffer
 	 */
 	if (m->len) {
 	    if (PerlIOMmap_unmap(f) != 0)
 		return 0;
 	}
 	/*
-	 * If unmap took the "buffer" see if we have one from before 
+	 * If unmap took the "buffer" see if we have one from before
 	 */
 	if (!b->buf && m->bbuf)
 	    b->buf = m->bbuf;
@@ -3624,12 +3686,12 @@ PerlIOMmap_flush(PerlIO *f)
     PerlIOBuf *b = &m->base;
     IV code = PerlIOBuf_flush(f);
     /*
-     * Now we are "synced" at PerlIOBuf level 
+     * Now we are "synced" at PerlIOBuf level
      */
     if (b->buf) {
 	if (m->len) {
 	    /*
-	     * Unmap the buffer 
+	     * Unmap the buffer
 	     */
 	    if (PerlIOMmap_unmap(f) != 0)
 		code = -1;
@@ -3637,7 +3699,7 @@ PerlIOMmap_flush(PerlIO *f)
 	else {
 	    /*
 	     * We seem to have a PerlIOBuf buffer which was not mapped
-	     * remember it in case we need one later 
+	     * remember it in case we need one later
 	     */
 	    m->bbuf = b->buf;
 	}
@@ -3675,6 +3737,12 @@ PerlIOMmap_close(PerlIO *f)
     return code;
 }
 
+PerlIO *
+PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+{
+ return NULL;
+}
+
 
 PerlIO_funcs PerlIO_mmap = {
     "mmap",
@@ -3685,6 +3753,7 @@ PerlIO_funcs PerlIO_mmap = {
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,
+    PerlIOMmap_dup,
     PerlIOBuf_read,
     PerlIOMmap_unread,
     PerlIOMmap_write,
@@ -3775,7 +3844,7 @@ PerlIO_getname(PerlIO *f, char *buf)
 /*--------------------------------------------------------------------------------------*/
 /*
  * Functions which can be called on any kind of PerlIO implemented in
- * terms of above 
+ * terms of above
  */
 
 #undef PerlIO_getc
@@ -3877,7 +3946,7 @@ PerlIO *
 PerlIO_tmpfile(void)
 {
     /*
-     * I have no idea how portable mkstemp() is ... 
+     * I have no idea how portable mkstemp() is ...
      */
 #if defined(WIN32) || !defined(HAVE_MKSTEMP)
     dTHX;
@@ -3916,8 +3985,8 @@ PerlIO_tmpfile(void)
 
 /*======================================================================================*/
 /*
- * Now some functions in terms of above which may be needed even if we are 
- * not in true PerlIO mode 
+ * Now some functions in terms of above which may be needed even if we are
+ * not in true PerlIO mode
  */
 
 #ifndef HAS_FSETPOS
diff --git a/perliol.h b/perliol.h
index eb6a415a30..4c86661e62 100644
--- a/perliol.h
+++ b/perliol.h
@@ -26,6 +26,7 @@ struct _PerlIO_funcs {
 		     PerlIO *old, int narg, SV **args);
     SV *(*Getarg) (PerlIO *f);
     IV (*Fileno) (PerlIO *f);
+    PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, clone_params *param);
     /* Unix-like functions - cf sfio line disciplines */
      SSize_t(*Read) (PerlIO *f, void *vbuf, Size_t count);
      SSize_t(*Unread) (PerlIO *f, const void *vbuf, Size_t count);
@@ -119,6 +120,7 @@ extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n);
 /* Generic, or stub layer functions */
 
 extern IV PerlIOBase_fileno(PerlIO *f);
+extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param);
 extern IV PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg);
 extern IV PerlIOBase_popped(PerlIO *f);
 extern SSize_t PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count);