summaryrefslogtreecommitdiff
path: root/perlio.c
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2003-05-05 07:23:57 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2003-05-05 07:23:57 +0000
commit72e9304675ac276b2ac244c09a40ea9e7b9ea35d (patch)
tree6e13733d5ada70f81f4fdb7536d58d4fa1e6d91a /perlio.c
parentcc2b665ffc0f9d5e159fa5a9531ece4a29a86f36 (diff)
downloadperl-72e9304675ac276b2ac244c09a40ea9e7b9ea35d.tar.gz
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
Diffstat (limited to 'perlio.c')
-rw-r--r--perlio.c72
1 files changed, 43 insertions, 29 deletions
diff --git a/perlio.c b/perlio.c
index dfad448b77..c2ea42bc47 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