From e96b369dc61077fe31b75895167f55dbce4d7519 Mon Sep 17 00:00:00 2001 From: Gisle Aas Date: Mon, 31 Oct 2005 05:53:53 -0800 Subject: futimes [PATCH] Message-ID: p4raw-id: //depot/perl@25941 --- doio.c | 50 +++++++++++++++++++++++++++++++++++++++++++------- handy.h | 2 +- pod/perlfunc.pod | 4 ++++ t/io/fs.t | 29 +++++++++++++++++++++++++++-- 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. 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 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"); -- cgit v1.2.1