package Win32::ReadDirectoryChanges;
use 5.006001;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(
FILE_NOTIFY_CHANGE_FILE_NAME
FILE_NOTIFY_CHANGE_DIR_NAME
FILE_NOTIFY_CHANGE_NAME
FILE_NOTIFY_CHANGE_ATTRIBUTES
FILE_NOTIFY_CHANGE_SIZE
FILE_NOTIFY_CHANGE_LAST_WRITE
FILE_NOTIFY_CHANGE_LAST_ACCESS
FILE_NOTIFY_CHANGE_CREATION
FILE_NOTIFY_CHANGE_SECURITY
FILE_ACTION_ADDED
FILE_ACTION_REMOVED
FILE_ACTION_MODIFIED
FILE_ACTION_RENAMED_OLD_NAME
FILE_ACTION_RENAMED_NEW_NAME
);
our $VERSION = '0.01';
use Win32::API;
## Exported stuff
sub FILE_NOTIFY_CHANGE_FILE_NAME { 0x00000001 }
sub FILE_NOTIFY_CHANGE_DIR_NAME { 0x00000002 }
sub FILE_NOTIFY_CHANGE_NAME { 0x00000003 }
sub FILE_NOTIFY_CHANGE_ATTRIBUTES { 0x00000004 }
sub FILE_NOTIFY_CHANGE_SIZE { 0x00000008 }
sub FILE_NOTIFY_CHANGE_LAST_WRITE { 0x00000010 }
sub FILE_NOTIFY_CHANGE_LAST_ACCESS { 0x00000020 }
sub FILE_NOTIFY_CHANGE_CREATION { 0x00000040 }
sub FILE_NOTIFY_CHANGE_EA { 0x00000080 }
sub FILE_NOTIFY_CHANGE_SECURITY { 0x00000100 }
sub FILE_NOTIFY_CHANGE_STREAM_NAME { 0x00000200 }
sub FILE_NOTIFY_CHANGE_STREAM_SIZE { 0x00000400 }
sub FILE_NOTIFY_CHANGE_STREAM_WRITE { 0x00000800 }
sub FILE_ACTION_ADDED { 0x00000001 }
sub FILE_ACTION_REMOVED { 0x00000002 }
sub FILE_ACTION_MODIFIED { 0x00000003 }
sub FILE_ACTION_RENAMED_OLD_NAME { 0x00000004 }
sub FILE_ACTION_RENAMED_NEW_NAME { 0x00000005 }
sub FILE_ACTION_ADDED_STREAM { 0x00000006 }
sub FILE_ACTION_REMOVED_STREAM { 0x00000007 }
sub FILE_ACTION_MODIFIED_STREAM { 0x00000008 }
sub FILE_ACTION_REMOVED_BY_DELETE { 0x00000009 }
sub FILE_ACTION_ID_NOT_TUNNELLED { 0x0000000A }
sub FILE_ACTION_TUNNELLED_ID_COLLISION { 0x0000000B }
## Internal stuff
my ($CloseHandle,
$GetCurrentProcess,
$OpenProcessToken,
$LookupPrivilegeValue,
$AdjustTokenPrivileges,
$CreateFile,
$ReadDirectoryChanges);
sub FILE_LIST_DIRECTORY { 0x00000001 }
sub FILE_SHARE_READ { 0x00000001 }
sub FILE_SHARE_WRITE { 0x00000002 }
sub OPEN_EXISTING { 3 }
sub FILE_FLAG_BACKUP_SEMANTICS { 0x02000000 }
sub TOKEN_ADJUST_PRIVILEGES { 0x0020 }
sub TOKEN_QUERY { 0x0008 }
sub SE_BACKUP_NAME { 'SeBackupPrivilege' }
sub SE_RESTORE_NAME { 'SeRestorePrivilege' }
sub SE_CHANGE_NOTIFY_NAME { 'SeChangeNotifyPrivilege' }
sub SE_PRIVILEGE_ENABLED { 2 }
sub DWORD_SIZE { 4 }
sub _InitializeAPI {
my $kernel32 = 'kernel32.dll';
my $advapi32 = 'advapi32.dll';
$CloseHandle = new Win32::API($kernel32,
'CloseHandle',
'N', 'I') || die;
$GetCurrentProcess = new Win32::API($kernel32,
'GetCurrentProcess',
'', 'N') || die;
$OpenProcessToken = new Win32::API($advapi32,
'OpenProcessToken',
'NNP', 'I' ) || die;
$LookupPrivilegeValue = new Win32::API($advapi32,
'LookupPrivilegeValue',
'PPP', 'I') || die;
$AdjustTokenPrivileges = new Win32::API($advapi32,
'AdjustTokenPrivileges',
'NIPNPP', 'I') || die;
$CreateFile = new Win32::API($kernel32,
'CreateFileA',
'PNNPNNN', 'N') or die;
$ReadDirectoryChanges = new Win32::API($kernel32,
'ReadDirectoryChangesW',
'NPNINPPP', 'I') || die;
}
sub _EnablePrivileges {
my $phToken = pack("L", 0);
if($OpenProcessToken->Call($GetCurrentProcess->Call(),
TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
$phToken)) {
my $hToken = unpack("L", $phToken);
_SetPrivilege($hToken, SE_BACKUP_NAME, 1);
_SetPrivilege($hToken, SE_RESTORE_NAME, 1);
_SetPrivilege($hToken, SE_CHANGE_NOTIFY_NAME, 1);
$CloseHandle->Call($hToken);
}
#print "privileges altered\n";
}
sub _SetPrivilege {
my ($hToken, $pszPriv, $bSetFlag) = @_;
my $iResult;
my $pLuid = pack("Ll", 0, 0);
if($LookupPrivilegeValue->Call("\x00\x00", $pszPriv, $pLuid))
{
my $pPrivStruct = pack("LLlL",
1,
unpack("Ll", $pLuid),
(($bSetFlag)? SE_PRIVILEGE_ENABLED : 0)
+);
$iResult = (0 != $AdjustTokenPrivileges->Call($hToken,
0,
$pPrivStruct,
length($pPrivStr
+uct),
0, 0));
}
return ($iResult);
}
## Methods
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = {
# the defaults
path => undef,
subtree => 0,
filter => FILE_NOTIFY_CHANGE_NAME,
# overridden
@_,
};
bless $self, $class;
return $self if $self->initialize(@_);
return undef;
}
sub initialize {
my $self = shift;
$CloseHandle->Call($self->{handle}) if (exists($self->{handle}) &&
$self->{handle} > 0);
$self->{handle} = $CreateFile->Call($self->{path},
FILE_LIST_DIRECTORY,
FILE_SHARE_READ | FILE_SHARE_W
+RITE,
0,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
0);
return ($self->{handle} > 0) ? 1 : undef;
}
sub read_changes {
my $self = shift;
return undef unless (exists($self->{handle}) && $self->{handle} >
+0);
my $nBufferLength = 1024; #1024 * DWORD_SIZE;
my $pBuffer = "\x00" x $nBufferLength;
my $pBytesReturned = pack("L", 0);
my $iResult = $ReadDirectoryChanges->Call($self->{handle},
$pBuffer,
$nBufferLength,
$self->{subtree},
$self->{filter},
$pBytesReturned,
0, 0);
my $bytesReturned = unpack("L", $pBytesReturned);
my @results = ();
if ($bytesReturned > 0) {
my ($NextEntryOffset, $Action, $FileNameLength, $FileName);
while (1) {
($NextEntryOffset, $Action, $FileNameLength) = unpack("LLL
+", $pBuffer);
(undef, undef, undef, $FileName) = unpack("LLLa$FileNameLe
+ngth", $pBuffer);
$FileName = pack "C*", unpack "S*", $FileName;
push @results, $Action => $FileName;
last if($NextEntryOffset <= 0);
$pBuffer = substr($pBuffer, $NextEntryOffset);
}
}
return @results;
}
DESTROY {
my $self = shift;
$CloseHandle->Call($self->{handle}) if (exists($self->{handle}) &&
$self->{handle} > 0);
}
_InitializeAPI;
_EnablePrivileges;
1;
__END__
=head1 NAME
Win32::ReadDirectoryChanges - Quick and dirty ReadDirectoryChangesW Pe
+rl wrapper
=head1 SYNOPSIS
use Win32::ReadDirectoryChanges;
$rdc = new Win32::ReadDirectoryChanges(path => $path,
subtree => 1,
filter => $filter);
@results = $rdc->read_changes;
while (scalar @results) {
my ($action, $filename) = splice(@results, 0, 2);
}
=head1 DESCRIPTION
Using Win32::API, this module allows the user to use the Win32
ReadDirectoryChangesW API call in order to monitor events relating to
+files and
directory trees.
See MSDN for a complete description of the features.
=head2 Methods
=over 4
=item $rdc = new Win32::ReadDirectoryChanges( %options )
This method constructs a new C<Win32::ReadDirectoryChanges> object and
+ returns
it. Key/value pair arguments may be provided to set up the initial sta
+te.
The following options correspond to attribute methods described below:
KEY DEFAULT
------- -----------------------
path undef
subtree 0
filter FILE_NOTIFY_CHANGE_NAME
=item @results = $rdc->read_changes;
This method waits until modifications occured to monitored directory t
+ree.
The returned array contains type of change codes and related file name
+ relative
to directory tree.
=head1 SEE ALSO
See L<"Win32::API">, L<"Win32::ChangeNotify">.
=head1 REMARKS
This module is a rework of several things found on the Net. It's more
+a proof
of concept than something really usuable.
=head1 AUTHOR
D. Faure, E<lt>dfaure@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004 by D. Faure
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut
|
