diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | op.c | 66 | ||||
| -rw-r--r-- | perlio.c | 46 | ||||
| -rw-r--r-- | proto.h | 2 |
5 files changed, 79 insertions, 43 deletions
@@ -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) @@ -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) @@ -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; +} + @@ -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 - - - - - - - - @@ -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) |