Compress::Zlib 1.35

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

diff --git a/doio.c b/doio.c
index 4d7d19b..9cd1326 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -566,8 +566,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
     }
     if (!fp) {
-       if (IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')
-           && ckWARN(WARN_NEWLINE)
+       if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
+           && strchr(name, '\n')
+           
        )
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
        goto say_false;
@@ -1394,7 +1395,7 @@ Perl_my_stat(pTHX)
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-       if (PL_laststatval < 0 && strchr(s, '\n') && ckWARN(WARN_NEWLINE))
+       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
        return PL_laststatval;
     }
@@ -1677,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;
@@ -1695,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;