[prev in list] [next in list] [prev in thread] [next in thread]
List: perl5-porters
Subject: Re: futimes [PATCH]
From: "H.Merijn Brand" <h.m.brand () xs4all ! nl>
Date: 2005-10-31 22:41:46
Message-ID: 20051031234146.6a7e5dd8 () pc09
[Download RAW message or body]
On 31 Oct 2005 13:53:53 -0800, Gisle Aas <gisle@ActiveState.com> wrote:
> "H.Merijn Brand" <h.m.brand@xs4all.nl> writes:
>
> > > ...so if somebody wants to add the Configure probes for futimes I'll
> > > make perl use it..
> >
> > Done in change #25935
> >
> > If you have *real* code that uses HAS_FUTIMES, please include the removal
> > from handy.h in your patch, since it is only a tag there.
>
> This patch make utime use futimes/utimes if available.
Thanks, applied as change #25941
> --Gisle
>
>
> diff -ru perl-current/doio.c perl-hack/doio.c
> --- perl-current/doio.c 2005-10-30 10:21:21.000000000 +0100
> +++ perl-hack/doio.c 2005-10-31 22:30:05.000000000 +0100
> @@ -1766,12 +1766,15 @@
> }
> }
> 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 @@
> 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 @@
> 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 -ru perl-current/handy.h perl-hack/handy.h
> --- perl-current/handy.h 2005-10-31 19:18:10.000000000 +0100
> +++ perl-hack/handy.h 2005-10-31 20:51:24.000000000 +0100
> @@ -175,7 +175,7 @@
> #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 -ru perl-current/pod/perlfunc.pod perl-hack/pod/perlfunc.pod
> --- perl-current/pod/perlfunc.pod 2005-10-24 18:48:29.000000000 +0200
> +++ perl-hack/pod/perlfunc.pod 2005-10-31 21:00:24.000000000 +0100
> @@ -6779,6 +6779,10 @@
> 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 -ru perl-current/t/io/fs.t perl-hack/t/io/fs.t
> --- perl-current/t/io/fs.t 2005-07-16 10:35:08.000000000 +0200
> +++ perl-hack/t/io/fs.t 2005-10-31 22:45:27.000000000 +0100
> @@ -47,7 +47,7 @@
> 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 @@
>
> $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 "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");
>
>
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using Perl 5.6.2, 5.8.0, 5.8.5, & 5.9.2 on HP-UX 10.20, 11.00 & 11.11,
AIX 4.3 & 5.2, SuSE 9.2 & 9.3, and Cygwin. http://www.cmve.net/~merijn
Smoking perl: http://www.test-smoke.org, perl QA: http://qa.perl.org
reports to: smokers-reports@perl.org, perl-qa@perl.org
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic