Win32API::File::Time - Set file times, even on open or readonly files.

 use Win32API::File::Time qw{:win};
 ($atime, $mtime, $ctime) = GetFileTime ($filename);
 SetFileTime ($filename, $atime, $mtime, $ctime);

 use Win32API::File::Time qw{utime};
 utime $atime, $mtime, $filename or die $^E;

 :all => exports everything exportable
 :win => exports GetFileTime and SetFileTime

 0.001 Initial release
 0.002 Correct MANIFEST and Makefile.PL dependencies.
       Tweak documentation. No code changes.
 0.003 Correct time conversion.
       Modify test to not change own date.
 0.004 Close handles after use. Thanks to Chris
           Camejo for pointing out the leak.
       Fix export tags to agree with docs.
       Tweak "BUGS" documentation.
 0.005 Assert FILE_FLAG_BACKUP_SEMANTICS when reading
           times, so that it works for directories
           under XP and 2003 server. Thanks to Leigh
           Power for pointing out the problem and
           suggesting the solution.
       Document FAT, and accomodate it in self-test.
           Thanks again, Leigh.
       Centralize code to close handles on error.
 0.006 T. R. Wyant
       Re-layout kit, add POD tests.

#	Modifications:

# 0.001	13-May-2004	T. R. Wyant
#		Initial version.
# 0.002	02-Oct-2004	T. R. Wyant
#		No code changes. Add the readme file to the manifest,
#		and add the dependencies to Makefile.PL, since they
#		really _should_ be there, and Active State is
#		complaining about them missing.
# 0.003	17-Dec-2004	T. R. Wyant
#		Reimplement time conversion. Also modified the self-
#		test to use a scratch file for the date modification
#		portion of the test.
# 0.003_01 28-Dec-2004	T. R. Wyant
#		Close handles after use. In case of error, preserve
#		the windows error around the close.
# 0.004	13-Jan-2005	T. R. Wyant
#		Fix export tags.
#		Tweak "Bugs" section to more accurately represent what
#			I think is going on.
#		Release to CPAN.
# 0.004_01 28-Apr-2005	T. R. Wyant
#		Assert FILE_FLAG_BACKUP_SEMANTICS when reading times,
#			so that it works for directories under XP and
#			2003 server.
#		Centralize code to close handles on error.
# 0.004_02 04-May-2005	T. R. Wyant
#		Document behaviour of FAT (and change test to
#		accomodate.
# 0.005 04-May-2005	T. R. Wyant
#		Release to CPAN.

use strict;
use warnings;

package Win32API::File::Time;

use base qw{Exporter};
use vars qw{@EXPORT_OK %EXPORT_TAGS $VERSION};
use vars qw{
	$FileTimeToSystemTime
	$FileTimeToLocalFileTime
	$GetFileTime
	$LocalFileTimeToFileTime
	$SetFileTime
	$SystemTimeToFileTime
	};

use Carp;
use Time::Local;
use Win32::API;
use Win32API::File qw{:ALL};

$VERSION = '0.006';

@EXPORT_OK = qw{GetFileTime SetFileTime utime};
%EXPORT_TAGS = (
    all => [@EXPORT_OK],
    win => [qw{GetFileTime SetFileTime}],
    );

sub GetFileTime {
my $fn = shift or croak "usage: GetFileTime (filename)";
my $fh = _get_handle ($fn) or return;
$GetFileTime ||= _map ('KERNEL32', 'GetFileTime', [qw{N P P P}], 'I');
my ($atime, $mtime, $ctime);
$atime = $mtime = $ctime = pack 'LL', 0, 0;	# Preallocate 64 bits.
$GetFileTime->Call ($fh, $ctime, $atime, $mtime) or
    return _close_handle ($fh);
CloseHandle ($fh);
return _filetime_to_perltime ($atime, $mtime, $ctime);
}

sub SetFileTime {
my $fn = shift or croak "usage: SetFileTime (filename, atime, mtime, ctime)";
my $atime = _perltime_to_filetime (shift);
my $mtime = _perltime_to_filetime (shift);
my $ctime = _perltime_to_filetime (shift);
# We assume we can do something useful for an undef.
$SetFileTime ||= _map ('KERNEL32', 'SetFileTime', [qw{N P P P}], 'I');
my $fh = _get_handle ($fn, 1) or return;

$SetFileTime->Call ($fh, $ctime, $atime, $mtime) or
    return _close_handle ($fh);

CloseHandle ($fh);
return 1;
}

sub utime {
my $atime = shift;
my $mtime = shift;
my $num = 0;
foreach my $fn (@_) {
    SetFileTime ($fn, $atime, $mtime) and $num++;
    }
return $num;
}


#######################################################################
#
#	Internal subroutines
#
#	_close_handle
#
#	This subroutine closes the given handle, preserving status
#	around the call.

sub _close_handle {
my $fh = shift;
my $err = Win32::GetLastError ();
CloseHandle ($fh);
$^E = $err;
return;
}


#	_filetime_to_perltime
#
#	This subroutine takes as input a number of Windows file times
#	and converts them to Perl times.
#
#	The algorithm is due to the unsung heros at Hip Communications
#	Inc (currently known as ActiveState), who found a way around
#	the fact that Perl and Windows have a fundamentally different
#	idea of what local time corresponds to a given GMT when summer
#	time was in effect at the given GMT, but not at the time the
#	conversion is made. The given algorithm is consistent with the
#	results of the stat () function.

sub _filetime_to_perltime {
my @result;
$FileTimeToSystemTime ||= _map (
	'KERNEL32', 'FileTimeToSystemTime', [qw{P P}], 'I');
$FileTimeToLocalFileTime ||= _map (
	'KERNEL32', 'FileTimeToLocalFileTime', [qw{P P}], 'I');
my $st = pack 'ssssssss', 0, 0, 0, 0, 0, 0, 0, 0;
foreach my $ft (@_) {
    my ($low, $high) = unpack 'LL', $ft;
    $high or do {
	push @result, undef;
	next;
	};
    my $lf = $ft;	# Just to get the space allocated.
    $FileTimeToLocalFileTime->Call ($ft, $lf) &&
	$FileTimeToSystemTime->Call ($lf, $st) or do {
	push @result, undef;
	next;
	};
    my @tm = unpack 'ssssssss', $st;
    push @result, $tm[0] > 0 ?
	timelocal (@tm[6, 5, 4, 3], $tm[1] - 1, $tm[0]) :
	undef;
    }
return wantarray ? @result : $result[0];
}


#	_get_handle
#
#	This subroutine takes a file name and returns a handle to the
#	file. If the second argument is true, the handle is configured
#	appropriately for  writing attributes; otherwise it is
#	configured appropriately for reading attributes.

sub _get_handle {
my $fn = shift;
my $write = shift;

${^WIDE_SYSTEM_CALLS} ?
    CreateFileW ($fn,
	($write ? FILE_WRITE_ATTRIBUTES : FILE_READ_ATTRIBUTES),
	($write ? FILE_SHARE_WRITE | FILE_SHARE_READ : FILE_SHARE_READ),
	[],
	OPEN_EXISTING,
	($write ? FILE_ATTRIBUTE_NORMAL | FILE_FLAG_BACKUP_SEMANTICS : FILE_FLAG_BACKUP_SEMANTICS),
	0,
	) :
    CreateFile ($fn,
	($write ? FILE_WRITE_ATTRIBUTES : FILE_READ_ATTRIBUTES),
	($write ? FILE_SHARE_WRITE | FILE_SHARE_READ : FILE_SHARE_READ),
	[],
	OPEN_EXISTING,
	($write ? FILE_ATTRIBUTE_NORMAL | FILE_FLAG_BACKUP_SEMANTICS : FILE_FLAG_BACKUP_SEMANTICS),
	0,
	)
  or do {
    $^E = Win32::GetLastError ();
    return;
    };
}


#	_map
#
#	This subroutine calls Win32API to map an entry point.

sub _map {
return Win32::API->new (@_) ||
    croak "Error - Failed to map $_[1] from $_[0]: $^E";
}


#	_perltime_to_filetime
#
#	This subroutine converts perl times to Windows file times.

#	The same considerations apply to the algorithm used here as to
#	the one used in _filetime_to_perltime.

sub _perltime_to_filetime {
my @result;
$SystemTimeToFileTime ||= _map (
	'KERNEL32', 'SystemTimeToFileTime', [qw{P P}], 'I');
$LocalFileTimeToFileTime ||= _map (
	'KERNEL32', 'LocalFileTimeToFileTime', [qw{P P}], 'I');
my $zero = pack 'LL', 0, 0;	# To get a quadword zero.
my ($ft, $lf) = ($zero, $zero);	# To get the space allocated.
foreach my $pt (@_) {
    if (defined $pt) {
	my @tm = localtime ($pt);
	my $st = pack 'ssssssss', $tm[5] + 1900, $tm[4] + 1, 0,
	    @tm[3, 2, 1, 0], 0;
	push @result, $SystemTimeToFileTime->Call ($st, $lf)  &&
	    $LocalFileTimeToFileTime->Call ($lf, $ft) ? $ft : $zero;
	}
      else {
	push @result, $zero;
	}
    }
return wantarray ? @result : $result[0];
}