Compress::Zlib 1.35

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

diff --git a/doio.c b/doio.c
index 0ecfe7d..9cd1326 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -566,7 +566,10 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
     }
     if (!fp) {
-       if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
+       if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
+           && strchr(name, '\n')
+           
+       )
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
        goto say_false;
     }
@@ -1079,7 +1082,7 @@ Perl_do_eof(pTHX_ GV *gv)
 
     if (!io)
        return TRUE;
-    else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
+    else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
        report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 
     while (IoIFP(io)) {
@@ -1418,8 +1421,8 @@ Perl_my_lstat(pTHX)
            return (PL_laststatval = -1);
        }
     }
-    else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT
-           && (PL_op->op_private & OPpFT_STACKED))
+    else if (PL_laststype != OP_LSTAT
+           && (PL_op->op_private & OPpFT_STACKED) && ckWARN(WARN_IO))
        Perl_croak(aTHX_ no_prev_lstat);
 
     PL_laststype = OP_LSTAT;
@@ -1456,9 +1459,10 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     if (sp > mark) {
-       Newx(PL_Argv, sp - mark + 1, char*);
-       char **a = PL_Argv;
+       char **a;
        const char *tmps = Nullch;
+       Newx(PL_Argv, sp - mark + 1, char*);
+       a = PL_Argv;
 
        while (++mark <= sp) {
            if (*mark)
@@ -1674,10 +1678,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPV_nolen_const(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_chmod(name, val))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_fchmod:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FCHMOD
+                       APPLY_TAINT_PROPER();
+                       if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val))
+                           tot--;
+#else
+                       Perl_die(aTHX_ PL_no_func, "fchmod");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_fchmod;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+                   if (PerlLIO_chmod(name, val))
+                       tot--;
+               }
            }
        }
        break;
@@ -1692,10 +1719,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPV_nolen_const(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_chown(name, val, val2))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_fchown:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FCHOWN
+                       APPLY_TAINT_PROPER();
+                       if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2))
+                           tot--;
+#else
+                       Perl_die(aTHX_ PL_no_func, "fchown");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_fchown;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+                   if (PerlLIO_chown(name, val, val2))
+                       tot--;
+               }
            }
        }
        break;