X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=2d5785baa91a7bd0768a1bb36e4a3d2a2e6b024c;hb=9cd675818fc1340670abcf2452a8cad2f8be19ac;hp=0fca6701a96f1a643cf3647cea9d7e3634b535fe;hpb=81b04369996fe19fbab7e8dfd28db6db516b0d90;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 0fca670..2d5785b 100644
--- a/perlio.c
+++ b/perlio.c
@@ -660,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;
@@ -2654,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
@@ -2666,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));
     }
@@ -2684,11 +2696,29 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	errno = EBADF;
 	return -1;
     }
-    if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
-	/* Do not close it but do flush any buffers */
-	return PerlIO_flush(f);
-    }
-    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) */ 
+#ifdef USE_THREADS
+    	    	/* Sarathy pointed out that another thread could reuse
+		   fd after fclose() but before we dup2() below
+		   so take out a MUTEX to shut them out 
+		 */  
+    	    	MUTEX_LOCK(&PerlIO_mutex);
+#endif
+	    	dupfd = PerlLIO_dup(fd);
+	    }
+	}    
+        result = (
 #ifdef SOCKS5_VERSION_NAME
 	       (getsockopt
 		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
@@ -2698,7 +2728,18 @@ 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;
+#ifdef USE_THREADS
+    	    MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+	    if (PerlLIO_close(dupfd) != 0)
+	      result = -1; 
+	}
+	return result;
+    } 
 }
 
 
@@ -3395,6 +3436,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)
@@ -3453,6 +3499,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