From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 5 May 2003 07:23:57 +0000 (+0000)
Subject: Switch the new perlio way of opening anonymous temporary files
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=72e9304675ac276b2ac244c09a40ea9e7b9ea35d;p=p5sagit%2Fp5-mst-13.2.git

Switch the new perlio way of opening anonymous temporary files
open my $fh, '+>', undef
to using File::Temp.  Test it, and test also the "accidental
feature" of +< working the same way.
This should address [perl #21937].

p4raw-id: //depot/perl@19418
---

diff --git a/MANIFEST b/MANIFEST
index 52f193a..66f2303 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -561,6 +561,7 @@ ext/PerlIO/scalar/scalar.xs	PerlIO layer for scalars
 ext/PerlIO/t/encoding.t		See if PerlIO encoding conversion works
 ext/PerlIO/t/fail.t		See if bad layers fail
 ext/PerlIO/t/fallback.t		See if PerlIO fallbacks work
+ext/PerlIO/t/open.t		See if PerlIO certain special opens work
 ext/PerlIO/t/scalar.t		See if PerlIO::scalar works
 ext/PerlIO/t/via.t		See if PerlIO::via works
 ext/PerlIO/via/Makefile.PL	PerlIO layer for layers in perl
diff --git a/ext/PerlIO/t/open.t b/ext/PerlIO/t/open.t
new file mode 100644
index 0000000..7d870b9
--- /dev/null
+++ b/ext/PerlIO/t/open.t
@@ -0,0 +1,42 @@
+#!./perl
+
+use strict;
+use warnings;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    unless (find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: not perlio\n";
+	exit 0;
+    }
+    use Config;
+    unless (" $Config{extensions} " =~ / Fcntl /) {
+	print "1..0 # Skip: no Fcntl (how did you get this far?)\n";
+	exit 0;
+    }
+}
+
+use Test::More tests => 6;
+
+use Fcntl qw(:seek);
+
+{
+    ok((open my $fh, "+>", undef), "open my \$fh, '+>', undef");
+    print $fh "the right write stuff";
+    ok(seek($fh, 0, SEEK_SET), "seek to zero");
+    my $data = <$fh>;
+    is($data, "the right write stuff", "found the right stuff");
+}
+
+{
+    ok((open my $fh, "+<", undef), "open my \$fh, '+<', undef");
+    print $fh "the right read stuff";
+    ok(seek($fh, 0, SEEK_SET), "seek to zero");
+    my $data = <$fh>;
+    is($data, "the right read stuff", "found the right stuff");
+}
+
+
+
+
diff --git a/perlio.c b/perlio.c
index dfad448..c2ea42b 100644
--- a/perlio.c
+++ b/perlio.c
@@ -4746,35 +4746,49 @@ PerlIO_stdoutf(const char *fmt, ...)
 PerlIO *
 PerlIO_tmpfile(void)
 {
-    /*
-     * I have no idea how portable mkstemp() is ...
-     */
-#if defined(WIN32) || !defined(HAVE_MKSTEMP)
-    dTHX;
-    PerlIO *f = NULL;
-    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;
-	}
-    }
-    return f;
-#else
-    dTHX;
-    SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
-    int fd = mkstemp(SvPVX(sv));
-    PerlIO *f = NULL;
-    if (fd >= 0) {
-	f = PerlIO_fdopen(fd, "w+");
-	if (f) {
-	    PerlIOBase(f)->flags |= PERLIO_F_TEMP;
-	}
-	PerlLIO_unlink(SvPVX(sv));
-	SvREFCNT_dec(sv);
-    }
-    return f;
-#endif
+     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;
+     }
+
+     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);
+	  }
+     }
+
+     return f;
 }
 
 #undef HAS_FSETPOS
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index b538701..7b441e0 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2856,7 +2856,12 @@ argument being C<undef>:
 
     open(TMP, "+>", undef) or die ...
 
-opens a filehandle to an anonymous temporary file.
+opens a filehandle to an anonymous temporary file.  Also using "+<"
+works for symmetry, but you really should consider writing something
+to the temporary file first.  You will need to seek() to do the
+reading.  Starting from Perl 5.8.1 the temporary files are created
+using the File::Temp module for greater portability, in Perl 5.8.0 the
+mkstemp() system call (which has known bugs in some platforms) was used.
 
 File handles can be opened to "in memory" files held in Perl scalars via: