futimes [PATCH]

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

p4raw-id: //depot/perl@25941

4 files changed, 75 insertions, 10 deletions

diff --git a/doio.c b/doio.c
index 21bf98c381..c82740c950 100644
--- 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 7f1e1dd4cd..bb4c3422c4 100644
--- 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 fcf9f6ba05..3138eb9fa0 100644
--- 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 f1d5fc453b..4dd188e974 100755
--- 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");