File-Monitor-1.00000755000765000120 011462070053 13135 5ustar00andyadmin000000000000File-Monitor-1.00/Build.PL000444000765000120 165511462070051 14573 0ustar00andyadmin000000000000# Note: this file has been initially generated by Module::Build::Convert 0.49 use strict; use warnings; use Module::Build; eval 'use ExtUtils::MakeMaker::Coverage'; warn "Optional ExtUtils::MakeMaker::Coverage not available\n" if $@; use lib 'inc'; use MyBuilder; my $build = MyBuilder->new( module_name => 'File::Monitor', dist_author => 'Andy Armstrong ', dist_version_from => 'lib/File/Monitor.pm', requires => { 'Test::More' => 0, 'version' => 0, }, PL_files => {}, add_to_cleanup => [ 'File-Monitor-*' ], sign => 1, license => 'perl', create_readme => 1, create_makefile_pl => 'traditional', ); $build->create_build_script; sub license { my $lic = shift; local $^W = 0; # Silence warning about non-numeric version return unless $ExtUtils::MakeMaker::VERSION >= '6.31'; return ( LICENSE => $lic ); } File-Monitor-1.00/Changes000444000765000120 216311462070051 14565 0ustar00andyadmin000000000000Revision history for File-Monitor 0.0.1 2007-02-01 Initial release. 0.0.2 2007-02-01 Removed idiotic idea of monitoring atime. What was I thinking? Started work on Linux specific implementation. 0.0.3 2007-02-02 Deprecated the direct creation of File::Monitor::Object and the whole idea using individual F::M::O instances directly. We need to enforce the idea of a parent object to support platform specific monitoring support (which typically requires a monitor instance with a number of watches attached to it). Moved the Linux support into a separate (unreleased) branch. 0.0.4 2007-02-07 Added the option (pass base argument to File::Monitor->new) to use relative names internally. This is to support relocatable trees - if the whole tree moves call $monitor->base( '/new/dir' ). 0.0.5 2007-02-23 Added machine readable licence and pod-coverage.t 0.10 2007-11-22 Stopped using version.pm Fixed version.pm related bug - didn't have use version on the version line. File-Monitor-1.00/MANIFEST000444000765000120 54011462070051 14400 0ustar00andyadmin000000000000Build.PL Changes examples/monitor.pl inc/MyBuilder.pm lib/File/Monitor.pm lib/File/Monitor/Base.pm lib/File/Monitor/Delta.pm lib/File/Monitor/Object.pm MANIFEST README t/00.load.t t/10.monitor-basic.t t/20.change.t t/30.monitor.t t/40.relocate.t t/50.freeze.t t/pod-coverage.t t/pod.t TODO Makefile.PL META.yml SIGNATURE Added here by Module::Build File-Monitor-1.00/META.yml000444000765000120 153611462070051 14546 0ustar00andyadmin000000000000--- abstract: 'Monitor files and directories for changes.' author: - 'Andy Armstrong ' configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: File-Monitor provides: File::Monitor: file: lib/File/Monitor.pm version: 1.00 File::Monitor::Base: file: lib/File/Monitor/Base.pm version: 1.00 File::Monitor::Delta: file: lib/File/Monitor/Delta.pm version: 1.00 File::Monitor::Object: file: lib/File/Monitor/Object.pm version: 1.00 requires: Test::More: 0 version: 0 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Monitor license: http://dev.perl.org/licenses/ repository: 'git://github.com/AndyA/File--Monitor.git (fetch)' version: 1.00 File-Monitor-1.00/Makefile.PL000444000765000120 56411462070051 15227 0ustar00andyadmin000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.3607 use ExtUtils::MakeMaker; WriteMakefile ( 'PL_FILES' => {}, 'INSTALLDIRS' => 'site', 'NAME' => 'File::Monitor', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/File/Monitor.pm', 'PREREQ_PM' => { 'Test::More' => 0, 'version' => 0 } ) ; File-Monitor-1.00/README000444000765000120 3263311462070051 14177 0ustar00andyadmin000000000000NAME File::Monitor - Monitor files and directories for changes. VERSION This document describes File::Monitor version 1.00 SYNOPSIS use File::Monitor; my $monitor = File::Monitor->new(); # Just watch $monitor->watch('somefile.txt'); # Watch with callback $monitor->watch('otherfile.txt', sub { my ($name, $event, $change) = @_; # Do stuff }); # Watch a directory $monitor->watch( { name => 'somedir', recurse => 1, callback => { files_created => sub { my ($name, $event, $change) = @_; # Do stuff } } } ); # First scan just finds out about the monitored files. No changes # will be reported. $object->scan; # Later perform a scan and gather any changes my @changes = $object->scan; DESCRIPTION This module provides a simple interface for monitoring one or more files or directories and reporting any changes that are made to them. It can * monitor existing files for changes to any of the attributes returned by the "stat" function * monitor files that don't yet exist and notify you if they are created * notify when a monitored file is deleted * notify when files are added or removed from a directory Some possible applications include * monitoring the configuration file(s) of a long running process so they can be automatically re-read if they change * implementing a 'drop box' directory that receives files to be processed in some way * automatically rebuilding a cached object that depends on a number of files if any of those files changes In order to monitor a single file create a new monitor object: my $monitor = File::Monitor->new(); Add the file to it: $monitor->watch( 'somefile.txt' ); And then call "scan" periodically to check for changes: my @changes = $monitor->scan; The first call to "scan" will never report any changes; it captures a snapshot of the state of all monitored files and directories so that subsequent calls to "scan" can report any changes. Note that "File::Monitor" doesn't provide asynchronous notifications of file changes; you have to call "scan" to learn if there have been any changes. To monitor multiple files call "watch" for each of them: for my $file ( @files ) { $monitor->watch( $file ); } If there have been any changes "scan" will return a list of File::Monitor::Delta objects. my @changes = $monitor->scan; for my $change (@changes) { warn $change->name, " has changed\n"; } Consult the documentation for File::Monitor::Delta for more information. If you prefer you may register callbacks to be triggered when changes occur. # Gets called for all changes $monitor->callback( sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed\n"; } ); # Called when file size changes $monitor->callback( size => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed size\n"; } ); See File::Monitor::Delta for more information about the various event types for which callbacks may be registered. You may register callbacks for a specific file or directory. # Gets called for all changes to server.conf $monitor->watch( 'server.conf', sub { my ($file_name, $event, $change) = @_; warn "Config file $file_name has changed\n"; } ); # Gets called if the owner of server.conf changes $monitor->watch( { name => 'server.conf', callback => { uid => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed owner\n"; } } } ); This last example shows the canonical way of specifying the arguments to "watch" as a hash reference. See "watch" for more details. Directories When monitoring a directory you can choose to ignore its contents, scan its contents one level deep or perform a recursive scan of all its subdirectories. See File::Monitor::Object for more information and caveats. INTERFACE "new( %args )" Create a new "File::Monitor" object. Any options should be passed as a reference to a hash as follows: my $monitor = File::Monitor->new( { base => $some_dir, callback => { uid => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed owner\n"; }, size => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed size\n"; } } ); Both options ("base" and "callback") are optional. The "base" option specifies a base directory. When a base directory has been specified all pathnames will internally be stored relative to it. This doesn't affect the public interface which still uses absolute paths but it does makes it possible to relocate a File::Monitor if the directory it's watching is moved. The "callback" option must be a reference to a hash that maps event types to handler subroutines. See File::Monitor::Delta for a full list of available event types. "watch( $name, $callback | { args } )" Create a new File::Monitor::Object and add it to this monitor. The passed hash reference contains various options as follows: $monitor->watch( { name => $file_or_directory_name, recurse => $should_recurse_directory, files => $should_read_files_in_directory, callback => { $some_event => sub { # Handler for $some_event }, $other_event => sub { # Handler for $other_event } } } ); Here are those options in more detail: "name" The name of the file or directory to be monitored. Relative paths will be made absolute relative to the current directory at the time of the call. This option is mandatory; "new" will croak if it is missing. "recurse" If this is a directory and "recurse" is true monitor the entire directory tree below this directory. "files" If this is a directory and "files" is true monitor the files and directories immediately below this directory but don't recurse down the directory tree. Note that if you specify "recurse" or "files" only the *names* of contained files will be monitored. Changes to the contents of contained files are not detected. "callback" Provides a reference to a hash of callback handlers the keys of which are the names of events as described in File::Monitor::Delta. Callback subroutines are called with the following arguments: $name The name of the file or directory that has changed. $event The type of change. If the callback was registered for a specific event it will be passed here. The actual event may be one of the events below the specified event in the event hierarchy. See File::Monitor::Delta for more details. $delta The File::Monitor::Delta object that describes this change. As a convenience "watch" may be called with a simpler form of arguments: $monitor->watch( $name ); is equivalent to $monitor->watch( { name => $name } ); And $monitor->watch( $name, $callback ); is eqivalent to $monitor->watch( { name => $name callback => { change => $callback } } ); "unwatch( $name )" Remove the watcher (if any) that corresponds with the specified file or directory. my $file = 'config.cfg'; $monitor->watch( $file ); # Now we're watching it $monitor->unwatch( $file ); # Now we're not "scan()" Perform a scan of all monitored files and directories and return a list of changes. Any callbacks that are registered will have been triggered before "scan" returns. When "scan" is first called the current state of the various monitored files and directories will be captured but no changes will be reported. The return value is a list of File::Monitor::Delta objects, one for each changed file or directory. my @changes = $monitor->scan; for my $change ( @changes ) { warn $change->name, " changed\n"; } "callback( [ $event, ] $coderef )" Register a callback. If $event is omitted the callback will be called for all changes. Specify $event to limit the callback to certain event types. See File::Monitor::Delta for a full list of events. $monitor->callback( sub { # called for all changes } ); $monitor->callback( metadata => sub { # called for changes to file/directory metatdata } ); The callback subroutine will be called with the following arguments: $name The name of the file or directory that has changed. $event The type of change. If the callback was registered for a specific event it will be passed here. The actual event may be one of the events below the specified event in the event hierarchy. See File::Monitor::Delta for more details. $delta The File::Monitor::Delta object that describes this change. "base" Get or set the base directory. This allows the entire monitor tree to be relocated. # Create a monitor and watch a couple of files my $monitor = File::Monitor->new( { base => $some_dir } ); $monitor->watch( "$some_dir/source.c" ); $monitor->watch( "$some_dir/notes.text" ); # Now move the directory and patch up the monitor rename( $some_dir, $other_dir ); $monitor->base( $other_dir ); # Still works my @changes = $monitor->scan; If you are going to specify a base directory you must do so before any watches are added. "has_monitors" Returns true if this File::Monitor has any monitors attached to it. Used internally to police the restriction that a base directory may not be set when monitors have been added. DIAGNOSTICS "A filename must be specified" You must pass "unwatch" the name of a file or directory to stop watching. CONFIGURATION AND ENVIRONMENT File::Monitor requires no configuration files or environment variables. DEPENDENCIES None. INCOMPATIBILITIES None reported. BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to "bug-file-monitor@rt.cpan.org", or through the web interface at . AUTHOR Andy Armstrong "" Faycal Chraibi originally registered the File::Monitor namespace and then kindly handed it to me. LICENCE AND COPYRIGHT Copyright (c) 2007, Andy Armstrong "". All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See perlartistic. DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Monitor-1.00/SIGNATURE000644000765000120 372611462070053 14570 0ustar00andyadmin000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.66. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 647809324f9e520fcc0969d5c311c6c2febb9bba Build.PL SHA1 d35c91d3ec58747c22b8a5c686abd7a818bb45fb Changes SHA1 0ffa5ec1cb9ac442b7792153ad2ad203814eb5e5 MANIFEST SHA1 b79c267e62261e6bff43942a60563cffdfe55516 META.yml SHA1 af236a0645ca2d52ceb01fe952e403071e586cd6 Makefile.PL SHA1 a2b56cd87bf22b4ae4ca3c68886c60d19a31f69e README SHA1 291c593f6abfce030f5956f5b4ab0357daf0709a TODO SHA1 61f9b8adb2a40affde948e9b55238db0e4d33dcb examples/monitor.pl SHA1 495a358aecc9307d9b0622a31031ac1cf0cee75e inc/MyBuilder.pm SHA1 abc2856d38319eab85814a6f3c6f338bf63dc9a5 lib/File/Monitor.pm SHA1 d4be09a014e51a920645d0a9917eae7218efc9bd lib/File/Monitor/Base.pm SHA1 f3b0fc536f1e414cececb3562d6881c8581c398e lib/File/Monitor/Delta.pm SHA1 41019404b055c8f8e8490d0f3512fefb88035245 lib/File/Monitor/Object.pm SHA1 252bd2341acf7a2b878107f1c11d16529725af1b t/00.load.t SHA1 a8cea48fed0bca362d51227c52161f27cf47cca1 t/10.monitor-basic.t SHA1 18d84479e112b0e7bb3eed9efcc69edd1fb1e68b t/20.change.t SHA1 aa6c5c13ee59e2271ccfac9042369f1828f94cde t/30.monitor.t SHA1 3d96c7121018e99a8b44c5e7e1c44e1e4a38e736 t/40.relocate.t SHA1 d44e32f6333133f97728dfd619b5bcafc81249fb t/50.freeze.t SHA1 f48d66a797df256b32d58b187b87d08d5c23a051 t/pod-coverage.t SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 t/pod.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (Darwin) iEYEARECAAYFAkzIcCkACgkQwoknRJZQnCHmRwCfYgkQ3cx9NNMJM/5X5NsvLlfT DTIAn3srtNr7GaG2L1ZoFh03reVsmYrQ =d3V4 -----END PGP SIGNATURE----- File-Monitor-1.00/TODO000444000765000120 136611462070051 13766 0ustar00andyadmin000000000000Things to do: * Use native file monitoring interface on platforms where it's available. * Implement a "don't scan more frequently that every X seconds" functionality. * Directory scanning is hideously inefficient. For directories with the 'files' flag set we only need to rescan the directory if stat shows that it has been modified. * Investigate whether changes to the monitored directory are reported correctly under Windows. * Implement more efficient polling in the degenerate case where you only want to know if any of the monitored files has changed. That's tricky because the current interface assumes that all the File::Monitor::Objects are updated after each call to scan(). File-Monitor-1.00/examples000755000765000120 011462070051 14751 5ustar00andyadmin000000000000File-Monitor-1.00/examples/monitor.pl000555000765000120 153111462070051 17135 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use Carp; use File::Monitor; $| = 1; my $monitor = File::Monitor->new; push @ARGV, '.' unless @ARGV; while ( my $obj = shift ) { $monitor->watch( { name => $obj, recurse => 1 } ); } my @attr = qw( deleted mtime ctime uid gid mode size files_created files_deleted ); while ( 1 ) { sleep 1; for my $change ( $monitor->scan ) { print $change->name, " changed\n"; for my $attr ( @attr ) { my $val; if ( $attr =~ /^files_/ ) { my @val = $change->$attr; $val = join( ' ', @val ); } else { $val = $change->$attr; } if ( $val ) { printf( "%14s = %s\n", $attr, $val ); } } } } File-Monitor-1.00/inc000755000765000120 011462070051 13704 5ustar00andyadmin000000000000File-Monitor-1.00/inc/MyBuilder.pm000444000765000120 347511462070051 16304 0ustar00andyadmin000000000000package MyBuilder; use base qw( Module::Build ); sub create_build_script { my ( $self, @args ) = @_; $self->_auto_mm; return $self->SUPER::create_build_script( @args ); } sub _auto_mm { my $self = shift; my $mm = $self->meta_merge; my @meta = qw( homepage bugtracker MailingList repository ); for my $meta ( @meta ) { next if exists $mm->{resources}{$meta}; my $auto = "_auto_$meta"; next unless $self->can( $auto ); my $av = $self->$auto(); $mm->{resources}{$meta} = $av if defined $av; } $self->meta_merge( $mm ); } sub _auto_repository { my $self = shift; if ( -d '.svn' ) { my $info = `svn info .`; return $1 if $info =~ /^URL:\s+(.+)$/m; } elsif ( -d '.git' ) { my $info = `git remote -v`; return unless $info =~ /^origin\s+(.+)$/m; my $url = $1; # Special case: patch up github URLs $url =~ s!^git\@github\.com:!git://github.com/!; return $url; } return; } sub _auto_bugtracker { 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name; } sub ACTION_disttest { my $self = shift; $self->SUPER::ACTION_disttest( @_ ); } sub ACTION_tags { exec( qw( ctags -f tags --recurse --totals --exclude=blib --exclude=.svn --exclude='*~' --languages=Perl t/ lib/ ) ); } sub ACTION_tidy { my $self = shift; my @extra = qw( Build.PL ); my %found_files = map { %$_ } $self->find_pm_files, $self->_find_file_by_type( 'pm', 'inc' ), $self->_find_file_by_type( 'pm', 't' ), $self->_find_file_by_type( 't', 't' ), $self->_find_file_by_type( 'pm', 'xt' ), $self->_find_file_by_type( 't', 'xt' ); my @files = ( keys %found_files, map { $self->localize_file_path( $_ ) } @extra ); for my $file ( @files ) { system 'perltidy', '-b', $file; unlink "$file.bak" if $? == 0; } } 1; File-Monitor-1.00/lib000755000765000120 011462070051 13701 5ustar00andyadmin000000000000File-Monitor-1.00/lib/File000755000765000120 011462070051 14560 5ustar00andyadmin000000000000File-Monitor-1.00/lib/File/Monitor.pm000444000765000120 3573211462070051 16734 0ustar00andyadmin000000000000package File::Monitor; use warnings; use strict; use Carp; use base qw(File::Monitor::Base); use File::Monitor::Object; use vars qw( $VERSION ); $VERSION = '1.00'; sub _initialize { my $self = shift; my $args = shift || {}; $self->SUPER::_initialize( $args ); $self->_install_callbacks( $args ); if ( my $base = delete $args->{base} ) { $self->base( $base ); } $self->_report_extra( $args ); $self->{_monitors} = {}; } sub has_monitors { my $self = shift; return 1 if exists $self->{_monitors} && %{ $self->{_monitors} }; return; } sub base { my $self = shift; my $cur_base = $self->{_base}; return $cur_base unless @_; my $new_base = shift or croak "Can't unset base directory"; if ( !defined $cur_base && $self->has_monitors ) { croak "Can't make a non-empty absolute " . __PACKAGE__ . " relative"; } $self->{_base} = File::Spec->canonpath( File::Spec->rel2abs( $new_base ) ); } sub _set_watcher { my $self = shift; my $object = shift; my $name = $self->_make_relative( $object->name ); return $self->{_monitors}->{$name} = $object; } sub watch { my $self = shift; my $args; if ( ref $_[0] eq 'HASH' ) { # Hash ref containing all arguments $args = shift; croak "When options are supplied as a hash " . "there may be no other arguments" if @_; } else { # File/dir name, optional callback my $name = shift or croak "A filename must be specified"; my $callback = shift; $args = { name => $name }; # If a callback is defined install it for all changes $args->{callback}->{change} = $callback if defined $callback; } $args->{owner} = $self; return $self->_set_watcher( File::Monitor::Object->new( $args ) ); } sub unwatch { my $self = shift; my $name = shift || croak "A filename must be specified"; $name = $self->_make_relative( $self->_canonical_name( $name ) ); delete $self->{_monitors}->{$name}; } sub scan { my $self = shift; my @changed = (); for my $obj ( values %{ $self->{_monitors} } ) { push @changed, $obj->scan; } for my $change ( @changed ) { $self->_make_callbacks( $change ); } return @changed; } sub _canonical_name { my $self = shift; my $name = shift; return $self->_make_relative( File::Spec->canonpath( File::Spec->rel2abs( $name ) ) ); } # Make a filename (relative or absolute) relative to the base # directory if any. sub _make_relative { my $self = shift; my $name = shift; if ( my $base = $self->base ) { return File::Spec->abs2rel( $name, $base ); } return $name; } # Make a filename relative to the base directory absolute. sub _make_absolute { my $self = shift; my $name = shift; if ( my $base = $self->base ) { return File::Spec->rel2abs( $name, $base ); } return $name; } 1; __END__ =head1 NAME File::Monitor - Monitor files and directories for changes. =head1 VERSION This document describes File::Monitor version 1.00 =head1 SYNOPSIS use File::Monitor; my $monitor = File::Monitor->new(); # Just watch $monitor->watch('somefile.txt'); # Watch with callback $monitor->watch('otherfile.txt', sub { my ($name, $event, $change) = @_; # Do stuff }); # Watch a directory $monitor->watch( { name => 'somedir', recurse => 1, callback => { files_created => sub { my ($name, $event, $change) = @_; # Do stuff } } } ); # First scan just finds out about the monitored files. No changes # will be reported. $object->scan; # Later perform a scan and gather any changes my @changes = $object->scan; =head1 DESCRIPTION This module provides a simple interface for monitoring one or more files or directories and reporting any changes that are made to them. It can =over =item * monitor existing files for changes to any of the attributes returned by the C function =item * monitor files that don't yet exist and notify you if they are created =item * notify when a monitored file is deleted =item * notify when files are added or removed from a directory =back Some possible applications include =over =item * monitoring the configuration file(s) of a long running process so they can be automatically re-read if they change =item * implementing a 'drop box' directory that receives files to be processed in some way =item * automatically rebuilding a cached object that depends on a number of files if any of those files changes =back In order to monitor a single file create a new monitor object: my $monitor = File::Monitor->new(); Add the file to it: $monitor->watch( 'somefile.txt' ); And then call C periodically to check for changes: my @changes = $monitor->scan; The first call to C will never report any changes; it captures a snapshot of the state of all monitored files and directories so that subsequent calls to C can report any changes. Note that C doesn't provide asynchronous notifications of file changes; you have to call C to learn if there have been any changes. To monitor multiple files call C for each of them: for my $file ( @files ) { $monitor->watch( $file ); } If there have been any changes C will return a list of L objects. my @changes = $monitor->scan; for my $change (@changes) { warn $change->name, " has changed\n"; } Consult the documentation for L for more information. If you prefer you may register callbacks to be triggered when changes occur. # Gets called for all changes $monitor->callback( sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed\n"; } ); # Called when file size changes $monitor->callback( size => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed size\n"; } ); See L for more information about the various event types for which callbacks may be registered. You may register callbacks for a specific file or directory. # Gets called for all changes to server.conf $monitor->watch( 'server.conf', sub { my ($file_name, $event, $change) = @_; warn "Config file $file_name has changed\n"; } ); # Gets called if the owner of server.conf changes $monitor->watch( { name => 'server.conf', callback => { uid => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed owner\n"; } } } ); This last example shows the canonical way of specifying the arguments to C as a hash reference. See C for more details. =head2 Directories When monitoring a directory you can choose to ignore its contents, scan its contents one level deep or perform a recursive scan of all its subdirectories. See L for more information and caveats. =head1 INTERFACE =over =item C<< new( %args ) >> Create a new C object. Any options should be passed as a reference to a hash as follows: my $monitor = File::Monitor->new( { base => $some_dir, callback => { uid => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed owner\n"; }, size => sub { my ($file_name, $event, $change) = @_; warn "$file_name has changed size\n"; } } ); Both options (C and C) are optional. The C option specifies a base directory. When a base directory has been specified all pathnames will internally be stored relative to it. This doesn't affect the public interface which still uses absolute paths but it does makes it possible to relocate a File::Monitor if the directory it's watching is moved. The C option must be a reference to a hash that maps event types to handler subroutines. See L for a full list of available event types. =item C<< watch( $name, $callback | { args } ) >> Create a new L and add it to this monitor. The passed hash reference contains various options as follows: $monitor->watch( { name => $file_or_directory_name, recurse => $should_recurse_directory, files => $should_read_files_in_directory, callback => { $some_event => sub { # Handler for $some_event }, $other_event => sub { # Handler for $other_event } } } ); Here are those options in more detail: =over =item C The name of the file or directory to be monitored. Relative paths will be made absolute relative to the current directory at the time of the call. This option is mandatory; C will croak if it is missing. =item C If this is a directory and C is true monitor the entire directory tree below this directory. =item C If this is a directory and C is true monitor the files and directories immediately below this directory but don't recurse down the directory tree. Note that if you specify C or C only the I of contained files will be monitored. Changes to the contents of contained files are not detected. =item C Provides a reference to a hash of callback handlers the keys of which are the names of events as described in L. =back Callback subroutines are called with the following arguments: =over =item C<$name> The name of the file or directory that has changed. =item C<$event> The type of change. If the callback was registered for a specific event it will be passed here. The actual event may be one of the events below the specified event in the event hierarchy. See L for more details. =item C<$delta> The L object that describes this change. =back As a convenience C may be called with a simpler form of arguments: $monitor->watch( $name ); is equivalent to $monitor->watch( { name => $name } ); And $monitor->watch( $name, $callback ); is eqivalent to $monitor->watch( { name => $name callback => { change => $callback } } ); =item C<< unwatch( $name ) >> Remove the watcher (if any) that corresponds with the specified file or directory. my $file = 'config.cfg'; $monitor->watch( $file ); # Now we're watching it $monitor->unwatch( $file ); # Now we're not =item C<< scan() >> Perform a scan of all monitored files and directories and return a list of changes. Any callbacks that are registered will have been triggered before C returns. When C is first called the current state of the various monitored files and directories will be captured but no changes will be reported. The return value is a list of L objects, one for each changed file or directory. my @changes = $monitor->scan; for my $change ( @changes ) { warn $change->name, " changed\n"; } =item C<< callback( [ $event, ] $coderef ) >> Register a callback. If C<$event> is omitted the callback will be called for all changes. Specify C<$event> to limit the callback to certain event types. See L for a full list of events. $monitor->callback( sub { # called for all changes } ); $monitor->callback( metadata => sub { # called for changes to file/directory metatdata } ); The callback subroutine will be called with the following arguments: =over =item C<$name> The name of the file or directory that has changed. =item C<$event> The type of change. If the callback was registered for a specific event it will be passed here. The actual event may be one of the events below the specified event in the event hierarchy. See L for more details. =item C<$delta> The L object that describes this change. =back =item C<< base >> Get or set the base directory. This allows the entire monitor tree to be relocated. # Create a monitor and watch a couple of files my $monitor = File::Monitor->new( { base => $some_dir } ); $monitor->watch( "$some_dir/source.c" ); $monitor->watch( "$some_dir/notes.text" ); # Now move the directory and patch up the monitor rename( $some_dir, $other_dir ); $monitor->base( $other_dir ); # Still works my @changes = $monitor->scan; If you are going to specify a base directory you must do so before any watches are added. =item C<< has_monitors >> Returns true if this File::Monitor has any monitors attached to it. Used internally to police the restriction that a base directory may not be set when monitors have been added. =back =head1 DIAGNOSTICS =over =item C<< A filename must be specified >> You must pass C the name of a file or directory to stop watching. =back =head1 CONFIGURATION AND ENVIRONMENT File::Monitor requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Andy Armstrong C<< >> Faycal Chraibi originally registered the File::Monitor namespace and then kindly handed it to me. =head1 LICENCE AND COPYRIGHT Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Monitor-1.00/lib/File/Monitor000755000765000120 011462070051 16207 5ustar00andyadmin000000000000File-Monitor-1.00/lib/File/Monitor/Base.pm000444000765000120 640611462070051 17562 0ustar00andyadmin000000000000package File::Monitor::Base; use strict; use warnings; use Carp; use File::Spec; our $VERSION = '1.00'; sub new { my $class = shift; my $self = bless {}, $class; $self->_initialize( @_ ); return $self; } sub _report_extra { my $self = shift; my $args = shift; my @extra = keys %$args; croak "The following options are not recognised: ", join( ' ', sort @extra ) if @extra; } sub _initialize { my $self = shift; } sub _install_callbacks { my $self = shift; my $args = shift; # Install callbacks if ( my $callback = delete $args->{callback} ) { if ( ref $callback eq 'CODE' ) { $self->callback( 'change', $callback ); } elsif ( ref $callback eq 'HASH' ) { while ( my ( $event, $cb ) = each %$callback ) { $self->callback( $event, $cb ); } } else { croak "A callback must be a code reference " . "or a hash of code references"; } } } sub _make_callbacks { my $self = shift; my $change = shift; $change->_trigger_callbacks( $self->{_callbacks} ); } sub callback { my $self = shift; my $event = shift; my $code = shift; # Allow event to be omitted if ( ref $event eq 'CODE' && !defined $code ) { ( $code, $event ) = ( $event, 'changed' ); } croak "Callback must be a code references" unless ref $code eq 'CODE'; $self->{_callbacks}->{$event} = $code; } 1; =head1 NAME File::Monitor::Base - Common base class for file monitoring. =head1 VERSION This document describes File::Monitor::Base version 1.00 =head1 DESCRIPTION Don't use this class directly. See L and L for the public interface. =head1 AUTHOR Andy Armstrong C<< >> Faycal Chraibi originally registered the File::Monitor namespace and then kindly handed it to me. =head1 LICENCE AND COPYRIGHT Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Monitor-1.00/lib/File/Monitor/Delta.pm000444000765000120 3562511462070051 17766 0ustar00andyadmin000000000000package File::Monitor::Delta; use strict; use warnings; use Carp; use base qw(File::Monitor::Base); our $VERSION = '1.00'; my %TAXONOMY; BEGIN { my $created = sub { my ( $this, $old, $new, $key ) = @_; return ( !defined $old->{mode} && defined $new->{mode} ) || 0; }; my $deleted = sub { my ( $this, $old, $new, $key ) = @_; return $created->( $this, $new, $old, $key ); }; my $num_diff = sub { my ( $this, $old, $new, $key ) = @_; return ( $new->{$key} || 0 ) - ( $old->{$key} || 0 ); }; my $bit_diff = sub { # XOR my ( $this, $old, $new, $key ) = @_; return ( $new->{$key} || 0 ) ^ ( $old->{$key} || 0 ); }; my $nop = sub { # Just return value my ( $this, $old, $new, $key ) = @_; return $this->{delta}->{$key}; }; %TAXONOMY = ( change => { created => $created, deleted => $deleted, metadata => { time => { mtime => $num_diff, ctime => $num_diff, }, perms => { uid => $num_diff, gid => $num_diff, # Bit delta mode => $bit_diff, }, # Value delta size => $num_diff, }, directory => { # List delta files_created => $nop, files_deleted => $nop } } ); my @OBJ_ATTR = qw( dev inode mode num_links uid gid rdev size mtime ctime blk_size blocks error files ); my $IS_ARRAY = qr/^files_/; no strict 'refs'; # Accessors for old/new attributes for my $pfx ( qw(old new) ) { for my $attr ( @OBJ_ATTR ) { my $func_name = "${pfx}_${attr}"; *$func_name = sub { my $self = shift; croak "$func_name is read-only" if @_; return $self->{ $pfx . '_info' }->{$attr}; }; } } # Accessors for deltas are named after the leaf keys in the taxonomy my @work = \%TAXONOMY; while ( my $obj = shift @work ) { while ( my ( $n, $v ) = each %$obj ) { my $is_name = "is_$n"; *$is_name = sub { my $self = shift; return $self->is_event( $n ); }; if ( ref $v eq 'CODE' ) { # Got a leaf item -> make an accessor my $func_name = $n; if ( $n =~ $IS_ARRAY ) { *$func_name = sub { my $self = shift; croak "$func_name is read-only" if @_; return @{ $self->{delta}->{$func_name} || [] }; }; } else { *$func_name = sub { my $self = shift; croak "$func_name is read-only" if @_; return $self->{delta}->{$func_name}; }; } } elsif ( ref $v eq 'HASH' ) { push @work, $v; } else { die "\%TAXONOMY contains a ", ref $v; } } } } sub _initialize { my $self = shift; my $args = shift; $self->SUPER::_initialize( $args ); for my $attr ( qw(object old_info new_info) ) { croak "You must supply a value for $attr" unless exists $args->{$attr}; $self->{$attr} = delete $args->{$attr}; } $self->_report_extra( $args ); if ( !$self->_deep_compare( $self->{old_info}, $self->{new_info} ) ) { $self->_compute_delta; } } sub object { my $self = shift; croak "object is read-only" if @_; return $self->{object}; } sub name { my $self = shift; return $self->object->name( @_ ); } sub _deep_compare { my ( $self, $this, $that ) = @_; use Storable qw/freeze/; local $Storable::canonical = 1; return freeze( $this ) eq freeze( $that ); } sub _diff_list { my ( $this, $that ) = @_; my %which = map { $_ => 1 } @$this; $which{$_} |= 2 for @$that; my @diff = ( [], [] ); while ( my ( $v, $w ) = each %which ) { push @{ $diff[ $w - 1 ] }, $v if $w < 3; } return @diff; } sub _walk_taxo { my $self = shift; my $taxo = shift; my $change_found = 0; while ( my ( $n, $v ) = each %$taxo ) { if ( ref $v eq 'CODE' ) { my $diff = $v->( $self, $self->{old_info}, $self->{new_info}, $n ); if ( $diff ) { $self->{delta}->{$n} = $diff; $self->{"_is_event"}->{$n}++; $change_found++; } } else { if ( $self->_walk_taxo( $v ) ) { $self->{"_is_event"}->{$n}++; $change_found++; } } } return $change_found; } sub _compute_delta { my $self = shift; # Compute the file list deltas as a special case first my @df = _diff_list( $self->{old_info}->{files} || [], $self->{new_info}->{files} || [] ); my $monitor = $self->object->owner; for my $attr ( qw(files_deleted files_created) ) { my @ar = map { $monitor->_make_absolute( $_ ) } sort @{ shift @df }; $self->{delta}->{$attr} = \@ar if @ar; } $self->{_is_event} = {}; # Now do everything else $self->_walk_taxo( \%TAXONOMY ); } sub is_event { my $self = shift; my $event = shift; return $self->{_is_event}->{$event}; } sub _trigger_callbacks { my $self = shift; my $callbacks = shift || {}; my $name = $self->name; if ( $self->is_change ) { while ( my ( $event, $cb ) = each %$callbacks ) { if ( $self->is_event( $event ) ) { $cb->( $name, $event, $self ); } } } } 1; =head1 NAME File::Monitor::Delta - Encapsulate a change to a file or directory =head1 VERSION This document describes File::Monitor::Delta version 1.00 =head1 SYNOPSIS use File::Monitor; my $monitor = File::Monitor->new(); # Watch some files for my $file (qw( myfile.txt yourfile.txt otherfile.txt some_directory )) { $monitor->watch( $file ); } # First scan just finds out about the monitored files. No changes # will be reported. $object->scan; # After the first scan we get a list of File::Monitor::Delta objects # that describe any changes my @changes = $object->scan; for my $change (@changes) { # Call methods on File::Monitor::Delta to discover what changed if ($change->is_size) { my $name = $change->name; my $old_size = $change->old_size; my $new_size = $change->new_size; print "$name has changed size from $old_size to $new_size\n"; } } =head1 DESCRIPTION When L or L detects a change to a file or directory it packages the details of the change in a C object. Methods exist to discover the nature of the change (C et al.), retrieve the attributes of the file or directory before and after the change (C, C, C, C etc), retrieve details of the change in a convenient form (C, C) and gain access to the L for which the change was observed (C). Unless you are writing a subclass of C it isn't normally necessary to instantiate C objects directly. =head2 Changes Classified Various types of change are identified and classified into the following hierarchy: change created deleted metadata time mtime ctime perms uid gid mode size directory files_created files_deleted The terminal nodes of that tree (C, C, C, C, C, C, C, C, C and C) represent actual change events. Non terminal nodes represent broader classifications of events. For example if a file's mtime changes the resulting C object will return true for each of $delta->is_mtime; # The actual change $delta->is_time; # One of the file times changed $delta->is_metadata; # The file's metadata changed $delta->is_change; # This is true for any change This event classification is used to target callbacks at specific events or categories of events. See L and L for more information about callbacks. =head2 Accessors Various accessors allow the state of the object before and after the change and the details of the change to be queried. These accessors return information about the state of the file or directory before the detected change: old_dev old_inode old_mode old_num_links old_uid old_gid old_rdev old_size old_mtime old_ctime old_blk_size old_blocks old_error old_files For example: my $mode_was = $delta->old_mode; These accessors return information about the state of the file or directory after the detected change: new_dev new_inode new_mode new_num_links new_uid new_gid new_rdev new_size new_mtime new_ctime new_blk_size new_blocks new_error new_files For example: my $new_size = $delta->new_size; These accessors return a value that reflects the change in the corresponding attribute: created deleted mtime ctime uid gid mode size With the exception of C, C and C they return the difference between the old value and the new value. This is only really useful in the case of C: my $grown_by = $delta->size; Is equivalent to my $grown_by = $delta->new_size - $delta->old_size; For the other values the subtraction is performed merely to ensure that these values are non-zero. # Get the difference between the old and new UID. Unlikely to be # interesting. my $delta_uid = $delta->uid; As a special case the delta value for C is computed as old_mode ^ new_mode. The old mode is XORed with the new mode so that my $bits_changed = $delta->mode; gets a bitmask of the mode bits that have changed. If the detected change was the creation or deletion of a file C or C respectively will be true. if ( $delta->created ) { print "Yippee! We exist\n"; } if ( $delta->deleted ) { print "Boo! We got deleted\n"; } For a directory which is being monitored with the C or C options (see L for details) C and C will contain respectively the list of new files below this directory and the list of files that have been deleted. my @new_files = $delta->files_created; for my $file ( @new_files ) { print "$file created\n"; } my @gone_away = $delta->files_deletedl for my $file ( @gone_away ) { print "$file deleted\n"; } =head1 INTERFACE =over =item C<< new( $args ) >> Create a new C object. You don't normally need to do this; deltas are created as necessary by L. The single argument is a reference to a hash that must contain the following keys: =over =item object The L for which this change is being reported. =item old_info A hash describing the state of the file or directory before the change. =item new_info A hash describing the state of the file or directory after the change. =back =item C<< is_event( $event ) >> Returns true if this delta represents the specified event. For example, if a file's size changes the following will all return true: $delta->is_event('size'); # The actual change $delta->is_event('metadata'); # The file's metadata changed $delta->is_event('change'); # This is true for any change Valid eventnames are change created deleted metadata time mtime ctime perms uid gid mode size directory files_created files_deleted As an alternative interface you may call CI directly. For example $delta->is_size; $delta->is_metadata; $delta->is_change; Unless the event you wish to test for is variable this is a cleaner, less error prone interface. Normally your code won't see a C for which C returns false. Any change causes C to be true and the C methods of C and C don't return deltas for unchanged files. =item C<< name >> The name of the file for which the change is being reported. Read only. =item C<< object >> The L for which this change is being reported. =back =head2 Other methods As mentioned above a large number of other accessors are provided to get the state of the object before and after the change and query details of the change: old_dev old_inode old_mode old_num_links old_uid old_gid old_rdev old_size old_mtime old_ctime old_blk_size old_blocks old_error old_files new_dev new_inode new_mode new_num_links new_uid new_gid new_rdev new_size new_mtime new_ctime new_blk_size new_blocks new_error new_files created deleted mtime ctime uid gid mode size files_created files_deleted name See L for details of these. =head1 DIAGNOSTICS =over =item C<< %s is read-only >> C is an immutable description of a change in a file's state. None of its accessors allow values to be changed. =item C<< You must supply a value for %s >> The three options that C (C, C and C) are all mandatory. =back =head1 CONFIGURATION AND ENVIRONMENT File::Monitor::Delta requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Andy Armstrong C<< >> Faycal Chraibi originally registered the File::Monitor namespace and then kindly handed it to me. =head1 LICENCE AND COPYRIGHT Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Monitor-1.00/lib/File/Monitor/Object.pm000444000765000120 2553211462070051 20137 0ustar00andyadmin000000000000package File::Monitor::Object; use strict; use warnings; use Carp; use File::Spec; use Scalar::Util qw(weaken); use Fcntl ':mode'; use File::Monitor::Delta; use base qw(File::Monitor::Base); our $VERSION = '1.00'; my @STAT_FIELDS; my @INFO_FIELDS; my $CLASS; BEGIN { @STAT_FIELDS = qw( dev inode mode num_links uid gid rdev size atime mtime ctime blk_size blocks ); @INFO_FIELDS = ( @STAT_FIELDS, qw( error ) ); no strict 'refs'; # Accessors for info for my $info ( @INFO_FIELDS ) { *$info = sub { my $self = shift; croak "$info attribute is read-only" if @_; return $self->{_info}->{$info}; }; } } sub owner { my $self = shift; croak "name attribute is read-only" if @_; return $self->{owner}; } sub name { my $self = shift; croak "name attribute is read-only" if @_; return $self->owner->_make_absolute( $self->{name} ); } sub files { my $self = shift; croak "files attribute is read-only" if @_; my $monitor = $self->owner; return map { $monitor->_make_absolute( $_ ) } @{ $self->{_info}->{files} || [] }; } sub _initialize { my $self = shift; my $args = shift; # Normalize the args $self->SUPER::_initialize( $args ); $self->_install_callbacks( $args ); $self->{_info}->{virgin} = 1; my $name = delete $args->{name} or croak "The name option must be supplied"; $self->{owner} = delete $args->{owner} or croak "A " . __PACKAGE__ . " must have an owner"; # Build our object $self->{name} = $self->owner->_canonical_name( $name ); # Avoid circular references weaken $self->{owner}; for my $opt ( qw(files recurse) ) { $self->{_options}->{$opt} = delete $args->{$opt}; } $self->_report_extra( $args ); } sub _read_dir { my $self = shift; my $dir = shift; opendir( my $dh, $dir ) or die "Can't read $dir ($!)"; my @files = map { File::Spec->catfile( $dir, $_ ) } sort grep { $_ !~ /^[.]{1,2}$/ } readdir( $dh ); closedir( $dh ); return @files; } sub _stat { my $self = shift; my $name = shift; return stat $name; } # Scan our target object sub _scan_object { my $self = shift; my $name = $self->name; my %info; eval { @info{@STAT_FIELDS} = $self->_stat( $name ); if ( defined $info{mode} && S_ISDIR( $info{mode} ) ) { my $monitor = $self->owner; # Do directory specific things if ( $self->{_options}->{files} ) { # Expand one level $info{files} = [ map { $monitor->_make_relative( $_ ) } $self->_read_dir( $name ) ]; } elsif ( $self->{_options}->{recurse} ) { # Expand whole directory tree my @work = $self->_read_dir( $name ); while ( my $obj = shift @work ) { push @{ $info{files} }, $monitor->_make_relative( $obj ); if ( -d $obj ) { # Depth first to simulate recursion unshift @work, $self->_read_dir( $obj ); } } } } }; $info{error} = $@; return \%info; } sub scan { my $self = shift; my $info = $self->_scan_object; my $name = $self->name; my @changes = (); unless ( delete $self->{_info}->{virgin} ) { # Already done one scan, so now we compute deltas my $change = File::Monitor::Delta->new( { object => $self, old_info => $self->{_info}, new_info => $info } ); if ( $change->is_change ) { $self->_make_callbacks( $change ); push @changes, $change; } } $self->{_info} = $info; return @changes; } 1; =head1 NAME File::Monitor::Object - Monitor a filesystem object for changes. =head1 VERSION This document describes File::Monitor::Object version 1.00 =head1 SYNOPSIS Created by L to monitor a single file or directory. use File::Monitor; use File::Monitor::Object; my $monitor = File::Monitor->new(); for my $file ( @files ) { $monitor->watch( $file ); } # First scan just finds out about the monitored files. No changes # will be reported. $monitor->scan; # Later perform a scan and gather any changes for my $change ( $monitor->scan ) { # $change is a File::Monitor::Delta } =head1 DESCRIPTION Monitors changes to a single file or directory. Don't create a C directly; instead call C on L. A C represents a single file or directory. The corresponding file or directory need not exist; a file being created is one of the events that is monitored for. Similarly if the file or directory is deleted that will be reported as a change. Changes of state are returned as a L object. The state of the monitored file or directory at the time of the last C can be queried. Before C is called these methods will all return C. The following methods return the value of the corresponding field from L: dev inode mode num_links uid gid rdev size atime mtime ctime blk_size blocks For example: my $file_size = $object->size; my $modified = $object->mtime; If any error occured during the previous C it may be retrieved like this: my $last_error = $obj->error; It is not an error for the file being monitored not to exist. Finally if a directory is being monitored and the C or C option was specified the list of files in the directory may be retrieved like this: my @contained_files = $obj->files; If C was specified this will return the files and directories immediately below the monitored directory but not the contents of any subdirectories. If C was specified the entire directory tree below this directory will be returned. In either case the returned filenames will be complete absolute paths. =head2 Caveat for Directories Note that C has no magical way to quickly perform a recursive scan of a directory. If you point it at a directory containing 1,000,000 files and specify the C option directory scans I take a long time. =head1 INTERFACE =over =item C<< new( $args ) >> Create a new C. Don't call C directly; use instead L<< File::Monitor->watch >>. =item C<< scan() >> Perform a scan of the monitored file or directory and return a list of changes. The returned list will contain either a single L object describing all changes or will be empty if no changes occurred. if ( my $change = $object->scan ) { # $change is a File::Monitor::Delta that describes all the # changes to the monitored file or directory. } When C is first called the current state of the monitored file/directory will be captured but no change will be reported. =item C<< callback( [ $event, ] $coderef ) >> Register a callback. If C<$event> is omitted the callback will be called for all changes. Specify C<$event> to limit the callback to certain event types. See L for a full list of events. $object->callback( sub { # called for all changes } ); $object->callback( metadata => sub { # called for changes to file/directory metatdata } ); See L for a full list of events that can be monitored. =item C<< name >> Returns the absolute name of the file or directory being monitored. If C was passed a relative path it is resolved relative to the current directory at the time of object creation to make it absolute. =item C<< files >> If monitoring a directory and the C or C options were specified to C, C returns a list of contained files. The returned filenames will be absolute paths. =back =head2 Other Accessors In addition to the above the following methods may be called to return the value of the corresponding field from L: dev inode mode num_links uid gid rdev size atime mtime ctime blk_size blocks For example: my $inode = $obj->inode; Check the documentation for L to discover which fields are valid on your platform. =head1 DIAGNOSTICS =over =item C<< %s is read-only >> You have attempted to modify a read-only accessor. It may be tempting for example to attempt to change the name of the monitored file or directory like this: # Won't work $obj->name( 'somefile.txt' ); All of the attributes exposed by C are read-only. =item C<< When options are supplied as a hash there may be no other arguments >> When creating a new C you must either supply C with a reference to a hash of options or, as a special case, pass a filename and optionally a callback. =item C<< The name option must be supplied >> The options hash must contain a key called C that specifies the name of the file or directory to be monitored. =item C<< A filename must be specified >> You must suppy C with the name of the file or directory to be monitored. =back =head1 CONFIGURATION AND ENVIRONMENT File::Monitor::Object requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Andy Armstrong C<< >> Faycal Chraibi originally registered the File::Monitor namespace and then kindly handed it to me. =head1 LICENCE AND COPYRIGHT Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Monitor-1.00/t000755000765000120 011462070051 13376 5ustar00andyadmin000000000000File-Monitor-1.00/t/00.load.t000444000765000120 30611462070051 15034 0ustar00andyadmin000000000000use Test::More tests => 3; BEGIN { use_ok( 'File::Monitor' ); use_ok( 'File::Monitor::Delta' ); use_ok( 'File::Monitor::Object' ); } diag( "Testing File::Monitor $File::Monitor::VERSION" ); File-Monitor-1.00/t/10.monitor-basic.t000444000765000120 160511462070051 16707 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use File::Monitor; use File::Monitor::Object; my @READ_ONLY = qw( dev inode mode num_links uid gid rdev size atime mtime ctime blk_size blocks error files name ); plan tests => 6 + @READ_ONLY * 2; ok my $monitor = File::Monitor->new(), 'object creation OK'; isa_ok $monitor, 'File::Monitor'; eval { File::Monitor::Object->new( { owner => $monitor } ); }; like $@, qr/name/, 'name is mandatory'; eval { File::Monitor::Object->new( { name => '.' } ); }; like $@, qr/owner/, 'owner is mandatory'; ok my $object = File::Monitor::Object->new( { name => '.', owner => $monitor } ), 'object creaton OK'; isa_ok $object, 'File::Monitor::Object'; for my $field ( @READ_ONLY ) { eval { $object->$field }; ok !$@, "$field can be read"; eval { $object->$field( 'something' ); }; like $@, qr/read\W+only/, "$field can't be written"; } File-Monitor-1.00/t/20.change.t000444000765000120 1126011462070051 15405 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use File::Monitor; use File::Monitor::Object; use File::Monitor::Delta; plan tests => 384; my @tests = ( { name => 'No files', old_info => { mode => 0x000081a4, atime => 1170281355, ctime => 1170281355, mtime => 1170281355, blk_size => 4096, blocks => 0, dev => 234881026, gid => 0, uid => 501, inode => 2828759, num_links => 1, rdev => 0, size => 0, error => '', }, new_info => { mode => 0x000040c9, atime => 1170281385, ctime => 1170281365, mtime => 1170281315, blk_size => 4096, blocks => 0, dev => 234881026, gid => 501, uid => 0, inode => 2828759, num_links => 1, rdev => 0, size => 123, error => '', }, expect => { mode => 0x000081a4 ^ 0x000040c9, ctime => 10, mtime => -40, gid => 501, uid => -501, size => 123, files_created => [], files_deleted => [], } }, { name => 'All files deleted', old_info => { mode => 0x000040c9, atime => 1170281385, ctime => 1170281365, mtime => 1170281315, blk_size => 4096, blocks => 0, dev => 234881026, gid => 501, uid => 0, inode => 2828759, num_links => 1, rdev => 0, size => 123, error => '', files => [ 'a', 'b', 'c' ], }, new_info => { mode => 0x000081a4, atime => 1170281355, ctime => 1170281355, mtime => 1170281355, blk_size => 4096, blocks => 0, dev => 234881026, gid => 0, uid => 501, inode => 2828759, num_links => 1, rdev => 0, size => 0, error => '', # files missing }, expect => { mode => 0x000081a4 ^ 0x000040c9, ctime => -10, mtime => 40, gid => -501, uid => 501, size => -123, files_created => [], files_deleted => [ 'a', 'b', 'c' ], } }, { name => 'Deleted and created', old_info => { mode => 0x000040c9, atime => 1170281385, ctime => 1170281365, mtime => 1170281315, blk_size => 4096, blocks => 0, dev => 234881026, gid => 501, uid => 0, inode => 2828759, num_links => 1, rdev => 0, size => 123, error => '', files => [ 'b', 'a', 'd', 'c', 'e' ], }, new_info => { mode => 0x000081a4, atime => 1170281355, ctime => 1170281355, mtime => 1170281355, blk_size => 4096, blocks => 0, dev => 234881026, gid => 0, uid => 501, inode => 2828759, num_links => 1, rdev => 0, size => 0, error => '', files => [ 'g', 'f', 'z', 'a', 'd', 'e' ], }, expect => { files_created => [ 'f', 'g', 'z' ], files_deleted => [ 'b', 'c' ], } } ); my @read_only_attr = qw( old_dev old_inode old_mode old_num_links old_uid old_gid old_rdev old_size old_mtime old_ctime old_blk_size old_blocks old_error old_files new_dev new_inode new_mode new_num_links new_uid new_gid new_rdev new_size new_mtime new_ctime new_blk_size new_blocks new_error new_files created deleted mtime ctime uid gid mode size files_created files_deleted name ); for my $test ( @tests ) { my $test_name = $test->{name}; ok my $monitor = File::Monitor->new; ok my $object = File::Monitor::Object->new( { name => '.', owner => $monitor } ); isa_ok $object, 'File::Monitor::Object'; ok my $change = File::Monitor::Delta->new( { object => $object, old_info => $test->{old_info}, new_info => $test->{new_info} } ); isa_ok $change, 'File::Monitor::Delta'; for my $ro ( @read_only_attr ) { can_ok $change, $ro; eval { $change->$ro() }; ok !$@, "read $ro OK"; eval { $change->$ro( 'ouch' ) }; like $@, qr/read\W+only/, "can't write $ro"; } while ( my ( $attr, $value ) = each %{ $test->{expect} } ) { if ( $attr =~ /^files_/ ) { my @got = $change->$attr(); is_deeply \@got, $value, "$test_name: $attr OK"; } else { my $got = $change->$attr(); is_deeply $got, $value, "$test_name: $attr OK"; } } } File-Monitor-1.00/t/30.monitor.t000444000765000120 3337411462070051 15662 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 464; use File::Path; use File::Spec; use Cwd; use File::Monitor; use File::Monitor::Object; use Data::Dumper; use Storable; use Fcntl ':mode'; sub empty_dir { my $dir = shift; rmtree( $dir ); } sub with_open { my ( $name, $mode, $cb ) = @_; if ( $mode =~ />/ ) { # Writing so make sure the directory exists my ( $vol, $dir, $leaf ) = File::Spec->splitpath( $name ); my $new_dir = File::Spec->catpath( $vol, $dir, '' ); mkpath( $new_dir ); } open( my $fh, $mode, $name ) or die "Can't open \"$name\" for $mode ($!)\n"; $cb->( $fh ); close( $fh ); } sub touch_file { my $name = shift; with_open( $name, '>>', sub { } ); } my @events = qw( change created deleted metadata time mtime ctime perms uid gid mode size directory files_created files_deleted ); my %test_map = ( true => sub { my ( $name, $change, $opts ) = @_; for my $field ( @$opts ) { my $value = $change->$field(); ok $value, "$name: $field is true" or warn Dumper( $change ); } }, false => sub { my ( $name, $change, $opts ) = @_; for my $field ( @$opts ) { my $value = $change->$field(); ok !$value, "$name: $field is false" or warn Dumper( $change ); } }, positive => sub { my ( $name, $change, $opts ) = @_; for my $field ( @$opts ) { my $value = $change->$field(); cmp_ok $value, '>', 0, "$name: $field is > 0" or warn Dumper( $change ); } }, deeply => sub { my ( $name, $change, $opts ) = @_; while ( my ( $field, $value ) = each %$opts ) { my @got = $change->$field(); is_deeply \@got, $value, "$name: $field matches" or warn Dumper( $change ); } }, is_event => sub { my ( $name, $change, $opts ) = @_; for my $event ( @$opts ) { ok $change->is_event( $event ), "$name: is_event('$event') OK" or warn Dumper( $change ); } }, is_not_event => sub { my ( $name, $change, $opts ) = @_; for my $event ( @$opts ) { ok !$change->is_event( $event ), "$name: !is_event('$event') OK" or warn Dumper( $change ); } }, ); SKIP: { my $tmp_dir = File::Spec->tmpdir; skip "Can't find temporary directory", 464 unless defined $tmp_dir; my $test_dir = File::Spec->catdir( $tmp_dir, "fmtest-$$" ); for my $set_base ( 0 .. 1 ) { my $fix_name = sub { my $name = shift; return File::Spec->catfile( $test_dir, split( /\//, $name ) ); }; my $fix_dir = sub { my $name = shift; return File::Spec->catdir( $test_dir, split( /\//, $name ) ); }; # Forward slashes in names are converted to platform # local path separator my @files = map { $fix_name->( $_ ) } qw( test0 test1 test2 test3 test4 a/long/dir/name/test5 a/long/time/ago/test6 ); my @schedule = ( { name => 'Create one file', action => sub { touch_file( $files[0] ); }, expect => { $files[0] => { true => ['created'], false => ['deleted'], deeply => { files_created => [], files_deleted => [] }, is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], } }, callbacks => { $files[0] => [ 'ctime', 'change', 'mode', 'time', 'created', 'metadata', 'perms' ] }, }, { name => 'Create two files', action => sub { touch_file( $files[1] ); touch_file( $files[2] ); }, expect => { $files[1] => { true => ['created'], false => ['deleted'], is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], }, $files[2] => { true => ['created'], false => ['deleted'], deeply => { files_created => [], files_deleted => [] }, is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], } }, callbacks => { $files[1] => [ 'ctime', 'change', 'mode', 'time', 'created', 'metadata', 'perms' ], $files[2] => [ 'ctime', 'change', 'mode', 'time', 'created', 'metadata', 'perms' ], } }, { name => 'Create another file', action => sub { touch_file( $files[3] ); }, expect => { $files[3] => { true => ['created'], false => ['deleted'], deeply => { files_created => [], files_deleted => [] }, is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], } }, callbacks => { $files[3] => [ 'ctime', 'change',, 'mode', 'time', 'created', 'metadata', 'perms' ], }, }, { name => 'Extend file', action => sub { with_open( $files[1], '>>', sub { my $fh = shift; print $fh 'something'; } ); }, expect => { $files[1] => { false => [ 'created', 'deleted' ], positive => ['size'], deeply => { files_created => [], files_deleted => [] }, is_event => [ 'change', 'metadata', 'size' ], is_not_event => [ 'created', 'deleted', 'directory', 'files_created', 'files_deleted' ], } }, callbacks => { $files[1] => [ 'change', 'metadata', 'size' ], }, }, { name => 'Create file in monitored directories', action => sub { touch_file( $files[6] ); }, expect => { $files[6] => { true => ['created'], false => ['deleted'], is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], }, $fix_dir->( 'a' ) => { deeply => { files_created => [ $fix_dir->( 'a/long' ), $fix_dir->( 'a/long/time' ), $fix_dir->( 'a/long/time/ago' ), $fix_dir->( 'a/long/time/ago/test6' ) ], files_deleted => [] }, true => ['created'], false => ['deleted'], is_event => [ 'change', 'directory', 'files_created', 'created' ], is_not_event => [ 'deleted', 'files_deleted' ], }, $fix_dir->( 'a/long/time/ago' ) => { deeply => { files_created => [ $files[6] ], files_deleted => [] }, true => ['created'], false => ['deleted'], is_event => [ 'change', 'directory', 'files_created', 'created' ], is_not_event => [ 'deleted', 'files_deleted' ], } }, callbacks => { $files[6] => [ 'ctime', 'change',, 'mode', 'time', 'created', 'metadata', 'perms' ], } }, { name => 'More files in monitored directories', action => sub { touch_file( $files[5] ); }, expect => { $files[5] => { true => ['created'], false => ['deleted'], is_event => [ 'change', 'created' ], is_not_event => [ 'deleted', 'directory', 'files_created', 'files_deleted' ], }, $fix_dir->( 'a' ) => { deeply => { files_created => [ $fix_dir->( 'a/long/dir' ), $fix_dir->( 'a/long/dir/name' ), $fix_dir->( 'a/long/dir/name/test5' ) ], files_deleted => [] }, false => [ 'deleted', 'created' ], is_event => [ 'change', 'directory', 'files_created' ], is_not_event => [ 'deleted', 'created', 'files_deleted' ], }, $fix_dir->( 'a/long/dir/name' ) => { deeply => { files_created => [ $files[5] ], files_deleted => [] }, true => ['created'], false => ['deleted'], is_event => [ 'change', 'directory', 'files_created', 'created' ], is_not_event => [ 'deleted', 'files_deleted' ], } }, callbacks => { $files[5] => [ 'ctime', 'change',, 'mode', 'time', 'created', 'metadata', 'perms' ], } }, { name => 'Delete file', action => sub { unlink( $files[5] ) or die "Can't delete ", $files[5], " ($!)\n"; }, expect => { $files[5] => { false => ['created'], true => ['deleted'], is_event => [ 'change', 'deleted' ], is_not_event => [ 'created', 'directory', 'files_created', 'files_deleted' ], }, $fix_dir->( 'a' ) => { deeply => { files_deleted => [ $fix_dir->( 'a/long/dir/name/test5' ) ], files_created => [] }, false => [ 'deleted', 'created' ], is_event => [ 'change', 'directory', 'files_deleted' ], is_not_event => [ 'deleted', 'created', 'files_created' ], }, $fix_dir->( 'a/long/dir/name' ) => { deeply => { files_deleted => [ $files[5] ], files_created => [] }, false => [ 'deleted', 'created' ], is_event => [ 'change', 'directory', 'files_deleted' ], is_not_event => [ 'deleted', 'created', 'files_created' ], } }, callbacks => { $files[5] => [ 'ctime', 'change', 'mode', 'time', 'deleted', 'metadata', 'perms' ], } }, { name => 'Delete directory', action => sub { rmtree( $fix_dir->( 'a/long/dir' ) ); }, expect => { $fix_dir->( 'a' ) => { deeply => { files_deleted => [ $fix_dir->( 'a/long/dir' ), $fix_dir->( 'a/long/dir/name' ), ], files_created => [] }, false => [ 'deleted', 'created' ], }, $fix_dir->( 'a/long/dir/name' ) => { false => ['created'], true => ['deleted'], is_event => [ 'change', 'deleted' ], is_not_event => [ 'directory', 'created', 'files_created', 'files_deleted' ], } } }, ); my $args = {}; if ( $set_base ) { $args->{base} = $test_dir; } my $monitor = File::Monitor->new( $args ); my $cb_recorder = {}; # Add files. None of them exist yet for my $file ( @files ) { my $args = { name => $file }; for my $ev ( @events ) { $args->{callback}->{$ev} = sub { my ( $name, $event, $change ) = @_; $cb_recorder->{$name}->{$event}++; } } $monitor->watch( $args ); } # Add some directories $monitor->watch( { name => $fix_dir->( 'a' ), recurse => 1 } ); $monitor->watch( { name => $fix_dir->( 'a/long/dir/name' ), files => 1 } ); $monitor->watch( { name => $fix_dir->( 'a/long/time/ago' ), recurse => 1, files => 1 } ); my @changed = $monitor->scan; is_deeply \@changed, [], 'first scan, no changes'; for my $item ( @schedule ) { my $test_name = $item->{name}; $item->{action}->(); $cb_recorder = {}; my @ch = $monitor->scan; if ( my $cb_spec = $item->{callbacks} ) { while ( my ( $file, $cbs ) = each %$cb_spec ) { for my $cb ( @$cbs ) { cmp_ok $cb_recorder->{$file}->{$cb}, '==', 1, "$test_name: callback for $file, $cb OK" or warn Dumper( $cb_recorder ); } } } CH: for my $change ( @ch ) { my $name = $change->name; my $caption = "$test_name($name)"; my $expect = delete $item->{expect}->{$name}; ok $expect, "$caption: change expected for $name" or warn Dumper( $change ); while ( my ( $test, $opts ) = each %$expect ) { my $func = $test_map{$test} || die "Test $test undefined"; $func->( $caption, $change, $opts ); } } # Check we used up all the items is_deeply $item->{expect}, {}, "$test_name: all expected changes matched"; # Make sure another scan returns no changes @ch = $monitor->scan; is_deeply \@ch, [], "$test_name: no change"; } #diag( Dumper( $monitor ) ); rmtree $test_dir; } } File-Monitor-1.00/t/40.relocate.t000444000765000120 1041211462070051 15756 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use File::Spec; use File::Path; use File::Monitor; use Data::Dumper; use Test::More tests => 11; sub with_open { my ( $name, $mode, $cb ) = @_; if ( $mode =~ />/ ) { # Writing so make sure the directory exists my ( $vol, $dir, $leaf ) = File::Spec->splitpath( $name ); my $new_dir = File::Spec->catpath( $vol, $dir, '' ); mkpath( $new_dir ); } open( my $fh, $mode, $name ) or die "Can't open \"$name\" for $mode ($!)\n"; $cb->( $fh ); close( $fh ); } sub touch_file { my $name = shift; with_open( $name, '>>', sub { } ); } sub sort_arrays { my $obj = shift; if ( ref $obj eq 'ARRAY' ) { return sort @$obj; } elsif ( ref $obj eq 'HASH' ) { while ( my ( $n, $v ) = each %$obj ) { $obj->{$n} = sort_arrays( $v ); } } else { $obj ||= '(undef)'; die "Can't sort $obj\n"; } } SKIP: { my $tmp_dir = File::Spec->tmpdir; skip "Can't find temporary directory", 11 unless defined $tmp_dir; my $test_base = File::Spec->catdir( $tmp_dir, "fmtest-$$" ); my $next_suff = 1; my $next_dir = sub { return File::Spec->catdir( $test_base, sprintf( "dir%03d", $next_suff++ ) ); }; my $test_dir = $next_dir->(); my $fix_name = sub { my $name = shift; return File::Spec->catfile( $test_dir, split( /\//, $name ) ); }; my $fix_dir = sub { my $name = shift; return File::Spec->catdir( $test_dir, split( /\//, $name ) ); }; my %change = (); my %action = ( add_dir => sub { my $dirs = shift; for my $dir ( @$dirs ) { my $name = $fix_dir->( $dir ); mkpath( $name ); } }, add_file => sub { my $files = shift; for my $file ( @$files ) { my $name = $fix_name->( $file ); touch_file( $name ); } }, rm_dir => sub { my $dirs = shift; for my $dir ( @$dirs ) { my $name = $fix_dir->( $dir ); rmtree( $name ); } }, rm_file => sub { my $files = shift; for my $file ( @$files ) { my $name = $fix_name->( $file ); unlink $name or die "Can't delete $name ($!)\n"; } }, ); my @schedule = ( { name => 'Create directories', add_dir => [qw( a b/c d/e/f )], }, { name => 'Create files', add_file => [qw( a/f1 b/c/f2 d/e/f/f3 )], }, { name => 'Create more directories', add_dir => [qw( g/h i )], }, { name => 'Delete files', rm_file => [qw( b/c/f2 d/e/f/f3)], }, { name => 'Delete directories', rm_dir => [qw( g/h i /b/c d/e/f)], }, ); my $monitor = File::Monitor->new( { base => $test_dir } ); $monitor->watch( { name => $test_dir, recurse => 1 } ); my @changed = $monitor->scan; is_deeply \@changed, [], 'first scan, no changes'; for my $test ( @schedule ) { %change = (); my $name = delete $test->{name}; while ( my ( $act, $arg ) = each %$test ) { my $code = $action{$act} || die "No action $act defined"; $code->( $arg ); push @{ $change{$act} }, @$arg; } # Relocate the test directory my $new_dir = $next_dir->(); rename( $test_dir, $new_dir ) or die "Can't rename $test_dir to $new_dir ($!)\n"; $monitor->base( $new_dir ); $test_dir = $new_dir; is $monitor->base, $test_dir, "$name: monitor relocated"; my %expect = (); # Get the expected changes for my $mode ( [ 'add', 'files_created' ], [ 'rm', 'files_deleted' ] ) { my ( $act, $key ) = @$mode; for my $type ( [ 'dir', $fix_dir ], [ 'file', $fix_name ] ) { my ( $typ, $fix ) = @$type; push @{ $expect{$key} }, map { $fix->( $_ ) } @{ $change{"${act}_${typ}"} || [] }; } } # Get the changes my %got = (); my @changes = $monitor->scan(); for my $change ( @changes ) { for my $meth ( qw ( files_created files_deleted ) ) { push @{ $got{$meth} }, $change->$meth; } } my $r_got = sort_arrays( \%got ); my $r_expect = sort_arrays( \%expect ); unless ( is_deeply $r_got, $r_expect, "$name: changes match" ) { diag( Data::Dumper->Dump( [$r_got], ['$got'] ) ); diag( Data::Dumper->Dump( [$r_expect], ['$expect'] ) ); } } rmtree( $test_base ); } File-Monitor-1.00/t/50.freeze.t000444000765000120 1103011462070051 15436 0ustar00andyadmin000000000000#!/usr/bin/perl use strict; use warnings; use Storable qw(freeze thaw); use Data::Dumper; use File::Spec; use File::Path; use File::Monitor; use Test::More tests => 26; sub with_open { my ( $name, $mode, $cb ) = @_; if ( $mode =~ />/ ) { # Writing so make sure the directory exists my ( $vol, $dir, $leaf ) = File::Spec->splitpath( $name ); my $new_dir = File::Spec->catpath( $vol, $dir, '' ); mkpath( $new_dir ); } open( my $fh, $mode, $name ) or die "Can't open \"$name\" for $mode ($!)\n"; $cb->( $fh ); close( $fh ); } sub touch_file { my $name = shift; with_open( $name, '>>', sub { } ); } sub sort_arrays { my $obj = shift; if ( ref $obj eq 'ARRAY' ) { return sort @$obj; } elsif ( ref $obj eq 'HASH' ) { while ( my ( $n, $v ) = each %$obj ) { $obj->{$n} = sort_arrays( $v ); } } else { $obj ||= '(undef)'; die "Can't sort $obj\n"; } } SKIP: { my $tmp_dir = File::Spec->tmpdir; skip "Can't find temporary directory", 26 unless defined $tmp_dir; my $test_base = File::Spec->catdir( $tmp_dir, "fmtest-$$" ); my $next_suff = 1; my $next_dir = sub { return File::Spec->catdir( $test_base, sprintf( "dir%03d", $next_suff++ ) ); }; my $test_dir = $next_dir->(); my $fix_name = sub { my $name = shift; return File::Spec->catfile( $test_dir, split( /\//, $name ) ); }; my $fix_dir = sub { my $name = shift; return File::Spec->catdir( $test_dir, split( /\//, $name ) ); }; my %change = (); my %action = ( add_dir => sub { my $dirs = shift; for my $dir ( @$dirs ) { my $name = $fix_dir->( $dir ); mkpath( $name ); } }, add_file => sub { my $files = shift; for my $file ( @$files ) { my $name = $fix_name->( $file ); touch_file( $name ); } }, rm_dir => sub { my $dirs = shift; for my $dir ( @$dirs ) { my $name = $fix_dir->( $dir ); rmtree( $name ); } }, rm_file => sub { my $files = shift; for my $file ( @$files ) { my $name = $fix_name->( $file ); unlink $name or die "Can't delete $name ($!)\n"; } }, ); my @schedule = ( { name => 'Create directories', add_dir => [qw( a b/c d/e/f )], }, { name => 'Create files', add_file => [qw( a/f1 b/c/f2 d/e/f/f3 )], }, { name => 'Create more directories', add_dir => [qw( g/h i )], }, { name => 'Delete files', rm_file => [qw( b/c/f2 d/e/f/f3)], }, { name => 'Delete directories', rm_dir => [qw( g/h i /b/c d/e/f)], }, ); my $thawed = File::Monitor->new( { base => $test_dir } ); $thawed->watch( { name => $test_dir, recurse => 1 } ); my @changed = $thawed->scan; is_deeply \@changed, [], 'first scan, no changes'; for my $test ( @schedule ) { %change = (); my $name = delete $test->{name}; while ( my ( $act, $arg ) = each %$test ) { my $code = $action{$act} || die "No action $act defined"; $code->( $arg ); push @{ $change{$act} }, @$arg; } # Relocate the test directory my $new_dir = $next_dir->(); rename( $test_dir, $new_dir ) or die "Can't rename $test_dir to $new_dir ($!)\n"; my $frozen = eval { freeze $thawed }; ok !$@, "$name: freeze OK" or diag "Error from freeze: $@"; my $thawed = eval { thaw $frozen }; ok !$@, "$name: thaw OK" or diag "Error from thaw: $@"; isa_ok $thawed, 'File::Monitor'; $thawed->base( $new_dir ); $test_dir = $new_dir; is $thawed->base, $test_dir, "$name: monitor relocated"; my %expect = (); # Get the expected changes for my $mode ( [ 'add', 'files_created' ], [ 'rm', 'files_deleted' ] ) { my ( $act, $key ) = @$mode; for my $type ( [ 'dir', $fix_dir ], [ 'file', $fix_name ] ) { my ( $typ, $fix ) = @$type; push @{ $expect{$key} }, map { $fix->( $_ ) } @{ $change{"${act}_${typ}"} || [] }; } } # Get the changes my %got = (); my @changes = $thawed->scan(); for my $change ( @changes ) { for my $meth ( qw ( files_created files_deleted ) ) { push @{ $got{$meth} }, $change->$meth; } } my $r_got = sort_arrays( \%got ); my $r_expect = sort_arrays( \%expect ); unless ( is_deeply $r_got, $r_expect, "$name: changes match" ) { diag( Data::Dumper->Dump( [$r_got], ['$got'] ) ); diag( Data::Dumper->Dump( [$r_expect], ['$expect'] ) ); } } rmtree( $test_base ); } File-Monitor-1.00/t/pod-coverage.t000444000765000120 70611462070051 16256 0ustar00andyadmin000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( { private => [ qr{^_}, ], trustme => [ qr{^(?:files_)?(?:created|deleted)$}, qr{^is_\w+$}, qr{^(?:new_|old_|)(?:files|atime|blk_size|blocks|ctime|dev|error|gid|inode|mode|mtime|num_links|owner|rdev|size|uid)$}, qr{^(?:new|callback)$}, ] } ); File-Monitor-1.00/t/pod.t000444000765000120 21411462070051 14457 0ustar00andyadmin000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();