Integrate mainline

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

diff --git a/doio.c b/doio.c
index 89df5da..87e5901 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -68,28 +68,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    supplied_fp, &svs, 1);
 }
 
-static char *S_layers(pTHX_ char *mode);
-
-static char *
-S_layers(pTHX_ char *mode)
-{
-    char *type = NULL;
-     /* Need to supply default layer info from open.pm */
-    SV *layers = PL_curcop->cop_io;
-    if (layers) {
-        STRLEN len;
-        type = SvPV(layers,len);
-        if (type && mode[0] != 'r') {
-           /* Skip to write part */
-           char *s = strchr(type,0);
-           if (s && (s-type) < len) {
-               type = s+1;
-           }
-        }
-    }
-   return type;
-}
-
 bool
 Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
@@ -163,12 +141,14 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
         /* sysopen style args, i.e. integer mode and permissions */
        STRLEN ix = 0;
        if (num_svs != 0) {
-            Perl_croak(aTHX_ "panic:sysopen with multiple args");
+            Perl_croak(aTHX_ "panic: sysopen with multiple args");
        }
+       if (rawmode & (O_WRONLY|O_RDWR|O_APPEND|O_CREAT|O_TRUNC))
+           TAINT_PROPER("sysopen");
        mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
-       rawmode |= O_LARGEFILE;
+       rawmode |= O_LARGEFILE; /* Transparently largefiley. */
 #endif
 
 #ifndef O_ACCMODE
@@ -214,7 +194,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        namesv = sv_2mortal(newSVpvn(name,strlen(name)));
        num_svs = 1;
        svp = &namesv;
-       fp = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode, -1, rawmode, rawperm, NULL, num_svs, svp);
+        type = Nullch;
+       fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
     }
     else {
        /* Regular (non-sys) open */
@@ -231,8 +212,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            *tend-- = '\0';
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
-           STRLEN l;
-           name = SvPV(*svp, l) ;
+           STRLEN l = 0;
+           name = SvOK(*svp) ? SvPV(*svp, l) : "";
            len = (I32)l;
            name = savepvn(name, len);
            SAVEFREEPV(name);
@@ -391,7 +372,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    else
                        was_fdopen = TRUE;
                    if (!num_svs)
-                       type = S_layers(aTHX_ mode);
+                       type = Nullch;
                    if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
                        if (dodup)
                            PerlLIO_close(fd);
@@ -415,7 +396,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        namesv = sv_2mortal(newSVpvn(type,strlen(type)));
                        num_svs = 1;
                        svp = &namesv;
-                       type = S_layers(aTHX_ mode);
+                       type = Nullch;
                    }
                    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
                }
@@ -447,7 +428,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    namesv = sv_2mortal(newSVpvn(type,strlen(type)));
                    num_svs = 1;
                    svp = &namesv;
-                   type = S_layers(aTHX_ mode);
+                   type = Nullch;
                }
                fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
            }
@@ -510,7 +491,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    namesv = sv_2mortal(newSVpvn(type,strlen(type)));
                    num_svs = 1;
                    svp = &namesv;
-                   type = S_layers(aTHX_ mode);
+                   type = Nullch;
                }
                fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
            }
@@ -525,15 +506,19 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (ckWARN(WARN_IO)) {
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
-               Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
-                               (fp == PerlIO_stdout()) ? "out" : "err");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STD%s opened only for input",
+                           (fp == PerlIO_stdout()) ? "OUT" : "ERR");
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
-               Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STDIN opened only for output");
        }
     }
 
-    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
+    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD &&
+       /* FIXME: This next term is a hack to avoid fileno on PerlIO::Scalar */
+       !(num_svs && SvROK(*svp))) {
        if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
            (void)PerlIO_close(fp);
            goto say_false;
@@ -574,13 +559,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (savefd != fd) {
            Pid_t pid;
            SV *sv;
-           PerlLIO_dup2(fd, savefd);
+           if (PerlLIO_dup2(fd, savefd) < 0) {
+               (void)PerlIO_close(fp);
+               goto say_false;
+           }
 #ifdef VMS
            if (savefd != PerlIO_fileno(PerlIO_stdin())) {
              char newname[FILENAME_MAX+1];
              if (fgetname(fp, newname)) {
-               if (savefd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
-               if (savefd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR",  newname);
+               if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+               if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
              }
            }
 #endif
@@ -614,7 +602,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (IoTYPE(io) == IoTYPE_SOCKET
            || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) {
            mode[0] = 'w';
-           if (!(IoOFP(io) = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode,PerlIO_fileno(fp),0,0,NULL,num_svs,svp))) {
+           if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,PerlIO_fileno(fp),0,0,NULL,num_svs,svp))) {
                PerlIO_close(fp);
                IoIFP(io) = Nullfp;
                goto say_false;
@@ -1223,8 +1211,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
            if (!SvUTF8(sv))
                sv_utf8_upgrade(sv = sv_mortalcopy(sv));
        }
-       else if (DO_UTF8(sv))
-           sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE);
+       else if (DO_UTF8(sv)) {
+           if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) {
+               Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
+           }
+       }
        tmps = SvPV(sv, len);
        break;
     }