Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Time-HiRes CPAN distribution.

Report information
The Basics
Id:
83356
Status:
resolved
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
jaekel [...] cablecats.de
Cc:
AdminCc:

BugTracker
Severity:
Normal
Broken in:
1.9719
Fixed in:
1.9719



Subject: Patch to add lstat() call.
Time::HiRes provides a high-resolution version of stat(), but not of lstat(). (see issue 78732) This patch adds lstat(). It's based on version 1.9719 of Time::HiRes. (I've also submitted this patch via github repository "gitpan / Time-HiRes")
Subject: time-hires-lstat.patch
diff -u -r perl-5.10.1/ext/Time-HiRes/HiRes.pm perl-5.10.1.patched/ext/Time-HiRes/HiRes.pm --- perl-5.10.1/ext/Time-HiRes/HiRes.pm 2009-04-14 20:30:58.000000000 +0200 +++ perl-5.10.1.patched/ext/Time-HiRes/HiRes.pm 2013-02-14 17:49:30.931141000 +0100 @@ -20,7 +20,7 @@ d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep d_clock_gettime d_clock_getres d_clock d_clock_nanosleep - stat + stat lstat ); $VERSION = '1.9719'; @@ -86,7 +86,7 @@ use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock - stat ); + stat lstat ); usleep ($microseconds); nanosleep ($nanoseconds); @@ -124,10 +124,11 @@ my $ticktock = clock(); - use Time::HiRes qw( stat ); + use Time::HiRes qw( stat lstat ); my @stat = stat("file"); my @stat = stat(FH); + my @lstat = lstat("link"); =head1 DESCRIPTION @@ -423,6 +424,11 @@ the access time stamp from t2 need not be greater-than the modify time stamp from t1: it may be equal or I<less>. +=item lstat + +Like stat(), but for symbolic links. lstat() can not be performed +on filehandles. Always use a filename. + =back =head1 EXAMPLES @@ -489,8 +495,9 @@ my $clock1 = clock(); my $clockd = $clock1 - $clock0; - use Time::HiRes qw( stat ); + use Time::HiRes qw( stat lstat ); my ($atime, $mtime, $ctime) = (stat("istics"))[8, 9, 10]; + my ($atime, $mtime, $ctime) = (lstat("link"))[8, 9, 10]; =head1 C API @@ -569,7 +576,7 @@ Your system documentation for C<clock>, C<clock_gettime>, C<clock_getres>, C<clock_nanosleep>, C<clock_settime>, C<getitimer>, -C<gettimeofday>, C<setitimer>, C<sleep>, C<stat>, C<ualarm>. +C<gettimeofday>, C<setitimer>, C<sleep>, C<stat>, C<lstat>, C<ualarm>. =head1 AUTHORS diff -u -r perl-5.10.1/ext/Time-HiRes/HiRes.xs perl-5.10.1.patched/ext/Time-HiRes/HiRes.xs --- perl-5.10.1/ext/Time-HiRes/HiRes.xs 2009-04-14 20:30:58.000000000 +0200 +++ perl-5.10.1.patched/ext/Time-HiRes/HiRes.xs 2013-02-15 14:41:12.661185000 +0100 @@ -1255,3 +1255,37 @@ XSRETURN(13); } XSRETURN(0); + +void +lstat(...) +PROTOTYPE: ;$ + PPCODE: + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); + PUTBACK; + ENTER; + PL_laststatval = -1; + PL_op->op_type = OP_LSTAT; + (void)*(PL_ppaddr[OP_LSTAT])(aTHXR); + SPAGAIN; + LEAVE; + if (PL_laststatval == 0) { + /* We assume that pp_stat() left us with 13 valid stack items, + * and that the timestamps are at offsets 8, 9, and 10. */ + UV atime = SvUV(ST( 8)); + UV mtime = SvUV(ST( 9)); + UV ctime = SvUV(ST(10)); + UV atime_nsec; + UV mtime_nsec; + UV ctime_nsec; + hrstatns(atime, mtime, ctime, + &atime_nsec, &mtime_nsec, &ctime_nsec); + if (atime_nsec) + ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec)); + if (mtime_nsec) + ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec)); + if (ctime_nsec) + ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec)); + XSRETURN(13); + } + XSRETURN(0); diff -u -r perl-5.10.1/ext/Time-HiRes/Makefile.PL perl-5.10.1.patched/ext/Time-HiRes/Makefile.PL --- perl-5.10.1/ext/Time-HiRes/Makefile.PL 2009-04-14 20:30:58.000000000 +0200 +++ perl-5.10.1.patched/ext/Time-HiRes/Makefile.PL 2013-02-15 13:32:10.777714000 +0100 @@ -627,6 +627,7 @@ EOM $has_stat_st_xtimespec++; DEFINE('TIME_HIRES_STAT', 1); + DEFINE('TIME_HIRES_LSTAT', 1); } if ($has_stat_st_xtimespec) { @@ -647,6 +648,7 @@ EOM $has_stat_st_xtimensec++; DEFINE('TIME_HIRES_STAT', 2); + DEFINE('TIME_HIRES_LSTAT', 2); } if ($has_stat_st_xtimensec) { @@ -667,6 +669,7 @@ EOM $has_stat_st_xtime_n++; DEFINE('TIME_HIRES_STAT', 3); + DEFINE('TIME_HIRES_LSTAT', 3); } if ($has_stat_st_xtime_n) { @@ -687,6 +690,7 @@ EOM $has_stat_st_xtim++; DEFINE('TIME_HIRES_STAT', 4); + DEFINE('TIME_HIRES_LSTAT', 4); } if ($has_stat_st_xtim) { @@ -707,6 +711,7 @@ EOM $has_stat_st_uxtime++; DEFINE('TIME_HIRES_STAT', 5); + DEFINE('TIME_HIRES_LSTAT', 5); } if ($has_stat_st_uxtime) { @@ -797,7 +802,7 @@ TIMER_ABSTIME); foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep d_clock_gettime d_clock_getres - d_clock d_clock_nanosleep d_hires_stat)) { + d_clock d_clock_nanosleep d_hires_stat d_hires_lstat)) { my $macro = $_; if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) { $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; @@ -807,6 +812,12 @@ push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat, default => ["IV", "0"]}; next; + } elsif ($macro =~ /^(d_hires_lstat)$/) { + my $d_hires_lstat = 0; + $d_hires_lstat = $1 if ($DEFINE =~ /-DTIME_HIRES_LSTAT=(\d+)/); + push @names, {name => $_, macro => "TIME_HIRES_LSTAT", value => $d_hires_lstat, + default => ["IV", "0"]}; + next; } else { $macro =~ s/^d_(.+)/HAS_\U$1/; }
Added in Time-HiRes-1.9726, now on CPAN. Did it differently from the offered patch.


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.