QuotedPrint.t

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index 1495ff5..01d485b 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -213,6 +213,15 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l = 0;
+#ifdef USE_STDIO
+           if (SvROK(*svp) && !strchr(name,'&')) {
+               if (ckWARN(WARN_IO))
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
+                           "Can't open a reference");
+               SETERRNO(EINVAL, LIB$_INVARG);
+               goto say_false;
+           }
+#endif /* USE_STDIO */
            name = SvOK(*svp) ? SvPV(*svp, l) : "";
            len = (I32)l;
            name = savepvn(name, len);
@@ -272,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");
@@ -307,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)) {
@@ -474,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)
@@ -522,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) {
@@ -572,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
             */
@@ -639,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;
@@ -895,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;
@@ -1154,7 +1182,7 @@ I32 fd;                   /* file descriptor */
 Off_t length;          /* length to set file to */
 {
     struct flock fl;
-    struct stat filebuf;
+    Stat_t filebuf;
 
     if (PerlLIO_fstat(fd, &filebuf) < 0)
        return -1;