X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=78b2d18be54257c1d6bfa1c8b31275b63645e81d;hb=ca9279baf07d6843f58a31f1ce3ff7dc875faf1a;hp=05b53c91bfea7e030f530c0551c960b838c49457;hpb=287c8091529321306208d03ea400ad532aea56f5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 05b53c9..78b2d18 100644
--- a/perlio.c
+++ b/perlio.c
@@ -3323,10 +3323,11 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
 	stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
 	if (stdio) {
 	    PerlIOl *l = *f;
+	    PerlIO *f2;
 	    /* 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);
+	    if ((f2 = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+		PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
 		s->stdio = stdio;
 		/* Link previous lower layers under new one */
 		*PerlIONext(f) = l;
@@ -3404,9 +3405,12 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     if (PerlIOValid(f)) {
 	PerlIO *next = PerlIONext(f);
-	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);
+	PerlIO_funcs *tab =
+	     PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
+	if (tab && tab->Open)
+	     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, self) != 0) {
 	    return NULL;
 	}
@@ -3420,8 +3424,11 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	     * mode++;
 	     */
 	}
-	f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-			  f, narg, args);
+	if (tab && tab->Open)
+	     f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+			      f, narg, args);
+	else
+	     SETERRNO(EINVAL, LIB_INVARG);
 	if (f) {
 	    if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
 		/*
@@ -4817,45 +4824,39 @@ PerlIO_tmpfile(void)
      dTHX;
      PerlIO *f = NULL;
      int fd = -1;
-     SV *sv = Nullsv;
-     GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
-
-     if (!gv) {
-	  ENTER;
-	  Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
-			   newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv);
-	  gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
-	  GvIMPORTED_CV_on(gv);
-	  LEAVE;
-     }
-
-     if (gv && GvCV(gv)) {
-	  dSP;
-	  ENTER;
-	  SAVETMPS;
-	  PUSHMARK(SP);
-	  PUTBACK;
-	  if (call_sv((SV*)GvCV(gv), G_SCALAR)) {
-	       GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--));
-	       IO *io = gv ? GvIO(gv) : 0;
-	       fd = io ? PerlIO_fileno(IoIFP(io)) : -1;
-	  }
-	  SPAGAIN;
-	  PUTBACK;
-	  FREETMPS;
-	  LEAVE;
-     }
-
+#ifdef WIN32
+     fd = win32_tmpfd();
+     if (fd >= 0)
+	  f = PerlIO_fdopen(fd, "w+b");
+#else /* WIN32 */
+#    ifdef HAS_MKSTEMP
+     SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+
+     /*
+      * I have no idea how portable mkstemp() is ... NI-S
+      */
+     fd = mkstemp(SvPVX(sv));
      if (fd >= 0) {
 	  f = PerlIO_fdopen(fd, "w+");
-	  if (sv) {
-	       if (f)
-		    PerlIOBase(f)->flags |= PERLIO_F_TEMP;
-	       PerlLIO_unlink(SvPVX(sv));
-	       SvREFCNT_dec(sv);
-	  }
+	  if (f)
+	       PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+	  PerlLIO_unlink(SvPVX(sv));
+	  SvREFCNT_dec(sv);
      }
+#    else	/* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
+     FILE *stdio = PerlSIO_tmpfile();
 
+     if (stdio) {
+	  if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
+                               &PerlIO_stdio, "w+", Nullsv))) {
+               PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+
+               if (s)
+                    s->stdio = stdio;
+          }
+     }
+#    endif /* else HAS_MKSTEMP */
+#endif /* else WIN32 */
      return f;
 }