res mtime for a symbolic link in Perl?
I want to reproduce the output of ls --full-time from a Perl script to avoid the overhead of calling ls several thousand times. I was hoping to use the stat function and grab all the information from there. However, the timestamp in the ls output uses the high-resolution clock so it includes the number of nanoseconds as well (according to the GNU docs, this is because --full-time is equivalent to --format=long --time-style=full-iso , and the full-iso time style includes the nanoseconds).
I came across the Time::HiRes module, which overrides the standard stat function with one that returns atime/mtime/ctime as floating point numbers, but there's no override for lstat. This is a problem, because calling stat on a symlink returns info for the linked file, not for the link itself.
So my question is this - where can I find a version of lstat that returns atime/mtime/ctime in the same way as Time::HiRes::stat? Failing that, is there another way to get the modtime for a symlink in high resolution (other than calling ls).
如果你愿意使用Inline :: C，这将适用于最近的linux
#!/usr/bin/perl
use strict;
use warnings;
use Inline C => <<'EOC';
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
long mtime_nsec(char* fname)
{
struct stat st;
if (-1 == lstat(fname, &st))
return -1;
return (long)st.st_mtim.tv_nsec;
}
EOC
print mtime_nsec($ARGV[0]);
Your best bet would be to ask for lstat to be added to Time::HiRes. In fact, you could probably do it yourself. I'd bet that all you need to do is copy the function that starts
void
stat(...)
in HiRes.xs , change stat(...) to lstat(...) & OP_STAT to OP_LSTAT , add lstat to @EXPORT_OK in HiRes.pm , and recompile. Then submit a patch so others can benefit.
The following changes work. This essentially contains changes to both the HiRes.pm module as well as the xs file.
In HiRes.pm
sub lstat {
my @lstatvalues = CORE::lstat(shift);
my @nanosecvalues = Time::HiRes::lstatimplementation( $lstatvalues[8], $lstatvalues[9], $lstatvalues[10]);
( $lstatvalues[8], $lstatvalues[9], $lstatvalues[10] ) = ( $nanosecvalues[0], $nanosecvalues[1], $nanosecvalues[2]);
return @lstatvalues;
}
Also added lstat to @EXPORT_OK list.
In HiRes.xs
void
lstatimplementation(...)
PPCODE:
UV atime = SvUV( ST( 0 ) );
UV mtime = SvUV( ST( 1 ) );
UV ctime = SvUV( ST( 2 ) );
UV atime_nsec;
UV mtime_nsec;
UV ctime_nsec;
hrstatns(atime, mtime, ctime,
&atime_nsec, &mtime_nsec, &ctime_nsec);
if (atime_nsec)
XPUSHs( sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec)));
if (mtime_nsec)
XPUSHs( sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec)));
if (ctime_nsec)
XPUSHs( sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec)));
上一篇: 现代Perl为什么要避免使用UTF