From de72a0a2f83a7d3d3d50d7d56d6f442eb3778175 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 2 Jun 2003 08:28:51 +0000
Subject: [PATCH] Since pulling in File::Temp for tempfiles would pull in also
 Fcntl, miniperl could not open up tempfiles.  This broke the use of miniperl
 in VMS, as noticed by Craig Berry. Try to cure this by moving the creation of
 tempfile into its own routine, my_tmpfp(), which gets compiled differently
 for miniperl and perl.

p4raw-id: //depot/perl@19656
---
 embed.fnc |  2 ++
 embed.h   |  6 ++++++
 op.c      | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 perlio.c  | 46 +++-----------------------------------------
 proto.h   |  2 ++
 5 files changed, 79 insertions(+), 43 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index be08619..a7ea6df 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -962,6 +962,8 @@ Adp	|void	|sv_nolocking	|SV *
 Adp	|void	|sv_nounlocking	|SV *
 Adp	|int	|nothreadhook
 
+p	|PerlIO*|my_tmpfp
+
 END_EXTERN_C
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index 5907e20..fab4e1a 100644
--- a/embed.h
+++ b/embed.h
@@ -1244,6 +1244,9 @@
 #define sv_nolocking		Perl_sv_nolocking
 #define sv_nounlocking		Perl_sv_nounlocking
 #define nothreadhook		Perl_nothreadhook
+#ifdef PERL_CORE
+#define my_tmpfp		Perl_my_tmpfp
+#endif
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define do_trans_simple		S_do_trans_simple
@@ -3716,6 +3719,9 @@
 #define sv_nolocking(a)		Perl_sv_nolocking(aTHX_ a)
 #define sv_nounlocking(a)	Perl_sv_nounlocking(aTHX_ a)
 #define nothreadhook()		Perl_nothreadhook(aTHX)
+#ifdef PERL_CORE
+#define my_tmpfp()		Perl_my_tmpfp(aTHX)
+#endif
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define do_trans_simple(a)	S_do_trans_simple(aTHX_ a)
diff --git a/op.c b/op.c
index efb94b6..4d64d83 100644
--- a/op.c
+++ b/op.c
@@ -6510,3 +6510,69 @@ const_sv_xsub(pTHX_ CV* cv)
     ST(0) = (SV*)XSANY.any_ptr;
     XSRETURN(1);
 }
+
+PerlIO*
+Perl_my_tmpfp(pTHX)
+{
+     dTHX;
+     PerlIO *f = NULL;
+     int fd = -1;
+#ifdef PERL_EXTERNAL_GLOB
+     /* File::Temp pulls in Fcntl, which may not be available with
+      *  e.g. miniperl, use mkstemp() or stdio tmpfile() instead. */
+#   ifdef HAS_MKSTEMP
+     SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+     fd = mkstemp(SvPVX(sv));
+     if (fd >= 0) {
+	  f = PerlIO_fdopen(fd, "w+");
+	  if (f) {
+	       PerlLIO_unlink(SvPVX(sv));
+	       SvREFCNT_dec(sv);
+	  }
+     }
+#   else
+     FILE *stdio = PerlSIO_tmpfile();
+     if (stdio) {
+	  if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
+			       &PerlIO_stdio, "w+", Nullsv))) {
+	       PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+	       s->stdio = stdio;
+	  }
+     }
+#   endif /* HAS_MKSTEMP */
+#else
+     /* We have internal glob, which probably also means that we 
+      * can also use File::Temp (which uses Fcntl) with impunity. */
+     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;
+     }
+     if (fd >= 0)
+	  f = PerlIO_fdopen(fd, "w+");
+#endif
+
+     return f;
+}
+
diff --git a/perlio.c b/perlio.c
index ac9887d..ae3e051 100644
--- a/perlio.c
+++ b/perlio.c
@@ -4814,42 +4814,10 @@ PerlIO_stdoutf(const char *fmt, ...)
 PerlIO *
 PerlIO_tmpfile(void)
 {
-     dTHX;
-     PerlIO *f = NULL;
-     int fd = -1;
-     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;
-     }
+     PerlIO *f = Perl_my_tmpfp();
 
-     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;
-     }
-
-     if (fd >= 0) {
-	  f = PerlIO_fdopen(fd, "w+");
-	  if (f)
-	    PerlIOBase(f)->flags |= PERLIO_F_TEMP;
-     }
+     if (f)
+	  PerlIOBase(f)->flags |= PERLIO_F_TEMP;
 
      return f;
 }
@@ -4980,11 +4948,3 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
     return result;
 }
 #endif
-
-
-
-
-
-
-
-
diff --git a/proto.h b/proto.h
index 1f03b3b..44d73be 100644
--- a/proto.h
+++ b/proto.h
@@ -920,6 +920,8 @@ PERL_CALLCONV void	Perl_sv_nolocking(pTHX_ SV *);
 PERL_CALLCONV void	Perl_sv_nounlocking(pTHX_ SV *);
 PERL_CALLCONV int	Perl_nothreadhook(pTHX);
 
+PERL_CALLCONV PerlIO*	Perl_my_tmpfp(pTHX);
+
 END_EXTERN_C
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
-- 
2.7.4