For those interested, I ended up with this. I have no idea whether it will be
threadsafe (need to have a few running in parallel!), but standalone it's
really quick - back down to 1s on that WAN link I mentioned. No idea why stat
would be so much slower - presumably wading down through perl and C runtime IO
layers slows it all down a bit!
Hope it's useful to someone.
P.
use Win32::API;
# $Win32::API::DEBUG = 1;
# Set up structs
Win32::API::Struct->typedef("FILETIME", qw(
DWORD dwLowDateTime;
DWORD dwHighDateTime;
));
Win32::API::Struct->typedef("WIN32_FIND_DATA", qw(
DWORD dwFileAttributes;
FILETIME ftCreationTime;
FILETIME ftLastAccessTime;
FILETIME ftLastWriteTime;
DWORD nFileSizeHigh;
DWORD nFileSizeLow;
DWORD dwReserved0;
DWORD dwReserved1;
TCHAR cFileName[260];
TCHAR cAlternateFileName[14];
));
# Func definitions
my $FindFirstFile = Win32::API->new("kernel32.dll", "FindFirstFile", "PS", "N")
or die;
my $FindNextFile = Win32::API->new("kernel32.dll", "FindNextFile", "NS", "I")
or die;
DirList("C:\\WINNT");
sub DirList {
my $searchDir = shift;
my %dir;
my $FileInfo = Win32::API::Struct->new("WIN32_FIND_DATA");
my $searchHandle = $FindFirstFile->Call("$searchDir\\*.*", $FileInfo);
do {
my $mTime =
ConvertTime($FileInfo->{ftLastWriteTime}->{dwHighDateTime},$FileInfo->{ftLastWriteTime}->{dwLowDateTime});
my $fType = $FileInfo->{dwFileAttributes} & 0x10 ? "1" : "0";
my $fName = $FileInfo->{cFileName};
$dir{$fName} = [ $mTime, $fType ];
} while (my $result = $FindNextFile->Call($searchHandle, $FileInfo));
return (\%dir);
}
# The following unashamedly pinched from
http://search.cpan.org/src/GAAS/libwww-perl-5.800/lib/HTTP/Cookies/Microsoft.pm
# was epoch_time_offset_from_win32_filetime
sub ConvertTime {
my ($high, $low) = @_;
#--------------------------------------------------------
# USEFUL CONSTANT
#--------------------------------------------------------
# 0x019db1de 0xd53e8000 is 1970 Jan 01 00:00:00 in Win32 FILETIME
#
# 100 nanosecond intervals == 0.1 microsecond intervals
my $filetime_low32_1970 = 0xd53e8000;
my $filetime_high32_1970 = 0x019db1de;
#------------------------------------
# ALGORITHM
#------------------------------------
# To go from 100 nanosecond intervals to seconds since 00:00 Jan 01
1970:
#
# 1. Adjust 100 nanosecond intervals to Jan 01 1970 base
# 2. Divide by 10 to get to microseconds (1/millionth second)
# 3. Divide by 1000000 (10 ^ 6) to get to seconds
#
# We can combine Step 2 & 3 into one divide.
#
# After much trial and error, I came up with the following code which
# avoids using Math::BigInt or floating pt, but still gives correct
answers
# If the filetime is before the epoch, return 0
if (($high < $filetime_high32_1970) ||
(($high == $filetime_high32_1970) && ($low < $filetime_low32_1970)))
{
return 0;
}
# Can't multiply by 0x100000000, (1 << 32),
# without Perl issuing an integer overflow warning
#
# So use two multiplies by 0x10000 instead of one multiply by
0x100000000
#
# The result is the same.
#
my $date1970 = (($filetime_high32_1970 * 0x10000) * 0x10000) +
$filetime_low32_1970;
my $time = (($high * 0x10000) * 0x10000) + $low;
$time -= $date1970;
$time /= 10000000;
return $time;
}
________________________________
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Paul Sobey
Sent: 16 November 2004 15:59
To: [EMAIL PROTECTED]
Subject: Remote Stat -> Slow??
I have a routine which takes a directory name and returns a hash keyed on
filename, with arrayrefs containing two values resulting from a stat of each
file. I've found that the routine runs incredibly slowly over a UNC,
particularly if over a WAN link. All I want to get is the filename, file age,
and whether or not it's a directory. I'm confused because the equivalent DOS
dir command on the same UNC runs very quickly - under a second even across the
WAN (vs. around 30 secs for my code!). Is there a way I could write the
following differently to speed it up? It seems a but nasty to shell out to cmd
/c dir and parse the output, but the relative speed input might outweigh any
elegance considerations I have :)
Cheers,
Paul
sub DirList {
my $dir = shift;
my %dir;
my $count;
logprint("\t\tSTAT: $dir");
opendir DIR, $dir;
%dir = map { $_, [ (stat("$dir/$_"))[9], -d _ ] } # Return hash entries -
names as keys, mtime and -d result as anon array for value
grep { ! /^\.{1,2}/ } # Dump . and .. dir entries
readdir DIR; # Read directory listing
closedir DIR;
logprint("\t\tSTAT: Done");
return (\%dir);
}
*****************************************************************
Gloucester Research Limited believes the information
provided herein is reliable. While every care has been
taken to ensure accuracy, the information is furnished
to the recipients with no warranty as to the completeness
and accuracy of its contents and on condition that any
errors or omissions shall not be made the basis for any
claim, demand or cause for action.
*****************************************************************
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
