futimes [PATCH]

Message-ID: <lrk6ft8ia6.fsf_-_@caliper.activestate.com>

p4raw-id: //depot/perl@25941

diff --git a/doio.c b/doio.c
index 21bf98c..c82740c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1766,12 +1766,15 @@ nothing in the core.
            }
        }
        break;
-#ifdef HAS_UTIME
+#if defined(HAS_UTIME) || defined(HAS_FUTIMES)
     case OP_UTIME:
        what = "utime";
        APPLY_TAINT_PROPER();
        if (sp - mark > 2) {
-#if defined(I_UTIME) || defined(VMS)
+#if defined(HAS_FUTIMES)
+           struct timeval utbuf[2];
+           void *utbufp = utbuf;
+#elif defined(I_UTIME) || defined(VMS)
            struct utimbuf utbuf;
            struct utimbuf *utbufp = &utbuf;
 #else
@@ -1793,7 +1796,12 @@ nothing in the core.
                 utbufp = NULL;
            else {
                 Zero(&utbuf, sizeof utbuf, char);
-#ifdef BIG_TIME
+#ifdef HAS_FUTIMES
+               utbuf[0].tv_sec = (long)SvIVx(accessed);  /* time accessed */
+               utbuf[0].tv_usec = 0;
+               utbuf[1].tv_sec = (long)SvIVx(modified);  /* time modified */
+               utbuf[1].tv_usec = 0;
+#elif defined(BIG_TIME)
                 utbuf.actime = (Time_t)SvNVx(accessed);  /* time accessed */
                 utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */
 #else
@@ -1804,10 +1812,38 @@ nothing in the core.
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPV_nolen(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_utime(name, utbufp))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_futimes:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FUTIMES
+                       APPLY_TAINT_PROPER();
+                       if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), utbufp))
+                           tot--;
+#else
+                       Perl_die(aTHX_ PL_no_func, "futimes");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_futimes;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+#ifdef HAS_FUTIMES
+                   if (utimes(name, utbufp))
+#else
+                   if (PerlLIO_utime(name, utbufp))
+#endif
+                       tot--;
+               }
+
            }
        }
        else

diff --git a/handy.h b/handy.h
index 7f1e1dd..bb4c342 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -175,7 +175,7 @@ typedef U64TYPE U64;
 #endif
 
 /* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
-#if defined(HAS_MALLOC_SIZE) && defined(HAS_MALLOC_GOOD_SIZE) && defined(HAS_CLEARENV) && defined(HAS_FUTIMES)
+#if defined(HAS_MALLOC_SIZE) && defined(HAS_MALLOC_GOOD_SIZE) && defined(HAS_CLEARENV)
 /* Not (yet) used at top level, but mention them for metaconfig */
 #endif
 

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index fcf9f6b..3138eb9 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -6779,6 +6779,10 @@ be equivalent of passing it as 0 and will not have the same effect as
 described when they are both C<undef>.  This case will also trigger an
 uninitialized warning.
 
+On systems that support futimes, you might pass file handles among the
+files.  On systems that don't support futimes, passing file handles
+produces a fatal error at run time.
+
 =item values HASH
 X<values>
 

diff --git a/t/io/fs.t b/t/io/fs.t
index f1d5fc4..4dd188e 100755 (executable)
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -47,7 +47,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
 my $skip_mode_checks =
     $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
 
-plan tests => 42;
+plan tests => 49;
 
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -206,10 +206,27 @@ is($ino, undef, "ino of renamed file a should be undef");
 
 $delta = $accurate_timestamps ? 1 : 2; # Granularity of time on the filesystem
 chmod 0777, 'b';
-$foo = (utime 500000000,500000000 + $delta,'b');
 
+$foo = (utime 500000000,500000000 + $delta,'b');
 is($foo, 1, "utime");
+check_utime_result();
+
+utime undef, undef, 'b';
+($atime,$mtime) = (stat 'b')[8,9];
+print "# utime undef, undef --> $atime, $mtime\n";
+isnt($atime, 500000000, 'atime');
+isnt($mtime, 500000000 + $delta, 'mtime');
+
+SKIP: {
+    skip "no futimes", 4 unless ($Config{d_futimes} || "") eq "define";
+    open(my $fh, "<", 'b');
+    $foo = (utime 500000000,500000000 + $delta, $fh);
+    is($foo, 1, "futime");
+    check_utime_result();
+}
 
+
+sub check_utime_result {
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('b');
 
@@ -259,6 +276,14 @@ SKIP: {
         }
     }
 }
+}
+
+SKIP: {
+    skip "has futimes", 1 if ($Config{d_futimes} || "") eq "define";
+    open(my $fh, "<", "b") || die;
+    eval { utime(undef, undef, $fh); };
+    like($@, qr/^The futimes function is unimplemented at/, "futimes is unimplemented");
+}
 
 is(unlink('b'), 1, "unlink b");