X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=de6950b4bc39710464ab511f6aa18d7ac7533e03;hb=caf774a6b47c93401a4581fab332b04b560c89d5;hp=7c06b5a677cc7d77964447a5c89f9b539cbffe14;hpb=00f5185623ac489efbed49ff4cbdf42316dcf5fd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 7c06b5a..de6950b 100644
--- a/perlio.c
+++ b/perlio.c
@@ -214,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;
@@ -337,12 +337,13 @@ PerlIO_init(pTHX)
     sfset(sfstdout, SF_SHARE, 0);
 }
 
+/* This is not the reverse of PerlIO_exportFILE(), PerlIO_releaseFILE() is. */
 PerlIO *
 PerlIO_importFILE(FILE *stdio, const char *mode)
 {
     int fd = fileno(stdio);
     if (!mode || !*mode) {
-	mmode = "r+";
+	mode = "r+";
     }
     return PerlIO_fdopen(fd, mode);
 }
@@ -480,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;
     }
 }
@@ -659,15 +660,23 @@ 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);
+	    ENTER;
+	    SAVEINT(PL_in_load_module);
+	    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;
@@ -811,7 +820,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 {
@@ -915,6 +924,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)
 {
@@ -937,6 +986,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),
@@ -1026,18 +1076,6 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 }
 
 IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
-{
-    PerlIO_pop(aTHX_ f);
-    if (*f) {
-	PerlIO_flush(f);
-	PerlIO_pop(aTHX_ f);
-	return 0;
-    }
-    return -1;
-}
-
-IV
 PerlIOBase_binmode(pTHX_ PerlIO *f)
 {
    if (PerlIOValid(f)) {
@@ -1193,7 +1231,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;
     }
 }
@@ -1217,7 +1255,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;
     }
 }
@@ -1255,7 +1293,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
@@ -1295,7 +1333,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.
 	     */
@@ -1418,7 +1456,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;
     }
 }
@@ -1429,7 +1467,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;
     }
 }
@@ -1440,7 +1478,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;
     }
 }
@@ -1451,7 +1489,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;
     }
 }
@@ -1462,7 +1500,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;
     }
 }
@@ -1478,13 +1516,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;
 	}
     }
@@ -1536,7 +1574,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;
     }
 }
@@ -1547,7 +1585,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;
     }
 }
@@ -1558,7 +1596,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;
     }
 }
@@ -1569,7 +1607,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;
     }
 }
@@ -1580,7 +1618,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
@@ -1589,7 +1627,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
@@ -1691,6 +1729,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
     }
 }
 
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * utf8 and raw dummy layers
@@ -1818,35 +1857,38 @@ 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, PerlIO_funcs *tab)
 {
@@ -1873,7 +1915,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 	    l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE;
 	    break;
 	default:
-	    SETERRNO(EINVAL, LIB$_INVARG);
+	    SETERRNO(EINVAL, LIB_INVARG);
 	    return -1;
 	}
 	while (*mode) {
@@ -1888,7 +1930,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 		l->flags |= PERLIO_F_CRLF;
 		break;
 	    default:
-		SETERRNO(EINVAL, LIB$_INVARG);
+		SETERRNO(EINVAL, LIB_INVARG);
 		return -1;
 	    }
 	}
@@ -2199,7 +2241,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;
@@ -2307,8 +2349,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) {
@@ -2365,7 +2409,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
 	}
     }
     else {
-	SETERRNO(EBADF,SS$_IVCHAN);
+	SETERRNO(EBADF,SS_IVCHAN);
 	return -1;
     }
     while (PerlLIO_close(fd) != 0) {
@@ -2433,7 +2477,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 *
@@ -2450,25 +2499,30 @@ 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, 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 do 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, tab);
 }
@@ -2552,8 +2606,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 			s->stdio = stdio;
 			PerlIOUnix_refcnt_inc(fileno(s->stdio));
 		    }
+		    return f;
+		}
+		else {
+		    return NULL;
 		}
-		return f;
 	    }
 	}
 	if (fd >= 0) {
@@ -2605,11 +2662,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 = PerlSIO_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
@@ -2617,6 +2676,8 @@ 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));
     }
@@ -2631,11 +2692,26 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     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 dupfd = -1;
+	IV result;
+    	if (PerlIOUnix_refcnt_dec(fd) > 0) {
+	    /* File descriptor still in use */
+	    if (fd < 3) {
+	    	/* For STD* handles don't close the stdio at all */
+	    	return PerlIO_flush(f);
+	    }
+	    else {
+            	/* Tricky - must fclose(stdio) to free memory but not close(fd) */ 
+	    	dupfd = PerlLIO_dup(fd);
+	    }
+	}    
+        result = (
 #ifdef SOCKS5_VERSION_NAME
 	       (getsockopt
 		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
@@ -2645,6 +2721,15 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	       PerlSIO_fclose(stdio)
 #endif
 	);
+	if (dupfd >= 0) {
+	    /* We need to restore fd from the saved copy */
+	    if (PerlLIO_dup2(dupfd,fd) != fd)
+	      result = -1;
+	    if (PerlLIO_close(dupfd) != 0)
+	      result = -1; 
+	}
+	return result;
+    } 
 
 }
 
@@ -2945,7 +3030,7 @@ PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
-    PerlIOBase_pushed,
+    PerlIOStdio_pushed,
     PerlIOBase_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
@@ -2986,26 +3071,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, const char *mode)
+PerlIO_exportFILE(PerlIO * f, const char *mode)
 {
     dTHX;
-    FILE *stdio;
-    char buf[8];
-    PerlIO_flush(f);
-    if (!mode || !*mode) {
-	mode = PerlIO_modestr(f,buf);
-    }
-    stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
-    if (stdio) {
-	if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
-	    PerlIOStdio *s = PerlIOSelf(f,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)
 {
@@ -3021,6 +3120,7 @@ PerlIO_findFILE(PerlIO *f)
     return PerlIO_exportFILE(f, Nullch);
 }
 
+/* Use this to reverse PerlIO_exportFILE calls. */
 void
 PerlIO_releaseFILE(PerlIO *p, FILE *f)
 {
@@ -3327,6 +3427,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)
@@ -3385,6 +3490,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
@@ -3771,13 +3889,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 */
@@ -3993,7 +4114,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
@@ -4512,7 +4633,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
@@ -4532,7 +4653,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 #endif
 	}
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #endif
@@ -4619,3 +4740,6 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 
 
 
+
+
+