X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=01d485bfcd260a74d39d2ba4b7e8584213a8ef97;hb=415c47386cbaaeba799eb4450916189f62200e8b;hp=fdcef27c918efb207537a3e4a2a3aff90a493c8f;hpb=bb16914a1b288b55cfa63f9fac29d11db6d49b56;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index fdcef27..01d485b 100644 --- a/doio.c +++ b/doio.c @@ -281,6 +281,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, else { fp = PerlProc_popen(name,mode); } + if (num_svs) { + if (*type) { + if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { + goto say_false; + } + } + } } else if (*type == IoTYPE_WRONLY) { TAINT_PROPER("open"); @@ -316,7 +323,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (num_svs > 1) { Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io)); } - if (num_svs && SvIOK(*svp)) { + if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) { fd = SvUV(*svp); } else if (isDIGIT(*type)) { @@ -483,6 +490,14 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, fp = PerlProc_popen(name,mode); } IoTYPE(io) = IoTYPE_PIPE; + if (num_svs) { + for (; isSPACE(*type); type++) ; + if (*type) { + if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { + goto say_false; + } + } + } } else { if (num_svs) @@ -531,8 +546,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::Scalar) assume it isn't a - * socket - this covers PerlIO::Scalar - otherwise unless we "know" the + /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a + * socket - this covers PerlIO::scalar - otherwise unless we "know" the * type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { @@ -581,7 +596,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } if (savefd != fd) { - /* Still a small can-of-worms here if (say) PerlIO::Scalar + /* Still a small can-of-worms here if (say) PerlIO::scalar is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ @@ -648,8 +663,11 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (writing) { if (IoTYPE(io) == IoTYPE_SOCKET || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(PL_statbuf.st_mode)) ) { - mode[0] = 'w'; - if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,0,svp))) { + char *s = mode; + if (*s == 'I' || *s == '#') + s++; + *s = 'w'; + if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,svp))) { PerlIO_close(fp); IoIFP(io) = Nullfp; goto say_false; @@ -790,7 +808,7 @@ Perl_nextargv(pTHX_ register GV *gv) #endif } else { -#if !defined(DOSISH) && !defined(AMIGAOS) && !defined(__CYGWIN__) +#if !defined(DOSISH) && !defined(AMIGAOS) # ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(PL_oldname) < 0) { if (ckWARN_d(WARN_INPLACE)) @@ -904,6 +922,7 @@ Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv) goto badexit; IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; IoTYPE(wstio) = IoTYPE_WRONLY;