X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=9cb12d0e6052239161b07ce8a75485258e28c912;hb=1ff4263c2be000d5dd4e3ae4643d6c34358e9dce;hp=73e3557ee40cc5cffee111e87133dd51a63c156b;hpb=9f7cd1361d495667028a2c63231ae8edb236962c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 73e3557..9cb12d0 100644
--- a/perlio.c
+++ b/perlio.c
@@ -158,7 +158,11 @@ PerlIO_intmode2str(int rawmode, char *mode, int *writing)
 int
 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 {
-    if (!names || !*names || strEQ(names, ":crlf") || strEQ(names, ":raw")) {
+    if (!names || !*names
+        || strEQ(names, ":crlf")
+        || strEQ(names, ":raw")
+        || strEQ(names, ":bytes")
+       ) {
 	return 0;
     }
     Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names);
@@ -210,7 +214,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 	return NULL;
     }
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
     }
 #endif
     return NULL;
@@ -333,12 +337,15 @@ PerlIO_init(pTHX)
     sfset(sfstdout, SF_SHARE, 0);
 }
 
+/* This is not the reverse of PerlIO_exportFILE(), PerlIO_releaseFILE() is. */
 PerlIO *
-PerlIO_importFILE(FILE *stdio, int fl)
+PerlIO_importFILE(FILE *stdio, const char *mode)
 {
     int fd = fileno(stdio);
-    PerlIO *r = PerlIO_fdopen(fd, "r+");
-    return r;
+    if (!mode || !*mode) {
+	mode = "r+";
+    }
+    return PerlIO_fdopen(fd, mode);
 }
 
 FILE *
@@ -474,7 +481,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 	return new;
     }
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return NULL;
     }
 }
@@ -628,7 +635,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
 	    if ((*l->tab->Popped) (aTHX_ f) != 0)
 		return;
 	}
-	*f = l->next;;
+	*f = l->next;
 	Safefree(l);
     }
 }
@@ -653,15 +660,28 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
     }
     if (load && PL_subname && PL_def_layerlist
 	&& PL_def_layerlist->cur >= 2) {
-	SV *pkgsv = newSVpvn("PerlIO", 6);
-	SV *layer = newSVpvn(name, len);
-	ENTER;
-	/*
-	 * The two SVs are magically freed by load_module
-	 */
-	Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
-	LEAVE;
-	return PerlIO_find_layer(aTHX_ name, len, 0);
+	if (PL_in_load_module) {
+	    Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer");
+	    return NULL;
+	} else {
+	    SV *pkgsv = newSVpvn("PerlIO", 6);
+	    SV *layer = newSVpvn(name, len);
+	    CV *cv  = get_cv("PerlIO::Layer::NoWarnings", FALSE);
+    	    ENTER;
+	    SAVEINT(PL_in_load_module);
+	    if (cv) {
+	        SAVESPTR(PL_warnhook);
+		PL_warnhook = (SV *) cv;
+	    }
+	    PL_in_load_module++;
+	    /*
+	     * The two SVs are magically freed by load_module
+	     */
+	    Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
+	    PL_in_load_module--;
+	    LEAVE;
+	    return PerlIO_find_layer(aTHX_ name, len, 0);
+	}
     }
     PerlIO_debug("Cannot find %.*s\n", (int) len, name);
     return NULL;
@@ -755,6 +775,17 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
     return sv;
 }
 
+XS(XS_PerlIO__Layer__NoWarnings)
+{
+    /* This is used as a %SIG{__WARN__} handler to supress warnings 
+       during loading of layers.
+     */
+    dXSARGS;
+    if (items)
+    	PerlIO_debug("warning:%s\n",SvPV_nolen(ST(0)));
+    XSRETURN(0);
+}
+
 XS(XS_PerlIO__Layer__find)
 {
     dXSARGS;
@@ -805,7 +836,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 			Perl_warner(aTHX_ packWARN(WARN_LAYER),
 			      "perlio: invalid separator character %c%c%c in layer specification list %s",
 			      q, *s, q, s);
-		    SETERRNO(EINVAL, LIB$_INVARG);
+		    SETERRNO(EINVAL, LIB_INVARG);
 		    return -1;
 		}
 		do {
@@ -909,6 +940,46 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def)
     return def;
 }
 
+IV
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+{
+    if (PerlIOValid(f)) {
+	PerlIO_flush(f);
+	PerlIO_pop(aTHX_ f);
+	return 0;
+    }
+    return -1;
+}
+
+PerlIO_funcs PerlIO_remove = {
+    sizeof(PerlIO_funcs),
+    "pop",
+    0,
+    PERLIO_K_DUMMY | PERLIO_K_UTF8,
+    PerlIOPop_pushed,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,                       /* flush */
+    NULL,                       /* fill */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,                       /* get_base */
+    NULL,                       /* get_bufsiz */
+    NULL,                       /* get_ptr */
+    NULL,                       /* get_cnt */
+    NULL,                       /* set_ptrcnt */
+};
+
 PerlIO_list_t *
 PerlIO_default_layers(pTHX)
 {
@@ -931,6 +1002,7 @@ PerlIO_default_layers(pTHX)
 	PerlIO_define_layer(aTHX_ & PerlIO_mmap);
 #endif
 	PerlIO_define_layer(aTHX_ & PerlIO_utf8);
+	PerlIO_define_layer(aTHX_ & PerlIO_remove);
 	PerlIO_define_layer(aTHX_ & PerlIO_byte);
 	PerlIO_list_push(aTHX_ PL_def_layerlist,
 			 PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
@@ -956,6 +1028,7 @@ Perl_boot_core_PerlIO(pTHX)
 	  __FILE__);
 #endif
     newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
+    newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__);
 }
 
 PerlIO_funcs *
@@ -984,17 +1057,35 @@ PerlIO_stdstreams(pTHX)
 PerlIO *
 PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 {
-    PerlIOl *l = NULL;
-    Newc('L',l,tab->size,char,PerlIOl);
-    if (l && f) {
-	Zero(l, tab->size, char);
-	l->next = *f;
-	l->tab = tab;
-	*f = l;
+    if (tab->fsize != sizeof(PerlIO_funcs)) {
+      mismatch:
+	Perl_croak(aTHX_ "Layer does not match this perl");
+    }
+    if (tab->size) {
+	PerlIOl *l = NULL;
+	if (tab->size < sizeof(PerlIOl)) {
+	    goto mismatch;
+	}
+	/* Real layer with a data area */
+	Newc('L',l,tab->size,char,PerlIOl);
+	if (l && f) {
+	    Zero(l, tab->size, char);
+	    l->next = *f;
+	    l->tab = tab;
+	    *f = l;
+	    PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
+			(mode) ? mode : "(Null)", (void*)arg);
+	    if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+		PerlIO_pop(aTHX_ f);
+		return NULL;
+	    }
+	}
+    }
+    else if (f) {
+	/* Pseudo-layer where push does its own stack adjust */
 	PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
 		     (mode) ? mode : "(Null)", (void*)arg);
-	if ((*l->tab->Pushed) (aTHX_ f, mode, arg) != 0) {
-	    PerlIO_pop(aTHX_ f);
+	if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
 	    return NULL;
 	}
     }
@@ -1002,45 +1093,57 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 }
 
 IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOBase_binmode(pTHX_ PerlIO *f)
 {
-    PerlIO_pop(aTHX_ f);
-    if (*f) {
-	PerlIO_flush(f);
-	PerlIO_pop(aTHX_ f);
+   if (PerlIOValid(f)) {
+	/* Is layer suitable for raw stream ? */
+	if (PerlIOBase(f)->tab->kind & PERLIO_K_RAW) {
+	    /* Yes - turn off UTF-8-ness, to undo UTF-8 locale effects */
+	    PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
+	}
+	else {
+	    /* Not suitable - pop it */
+	    PerlIO_pop(aTHX_ f);
+	}
 	return 0;
-    }
-    return -1;
+   }
+   return -1;
 }
 
 IV
-PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    /*
-     * Remove the dummy layer
-     */
-    PerlIO_pop(aTHX_ f);
-    /*
-     * Pop back to bottom layer
-     */
+
     if (PerlIOValid(f)) {
+	PerlIO *t;
+	PerlIOl *l;
 	PerlIO_flush(f);
-	while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW)) {
-	    if (*PerlIONext(f)) {
-		PerlIO_pop(aTHX_ f);
+	/*
+	 * Strip all layers that are not suitable for a raw stream
+	 */
+	t = f;
+	while (t && (l = *t)) {
+	    if (l->tab->Binmode) {
+		/* Has a handler - normal case */
+		if ((*l->tab->Binmode)(aTHX_ f) == 0) {
+		    if (*t == l) {
+			/* Layer still there - move down a layer */
+			t = PerlIONext(t);
+		    }
+		}
+		else {
+		    return -1;
+		}
 	    }
 	    else {
-		/*
-		 * Nothing bellow - push unix on top then remove it
-		 */
-		if (PerlIO_push(aTHX_ f, PerlIO_default_btm(), mode, arg)) {
-		    PerlIO_pop(aTHX_ PerlIONext(f));
-		}
-		break;
+		/* No handler - pop it */
+		PerlIO_pop(aTHX_ t);
 	    }
 	}
-	PerlIO_debug(":raw f=%p :%s\n", (void*)f, PerlIOBase(f)->tab->name);
-	return 0;
+	if (PerlIOValid(f)) {
+	    PerlIO_debug(":raw f=%p :%s\n", (void*)f, PerlIOBase(f)->tab->name);
+	    return 0;
+	}
     }
     return -1;
 }
@@ -1099,16 +1202,17 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 	return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
     }
     else {
-	/* FIXME?: Looking down the layer stack seems wrong,
-	   but is a way of reaching past (say) an encoding layer
-	   to flip CRLF-ness of the layer(s) below
-	 */
+	/* Fake 5.6 legacy of using this call to turn ON O_TEXT */
 #ifdef PERLIO_USING_CRLF
 	/* Legacy binmode only has meaning if O_TEXT has a value distinct from
 	   O_BINARY so we can look for it in mode.
 	 */
 	if (!(mode & O_BINARY)) {
 	    /* Text mode */
+	    /* FIXME?: Looking down the layer stack seems wrong,
+	       but is a way of reaching past (say) an encoding layer
+	       to flip CRLF-ness of the layer(s) below
+	     */
 	    while (*f) {
 		/* Perhaps we should turn on bottom-most aware layer
 		   e.g. Ilya's idea that UNIX TTY could serve
@@ -1131,31 +1235,10 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 	    return FALSE;
 	}
 #endif
-	/* Either asked for BINMODE or that is normal on this platform
-	   see if any CRLF aware layers are present and turn off the flag
-	   and possibly remove layer.
+	/* Legacy binmode is now _defined_ as being equivalent to pushing :raw
+	   So code that used to be here is now in PerlIORaw_pushed().
 	 */
-	while (*f) {
-	    if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) {
-		if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
-		    /* In text mode - flush any pending stuff and flip it */
-		    PerlIO_flush(f);
-		    PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
-#ifndef PERLIO_USING_CRLF
-		    /* CRLF is unusual case - if this is just the :crlf layer pop it */
-		    if (PerlIOBase(f)->tab == &PerlIO_crlf) {
-			PerlIO_pop(aTHX_ f);
-		    }
-#endif
-		    /* Normal case is only one layer doing this, so exit on first
-		       abnormal case can always do multiple binmode calls
-		     */
-		    return TRUE;
-		}
-	    }
-	    f = PerlIONext(f);
-	}
-	return TRUE;
+	return PerlIO_push(aTHX_ f, &PerlIO_raw, Nullch, Nullsv) ? TRUE : FALSE;
     }
 }
 
@@ -1165,7 +1248,7 @@ PerlIO__close(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1189,7 +1272,7 @@ Perl_PerlIO_fileno(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1227,7 +1310,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
      * 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);
+	return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
 
     /*
      * For other types allow if layer is known but don't try and load it
@@ -1267,7 +1350,7 @@ 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.
 	     */
@@ -1390,7 +1473,7 @@ Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1401,7 +1484,7 @@ Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1412,7 +1495,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1423,7 +1506,7 @@ Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1434,7 +1517,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1450,13 +1533,13 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
 	    }
 	    else {
 		PerlIO_debug("Cannot flush f=%p :%s\n", (void*)f, tab->name);
-		SETERRNO(EBADF, SS$_IVCHAN);
+		SETERRNO(EBADF, SS_IVCHAN);
 		return -1;
 	    }
 	}
 	else {
 	    PerlIO_debug("Cannot flush f=%p\n", (void*)f);
-	    SETERRNO(EBADF, SS$_IVCHAN);
+	    SETERRNO(EBADF, SS_IVCHAN);
 	    return -1;
 	}
     }
@@ -1508,7 +1591,7 @@ Perl_PerlIO_fill(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1519,7 +1602,7 @@ PerlIO_isutf8(PerlIO *f)
     if (PerlIOValid(f))
 	return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1530,7 +1613,7 @@ Perl_PerlIO_eof(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1541,7 +1624,7 @@ Perl_PerlIO_error(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
     else {
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
     }
 }
@@ -1552,7 +1635,7 @@ Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	(*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
     else
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 }
 
 void
@@ -1561,7 +1644,7 @@ Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
 	(*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
     else
-	SETERRNO(EBADF, SS$_IVCHAN);
+	SETERRNO(EBADF, SS_IVCHAN);
 }
 
 int
@@ -1663,17 +1746,16 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
     }
 }
 
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * utf8 and raw dummy layers
  */
 
 IV
-PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    if (*PerlIONext(f)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	PerlIO_pop(aTHX_ f);
+    if (PerlIOValid(f)) {
 	if (tab->kind & PERLIO_K_UTF8)
 	    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
 	else
@@ -1684,9 +1766,10 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 }
 
 PerlIO_funcs PerlIO_utf8 = {
+    sizeof(PerlIO_funcs),
     "utf8",
-    sizeof(PerlIOl),
-    PERLIO_K_DUMMY | PERLIO_F_UTF8,
+    0,
+    PERLIO_K_DUMMY | PERLIO_K_UTF8,
     PerlIOUtf8_pushed,
     NULL,
     NULL,
@@ -1712,8 +1795,9 @@ PerlIO_funcs PerlIO_utf8 = {
 };
 
 PerlIO_funcs PerlIO_byte = {
+    sizeof(PerlIO_funcs),
     "bytes",
-    sizeof(PerlIOl),
+    0,
     PERLIO_K_DUMMY,
     PerlIOUtf8_pushed,
     NULL,
@@ -1750,8 +1834,9 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 }
 
 PerlIO_funcs PerlIO_raw = {
+    sizeof(PerlIO_funcs),
     "raw",
-    sizeof(PerlIOl),
+    0,
     PERLIO_K_DUMMY,
     PerlIORaw_pushed,
     PerlIOBase_popped,
@@ -1789,44 +1874,46 @@ PerlIOBase_fileno(pTHX_ PerlIO *f)
 }
 
 char *
-PerlIO_modestr(PerlIO *f, char *buf)
+PerlIO_modestr(PerlIO * f, char *buf)
 {
     char *s = buf;
-    IV flags = PerlIOBase(f)->flags;
-    if (flags & PERLIO_F_APPEND) {
-	*s++ = 'a';
-	if (flags & PERLIO_F_CANREAD) {
-	    *s++ = '+';
+    if (PerlIOValid(f)) {
+	IV flags = PerlIOBase(f)->flags;
+	if (flags & PERLIO_F_APPEND) {
+	    *s++ = 'a';
+	    if (flags & PERLIO_F_CANREAD) {
+		*s++ = '+';
+	    }
 	}
-    }
-    else if (flags & PERLIO_F_CANREAD) {
-	*s++ = 'r';
-	if (flags & PERLIO_F_CANWRITE)
-	    *s++ = '+';
-    }
-    else if (flags & PERLIO_F_CANWRITE) {
-	*s++ = 'w';
-	if (flags & PERLIO_F_CANREAD) {
-	    *s++ = '+';
+	else if (flags & PERLIO_F_CANREAD) {
+	    *s++ = 'r';
+	    if (flags & PERLIO_F_CANWRITE)
+		*s++ = '+';
+	}
+	else if (flags & PERLIO_F_CANWRITE) {
+	    *s++ = 'w';
+	    if (flags & PERLIO_F_CANREAD) {
+		*s++ = '+';
+	    }
 	}
-    }
 #ifdef PERLIO_USING_CRLF
-    if (!(flags & PERLIO_F_CRLF))
-	*s++ = 'b';
+	if (!(flags & PERLIO_F_CRLF))
+	    *s++ = 'b';
 #endif
+    }
     *s = '\0';
     return buf;
 }
 
+
 IV
-PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIOl *l = PerlIOBase(f);
 #if 0
     const char *omode = mode;
     char temp[8];
 #endif
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
     l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE |
 		  PERLIO_F_TRUNCATE | PERLIO_F_APPEND);
     if (tab->Set_ptrcnt != NULL)
@@ -1845,7 +1932,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 	    l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE;
 	    break;
 	default:
-	    SETERRNO(EINVAL, LIB$_INVARG);
+	    SETERRNO(EINVAL, LIB_INVARG);
 	    return -1;
 	}
 	while (*mode) {
@@ -1860,7 +1947,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 		l->flags |= PERLIO_F_CRLF;
 		break;
 	    default:
-		SETERRNO(EINVAL, LIB$_INVARG);
+		SETERRNO(EINVAL, LIB_INVARG);
 		return -1;
 	    }
 	}
@@ -2171,7 +2258,7 @@ PerlIOUnix_oflags(const char *mode)
      */
     oflags |= O_BINARY;
     if (*mode || oflags == -1) {
-	SETERRNO(EINVAL, LIB$_INVARG);
+	SETERRNO(EINVAL, LIB_INVARG);
 	oflags = -1;
     }
     return oflags;
@@ -2184,12 +2271,12 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f)
 }
 
 IV
-PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
-	/* We never call down so any pending stuff now */
+	/* We never call down so do any pending stuff now */
 	PerlIO_flush(PerlIONext(f));
 	s->fd = PerlIO_fileno(PerlIONext(f));
 	/*
@@ -2232,12 +2319,11 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	    f = PerlIO_allocate(aTHX);
 	}
 	if (!PerlIOValid(f)) {
-	    s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg),
-			   PerlIOUnix);
-	}
-	else {
-	    s = PerlIOSelf(f, PerlIOUnix);
+	    if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
+		return NULL;
+	    }
 	}
+	s = PerlIOSelf(f, PerlIOUnix);
 	s->fd = fd;
 	s->oflags = imode;
 	PerlIOBase(f)->flags |= PERLIO_F_OPEN;
@@ -2280,8 +2366,10 @@ SSize_t
 PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
-    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) ||
+         PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
 	return 0;
+    }
     while (1) {
 	SSize_t len = PerlLIO_read(fd, vbuf, count);
 	if (len >= 0 || errno != EINTR) {
@@ -2338,7 +2426,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
 	}
     }
     else {
-	SETERRNO(EBADF,SS$_IVCHAN);
+	SETERRNO(EBADF,SS_IVCHAN);
 	return -1;
     }
     while (PerlLIO_close(fd) != 0) {
@@ -2355,12 +2443,14 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
 }
 
 PerlIO_funcs PerlIO_unix = {
+    sizeof(PerlIO_funcs),
     "unix",
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
     PerlIOUnix_pushed,
     PerlIOBase_popped,
     PerlIOUnix_open,
+    PerlIOBase_binmode,         /* binmode */
     NULL,
     PerlIOUnix_fileno,
     PerlIOUnix_dup,
@@ -2388,6 +2478,14 @@ PerlIO_funcs PerlIO_unix = {
  * stdio as a layer
  */
 
+#if defined(VMS) && !defined(STDIO_BUFFER_WRITABLE)
+/* perl5.8 - This ensures the last minute VMS ungetc fix is not
+   broken by the last second glibc 2.3 fix
+ */
+#define STDIO_BUFFER_WRITABLE
+#endif
+
+
 typedef struct {
     struct _PerlIO base;
     FILE *stdio;                /* The stream */
@@ -2396,7 +2494,12 @@ typedef struct {
 IV
 PerlIOStdio_fileno(pTHX_ PerlIO *f)
 {
-    return PerlSIO_fileno(PerlIOSelf(f, PerlIOStdio)->stdio);
+    FILE *s;
+    if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {
+	return PerlSIO_fileno(s);
+    }
+    errno = EBADF;
+    return -1;
 }
 
 char *
@@ -2413,65 +2516,69 @@ PerlIOStdio_mode(const char *mode, char *tmode)
     return ret;
 }
 
-/*
- * This isn't used yet ...
- */
 IV
-PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    if (*PerlIONext(f)) {
-	PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-	char tmode[8];
-	FILE *stdio =
-	    PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)), mode =
-			   PerlIOStdio_mode(mode, tmode));
-	if (stdio) {
-	    s->stdio = stdio;
-	    /* We never call down so any pending stuff now */
-	    PerlIO_flush(PerlIONext(f));
-	}
-	else
-	    return -1;
+    PerlIO *n;
+    if (PerlIOValid(f) && PerlIOValid(n = PerlIONext(f))) {
+        PerlIO_funcs *toptab = PerlIOBase(n)->tab;
+        if (toptab == tab) {
+	    /* Top is already stdio - pop self (duplicate) and use original */
+	    PerlIO_pop(aTHX_ f);
+	    return 0;
+	} else {
+	    int fd = PerlIO_fileno(n);
+	    char tmode[8];
+	    FILE *stdio;
+	    if (fd >= 0 && (stdio  = PerlSIO_fdopen(fd,
+			    mode = PerlIOStdio_mode(mode, tmode)))) {
+		PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+	    	/* We never call down so do any pending stuff now */
+	    	PerlIO_flush(PerlIONext(f));
+	    }
+	    else {
+		return -1;
+	    }
+        }
     }
-    return PerlIOBase_pushed(aTHX_ f, mode, arg);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
 }
 
 
 PerlIO *
-PerlIO_importFILE(FILE *stdio, int fl)
+PerlIO_importFILE(FILE *stdio, const char *mode)
 {
     dTHX;
     PerlIO *f = NULL;
     if (stdio) {
-	/* We need to probe to see how we can open the stream
-	   so start with read/write and then try write and read
-	   we dup() so that we can fclose without loosing the fd.
-
-	   Note that the errno value set by a failing fdopen
-	   varies between stdio implementations.
-	 */
-	int fd = PerlLIO_dup(fileno(stdio));
-	char *mode = "r+";
-	FILE *f2 = fdopen(fd, mode);
 	PerlIOStdio *s;
-	if (!f2) {
-	    mode = "w";
-	    f2 = fdopen(fd, mode);
-	}
-	if (!f2) {
-	    mode = "r";
-	    f2 = fdopen(fd, mode);
+	if (!mode || !*mode) {
+	    /* We need to probe to see how we can open the stream
+	       so start with read/write and then try write and read
+	       we dup() so that we can fclose without loosing the fd.
+
+	       Note that the errno value set by a failing fdopen
+	       varies between stdio implementations.
+	     */
+	    int fd = PerlLIO_dup(fileno(stdio));
+	    FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+"));
+	    if (!f2) {
+		f2 = PerlSIO_fdopen(fd, (mode = "w"));
+	    }
+	    if (!f2) {
+		f2 = PerlSIO_fdopen(fd, (mode = "r"));
+	    }
+	    if (!f2) {
+		/* Don't seem to be able to open */
+		PerlLIO_close(fd);
+		return f;
+	    }
+	    fclose(f2);
 	}
-	if (!f2) {
-	    /* Don't seem to be able to open */
-	    PerlLIO_close(fd);
-	    return f;
+	if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), &PerlIO_stdio, mode, Nullsv))) {
+	    s = PerlIOSelf(f, PerlIOStdio);
+	    s->stdio = stdio;
 	}
-	fclose(f2);
-	s = PerlIOSelf(PerlIO_push
-			   (aTHX_(f = PerlIO_allocate(aTHX)), &PerlIO_stdio,
-			    mode, Nullsv), PerlIOStdio);
-	s->stdio = stdio;
     }
     return f;
 }
@@ -2509,14 +2616,18 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		    if (!f) {
 			f = PerlIO_allocate(aTHX);
 		    }
-		    s = PerlIOSelf(PerlIO_push(aTHX_ f, self,
+		    if ((f = PerlIO_push(aTHX_ f, self,
 				    (mode = PerlIOStdio_mode(mode, tmode)),
-				    PerlIOArg),
-				   PerlIOStdio);
-		    s->stdio = stdio;
-		    PerlIOUnix_refcnt_inc(fileno(s->stdio));
+				    PerlIOArg))) {
+			s = PerlIOSelf(f, PerlIOStdio);
+			s->stdio = stdio;
+			PerlIOUnix_refcnt_inc(fileno(s->stdio));
+		    }
+		    return f;
+		}
+		else {
+		    return NULL;
 		}
-		return f;
 	    }
 	}
 	if (fd >= 0) {
@@ -2548,9 +2659,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		if (!f) {
 		    f = PerlIO_allocate(aTHX);
 		}
-		s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg), PerlIOStdio);
-		s->stdio = stdio;
-		PerlIOUnix_refcnt_inc(fileno(s->stdio));
+		if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
+		    s = PerlIOSelf(f, PerlIOStdio);
+		    s->stdio = stdio;
+		    PerlIOUnix_refcnt_inc(fileno(s->stdio));
+		}
 		return f;
 	    }
 	}
@@ -2566,11 +2679,13 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
      */
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
 	FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio;
+	int fd = fileno(stdio);
+	char mode[8];
 	if (flags & PERLIO_DUP_FD) {
-	    int fd = PerlLIO_dup(fileno(stdio));
-	    if (fd >= 0) {
-		char mode[8];
-		stdio = fdopen(fd, PerlIO_modestr(o,mode));
+	    int dfd = PerlLIO_dup(fileno(stdio));
+	    if (dfd >= 0) {
+		stdio = PerlSIO_fdopen(dfd, PerlIO_modestr(o,mode));
+		goto set_this;
 	    }
 	    else {
 		/* FIXME: To avoid messy error recovery if dup fails
@@ -2578,58 +2693,194 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 		 */
 	    }
 	}
+    	stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode));
+    set_this:
 	PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
 	PerlIOUnix_refcnt_inc(fileno(stdio));
     }
     return f;
 }
 
+static int
+PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
+{
+    /* XXX this could use PerlIO_canset_fileno() and
+     * PerlIO_set_fileno() support from Configure 
+     */
+#  if defined(__GLIBC__)
+    /* There may be a better way for GLIBC:
+    	- libio.h defines a flag to not close() on cleanup 
+     */	
+    f->_fileno = -1;
+    return 1;
+#  elif defined(__sun__)
+#    if defined(_LP64)
+    /* On solaris, if _LP64 is defined, the FILE structure is this:
+     *
+     *  struct FILE {
+     *      long __pad[16];
+     *  };
+     *
+     * It turns out that the fd is stored in the top 32 bits of 
+     * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears
+     * to contain a pointer or offset into another structure. All the
+     * remaining fields are zero.
+     *
+     * We set the top bits to -1 (0xFFFFFFFF).
+     */
+    f->__pad[4] |= 0xffffffff00000000L;
+    assert(fileno(f) == 0xffffffff);
+#    else /* !defined(_LP64) */
+    /* _file is just a unsigned char :-( 
+       Not clear why we dup() rather than using -1 
+       even if that would be treated as 0xFF - so will 
+       a dup fail ...
+     */
+    f->_file = PerlLIO_dup(fileno(f));
+#    endif /* defined(_LP64) */
+    return 1;
+#  elif defined(__hpux)
+    f->__fileH = 0xff;
+    f->__fileL = 0xff;
+    return 1;
+   /* Next one ->_file seems to be a reasonable fallback, i.e. if
+      your platform does not have special entry try this one.       
+      [For OSF only have confirmation for Tru64 (alpha)
+      but assume other OSFs will be similar.]
+    */    
+#  elif defined(_AIX) || defined(__osf__) || defined(__irix__)
+    f->_file = -1;
+    return 1;
+#  elif defined(__FreeBSD__)
+    /* There may be a better way on FreeBSD:
+        - we could insert a dummy func in the _close function entry 
+	f->_close = (int (*)(void *)) dummy_close; 
+     */
+    f->_file = -1;
+    return 1;
+#  elif defined(__CYGWIN__)
+    /* There may be a better way on CYGWIN:
+        - we could insert a dummy func in the _close function entry 
+	f->_close = (int (*)(void *)) dummy_close; 
+     */
+    f->_file = -1;
+    return 1;
+#  elif defined(WIN32)
+#    if defined(__BORLANDC__)
+    f->fd = PerlLIO_dup(fileno(f));
+#    else
+    f->_file = -1;
+#    endif
+    return 1;
+#  else
+#if 0
+    /* Sarathy's code did this - we fall back to a dup/dup2 hack 
+       (which isn't thread safe) instead
+     */  
+#    error "Don't know how to set FILE.fileno on your platform"
+#endif
+    return 0;
+#  endif
+}
+
 IV
 PerlIOStdio_close(pTHX_ PerlIO *f)
 {
-#ifdef SOCKS5_VERSION_NAME
-    int optval;
-    Sock_size_t optlen = sizeof(int);
-#endif
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
-	/* Do not close it but do flush any buffers */
-	return PerlIO_flush(f);
+    if (!stdio) {
+	errno = EBADF;
+	return -1;
     }
-    return (
+    else {
+        int fd = fileno(stdio);
+	int socksfd = 0;
+	int invalidate = 0;
+	IV result = 0;
+	int saveerr = 0;
+	int dupfd = 0;
 #ifdef SOCKS5_VERSION_NAME
-	       (getsockopt
-		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
-		 &optlen) <
-		0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
-#else
-	       PerlSIO_fclose(stdio)
+    	/* Socks lib overrides close() but stdio isn't linked to 
+	   that library (though we are) - so we must call close() 
+	   on sockets on stdio's behalf. 
+	 */   
+    	int optval;
+    	Sock_size_t optlen = sizeof(int);
+    	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
+            socksfd = 1;
+	    invalidate = 1;  
+    	}
 #endif
-	);
-
+    	if (PerlIOUnix_refcnt_dec(fd) > 0) {
+	    /* File descriptor still in use */
+	    invalidate = 1;
+	    socksfd = 0;
+	}    
+	if (invalidate) {
+   	    /* For STD* handles don't close the stdio at all 
+	       this is because we have shared the FILE * too 
+   	     */
+	    if (stdio == stdin) {
+	    	/* Some stdios are buggy fflush-ing inputs */
+	    	return 0;
+	    }
+	    else if (stdio == stdout || stdio == stderr) {
+	    	return PerlIO_flush(f);
+	    }
+            /* Tricky - must fclose(stdio) to free memory but not close(fd) 
+	       Use Sarathy's trick from maint-5.6 to invalidate the 
+	       fileno slot of the FILE * 
+	    */ 
+	    result = PerlIO_flush(f);
+	    saveerr = errno;
+    	    if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
+	    	dupfd = PerlLIO_dup(fd);
+	    }
+	} 
+        result = PerlSIO_fclose(stdio);
+	/* We treat error from stdio as success if we invalidated 
+	   errno may NOT be expected EBADF 
+	 */
+	if (invalidate && result != 0) {
+	    errno = saveerr;
+	    result = 0;
+	} 
+	if (socksfd) {
+	    /* in SOCKS case let close() determine return value */
+	    result = close(fd);
+	}
+	if (dupfd) {
+	    PerlLIO_dup2(dupfd,fd);
+	    close(dupfd);
+	}
+	return result;
+    } 
 }
 
-
-
 SSize_t
 PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
-    if (count == 1) {
-	STDCHAR *buf = (STDCHAR *) vbuf;
-	/*
-	 * Perl is expecting PerlIO_getc() to fill the buffer Linux's
-	 * stdio does not do that for fread()
-	 */
-	int ch = PerlSIO_fgetc(s);
-	if (ch != EOF) {
-	    *buf = ch;
-	    got = 1;
+    for (;;) {
+	if (count == 1) {
+	    STDCHAR *buf = (STDCHAR *) vbuf;
+	    /*
+	     * Perl is expecting PerlIO_getc() to fill the buffer Linux's
+	     * stdio does not do that for fread()
+	     */
+	    int ch = PerlSIO_fgetc(s);
+	    if (ch != EOF) {
+		*buf = ch;
+		got = 1;
+	    }
 	}
+	else
+	    got = PerlSIO_fread(vbuf, 1, count, s);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
     }
-    else
-	got = PerlSIO_fread(vbuf, 1, count, s);
     return got;
 }
 
@@ -2639,6 +2890,7 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     SSize_t unread = 0;
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
 
+#ifdef STDIO_BUFFER_WRITABLE
     if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
 	STDCHAR *buf = ((STDCHAR *) vbuf) + count;
 	STDCHAR *base = PerlIO_get_base(f);
@@ -2658,7 +2910,9 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 		PerlSIO_clearerr(s);
 	}
     }
-    else if (PerlIO_has_cntptr(f)) {
+    else
+#endif
+    if (PerlIO_has_cntptr(f)) {
 	/* We can get pointer to buffer but not its base
 	   Do ungetc() but check chars are ending up in the
 	   buffer
@@ -2691,8 +2945,16 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    return PerlSIO_fwrite(vbuf, 1, count,
-			  PerlIOSelf(f, PerlIOStdio)->stdio);
+    SSize_t got;
+    for (;;) {
+	got = PerlSIO_fwrite(vbuf, 1, count,
+			      PerlIOSelf(f, PerlIOStdio)->stdio);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
+    }
+    return got;
 }
 
 IV
@@ -2852,6 +3114,8 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
 	return EOF;
 
 #if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
+
+#ifdef STDIO_BUFFER_WRITABLE
     if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
 	/* Fake ungetc() to the real buffer in case system's ungetc
 	   goes elsewhere
@@ -2867,7 +3131,9 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
 	    return 0;
 	}
     }
-    else if (PerlIO_has_cntptr(f)) {
+    else
+#endif
+    if (PerlIO_has_cntptr(f)) {
 	STDCHAR ch = c;
 	if (PerlIOStdio_unread(aTHX_ f,&ch,1) == 1) {
 	    return 0;
@@ -2895,12 +3161,14 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
 
 
 PerlIO_funcs PerlIO_stdio = {
+    sizeof(PerlIO_funcs),
     "stdio",
     sizeof(PerlIOStdio),
-    PERLIO_K_BUFFERED,
-    PerlIOBase_pushed,
+    PERLIO_K_BUFFERED|PERLIO_K_RAW,
+    PerlIOStdio_pushed,
     PerlIOBase_popped,
     PerlIOStdio_open,
+    PerlIOBase_binmode,         /* binmode */
     NULL,
     PerlIOStdio_fileno,
     PerlIOStdio_dup,
@@ -2938,23 +3206,40 @@ PerlIO_funcs PerlIO_stdio = {
 #endif                          /* USE_STDIO_PTR */
 };
 
+/* Note that calls to PerlIO_exportFILE() are reversed using
+ * PerlIO_releaseFILE(), not importFILE. */
 FILE *
-PerlIO_exportFILE(PerlIO *f, int fl)
+PerlIO_exportFILE(PerlIO * f, const char *mode)
 {
     dTHX;
-    FILE *stdio;
-    char buf[8];
-    PerlIO_flush(f);
-    stdio = fdopen(PerlIO_fileno(f), PerlIO_modestr(f,buf));
-    if (stdio) {
-	PerlIOStdio *s =
-	    PerlIOSelf(PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv),
-		       PerlIOStdio);
-	s->stdio = stdio;
+    FILE *stdio = NULL;
+    if (PerlIOValid(f)) {
+	char buf[8];
+	PerlIO_flush(f);
+	if (!mode || !*mode) {
+	    mode = PerlIO_modestr(f, buf);
+	}
+	stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
+	if (stdio) {
+	    PerlIOl *l = *f;
+	    /* De-link any lower layers so new :stdio sticks */
+	    *f = NULL;
+	    if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+		PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+		s->stdio = stdio;
+		/* Link previous lower layers under new one */
+		*PerlIONext(f) = l;
+	    }
+	    else {
+		/* restore layers list */
+		*f = l;
+	    }
+	}
     }
     return stdio;
 }
 
+
 FILE *
 PerlIO_findFILE(PerlIO *f)
 {
@@ -2966,9 +3251,11 @@ PerlIO_findFILE(PerlIO *f)
 	}
 	l = *PerlIONext(&l);
     }
-    return PerlIO_exportFILE(f, 0);
+    /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */
+    return PerlIO_exportFILE(f, Nullch);
 }
 
+/* Use this to reverse PerlIO_exportFILE calls. */
 void
 PerlIO_releaseFILE(PerlIO *p, FILE *f)
 {
@@ -2993,19 +3280,20 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
  */
 
 IV
-PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     int fd = PerlIO_fileno(f);
-    Off_t posn;
     if (fd >= 0 && PerlLIO_isatty(fd)) {
 	PerlIOBase(f)->flags |= PERLIO_F_LINEBUF | PERLIO_F_TTY;
     }
-    posn = PerlIO_tell(PerlIONext(f));
-    if (posn != (Off_t) - 1) {
-	b->posn = posn;
+    if (*PerlIONext(f)) {
+	Off_t posn = PerlIO_tell(PerlIONext(f));
+	if (posn != (Off_t) - 1) {
+	    b->posn = posn;
+	}
     }
-    return PerlIOBase_pushed(aTHX_ f, mode, arg);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
 }
 
 PerlIO *
@@ -3018,7 +3306,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	PerlIO_funcs *tab =  PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
 	next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
 			  next, narg, args);
-	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) {
+	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
 	    return NULL;
 	}
     }
@@ -3101,19 +3389,26 @@ PerlIOBuf_flush(pTHX_ PerlIO *f)
 	 */
 	b->posn += (b->ptr - buf);
 	if (b->ptr < b->end) {
-	    /*
-	     * We did not consume all of it
+	    /* We did not consume all of it - try and seek downstream to
+	       our logical position
 	     */
-	    if (PerlIO_seek(n, b->posn, SEEK_SET) == 0) {
+	    if (PerlIOValid(n) && PerlIO_seek(n, b->posn, SEEK_SET) == 0) {
 		/* Reload n as some layers may pop themselves on seek */
 		b->posn = PerlIO_tell(n = PerlIONext(f));
 	    }
+	    else {
+		/* Seek failed (e.g. pipe or tty). Do NOT clear buffer or pre-read
+		   data is lost for good - so return saying "ok" having undone
+		   the position adjust
+		 */
+		b->posn -= (b->ptr - buf);
+		return code;
+	    }
 	}
     }
     b->ptr = b->end = b->buf;
     PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
     /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */
-    /* FIXME: Doing downstream flush may be sub-optimal see PerlIOBuf_fill() below */
     if (PerlIOValid(n) && PerlIO_flush(n) != 0)
 	code = -1;
     return code;
@@ -3126,10 +3421,8 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
     PerlIO *n = PerlIONext(f);
     SSize_t avail;
     /*
-     * FIXME: doing the down-stream flush maybe sub-optimal if it causes
-     * pre-read data in stdio buffer to be discarded.
-     * However, skipping the flush also skips _our_ hosekeeping
-     * and breaks tell tests. So we do the flush.
+     * Down-stream flush is defined not to loose read data so is harmless.
+     * we would not normally be fill'ing if there was data left in anycase.
      */
     if (PerlIO_flush(f) != 0)
 	return -1;
@@ -3140,6 +3433,12 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
 	PerlIO_get_base(f);     /* allocate via vtable */
 
     b->ptr = b->end = b->buf;
+
+    if (!PerlIOValid(n)) {
+	PerlIOBase(f)->flags |= PERLIO_F_EOF;
+	return -1;
+    }
+
     if (PerlIO_fast_gets(n)) {
 	/*
 	 * Layer below is also buffered. We do _NOT_ want to call its
@@ -3263,6 +3562,11 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 	PerlIO_get_base(f);
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
 	return 0;
+    if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
+    	if (PerlIO_flush(f) != 0) {
+	    return 0;
+	}
+    }	
     while (count > 0) {
 	SSize_t avail = b->bufsiz - (b->ptr - b->buf);
 	if ((SSize_t) count < avail)
@@ -3321,6 +3625,19 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
      * b->posn is file position where b->buf was read, or will be written
      */
     Off_t posn = b->posn;
+    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) && 
+        (PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
+#if 1
+    	/* As O_APPEND files are normally shared in some sense it is better
+	   to flush :
+	 */  	
+	PerlIO_flush(f);
+#else	
+        /* when file is NOT shared then this is sufficient */ 
+	PerlIO_seek(PerlIONext(f),0, SEEK_END);
+#endif
+	posn = b->posn = PerlIO_tell(PerlIONext(f));
+    }
     if (b->buf) {
 	/*
 	 * If buffer is valid adjust position by amount in buffer
@@ -3429,12 +3746,14 @@ PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 
 
 PerlIO_funcs PerlIO_perlio = {
+    sizeof(PerlIO_funcs),
     "perlio",
     sizeof(PerlIOBuf),
-    PERLIO_K_BUFFERED,
+    PERLIO_K_BUFFERED|PERLIO_K_RAW,
     PerlIOBuf_pushed,
     PerlIOBuf_popped,
     PerlIOBuf_open,
+    PerlIOBase_binmode,         /* binmode */
     NULL,
     PerlIOBase_fileno,
     PerlIOBuf_dup,
@@ -3517,9 +3836,9 @@ PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 }
 
 IV
-PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
-    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOl *l = PerlIOBase(f);
     /*
      * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
@@ -3550,12 +3869,14 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 }
 
 PerlIO_funcs PerlIO_pending = {
+    sizeof(PerlIO_funcs),
     "pending",
     sizeof(PerlIOBuf),
-    PERLIO_K_BUFFERED,
+    PERLIO_K_BUFFERED|PERLIO_K_RAW,  /* not sure about RAW here */
     PerlIOPending_pushed,
     PerlIOBuf_popped,
     NULL,
+    PerlIOBase_binmode,         /* binmode */
     NULL,
     PerlIOBase_fileno,
     PerlIOBuf_dup,
@@ -3594,11 +3915,11 @@ typedef struct {
 } PerlIOCrlf;
 
 IV
-PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     IV code;
     PerlIOBase(f)->flags |= PERLIO_F_CRLF;
-    code = PerlIOBuf_pushed(aTHX_ f, mode, arg);
+    code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab);
 #if 0
     PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n",
 		 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
@@ -3703,13 +4024,16 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
 			b->ptr++;       /* say we have read it as far as
 					 * flush() is concerned */
 			b->buf++;       /* Leave space in front of buffer */
+			/* Note as we have moved buf up flush's
+			   posn += ptr-buf
+			   will naturally make posn point at CR
+			 */
 			b->bufsiz--;    /* Buffer is thus smaller */
 			code = PerlIO_fill(f);  /* Fetch some more */
 			b->bufsiz++;    /* Restore size for next time */
 			b->buf--;       /* Point at space */
 			b->ptr = nl = b->buf;   /* Which is what we hand
 						 * off */
-			b->posn--;      /* Buffer starts here */
 			*nl = 0xd;      /* Fill in the CR */
 			if (code == 0)
 			    goto test;  /* fill() call worked */
@@ -3842,13 +4166,31 @@ PerlIOCrlf_flush(pTHX_ PerlIO *f)
     return PerlIOBuf_flush(aTHX_ f);
 }
 
+IV
+PerlIOCrlf_binmode(pTHX_ PerlIO *f)
+{
+    if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
+	/* In text mode - flush any pending stuff and flip it */
+	PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
+#ifndef PERLIO_USING_CRLF
+	/* CRLF is unusual case - if this is just the :crlf layer pop it */
+	if (PerlIOBase(f)->tab == &PerlIO_crlf) {
+		PerlIO_pop(aTHX_ f);
+	}
+#endif
+    }
+    return 0;
+}
+
 PerlIO_funcs PerlIO_crlf = {
+    sizeof(PerlIO_funcs),
     "crlf",
     sizeof(PerlIOCrlf),
-    PERLIO_K_BUFFERED | PERLIO_K_CANCRLF,
+    PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW,
     PerlIOCrlf_pushed,
     PerlIOBuf_popped,         /* popped */
     PerlIOBuf_open,
+    PerlIOCrlf_binmode,       /* binmode */
     NULL,
     PerlIOBase_fileno,
     PerlIOBuf_dup,
@@ -3907,7 +4249,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
 		if (!page_size) {
 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
 		    {
-			SETERRNO(0, SS$_NORMAL);
+			SETERRNO(0, SS_NORMAL);
 #   ifdef _SC_PAGESIZE
 			page_size = sysconf(_SC_PAGESIZE);
 #   else
@@ -4158,12 +4500,14 @@ PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 
 
 PerlIO_funcs PerlIO_mmap = {
+    sizeof(PerlIO_funcs),
     "mmap",
     sizeof(PerlIOMmap),
-    PERLIO_K_BUFFERED,
+    PERLIO_K_BUFFERED|PERLIO_K_RAW,
     PerlIOBuf_pushed,
     PerlIOBuf_popped,
     PerlIOBuf_open,
+    PerlIOBase_binmode,         /* binmode */
     NULL,
     PerlIOBase_fileno,
     PerlIOMmap_dup,
@@ -4377,11 +4721,10 @@ PerlIO_tmpfile(void)
     PerlIO *f = NULL;
     FILE *stdio = PerlSIO_tmpfile();
     if (stdio) {
-	PerlIOStdio *s =
-	    PerlIOSelf(PerlIO_push
-		       (aTHX_(f = PerlIO_allocate(aTHX)), &PerlIO_stdio,
-			"w+", Nullsv), PerlIOStdio);
-	s->stdio = stdio;
+	if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), &PerlIO_stdio, "w+", Nullsv))) {
+	    PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+	    s->stdio = stdio;
+	}
     }
     return f;
 #else
@@ -4425,7 +4768,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 	if (f && len == sizeof(Off_t))
 	    return PerlIO_seek(f, *posn, SEEK_SET);
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #else
@@ -4445,7 +4788,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 #endif
 	}
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #endif
@@ -4532,3 +4875,6 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 
 
 
+
+
+