#!/usr/bin/perl
# Created on: 2014-12-16 14:07:12
# Create by: Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$
use strict;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use FindBin qw/$Bin/;
our $VERSION = 0.001;
my ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
my $types = [qw/
IN_ACCESS
IN_MODIFY
IN_ATTRIB
IN_CLOSE_WRITE
IN_CLOSE_NOWRITE
IN_OPEN
IN_ALL_EVENTS
IN_MOVED_FROM
IN_MOVED_TO
IN_CREATE
IN_DELETE
IN_DELETE_SELF
IN_MOVE_SELF
/];
my %option = (
dir => 0,
verbose => 0,
man => 0,
help => 0,
VERSION => 0,
);
my %watch;
my $inotify;
main();
exit 0;
sub main {
Getopt::Long::Configure('bundling');
GetOptions(
\%option,
'dir|d!',
'type|t=s@',
'report|r',
'command|cmd|c=s',
'verbose|v+',
'man',
'help',
'version',
) or pod2usage(2);
if ( $option{'version'} ) {
print "$name Version = $VERSION\n";
exit 1;
}
elsif ( $option{'man'} ) {
pod2usage( -verbose => 2 );
}
elsif ( $option{'help'} ) {
pod2usage( -verbose => 1 );
}
# do stuff here
my @files = map { path($_) } @ARGV ? @ARGV : ('.');
my $tc = File::TypeCategories->new();
$inotify = Linux::Inotify2->new;
while ( my $file = shift @files ) {
next if !$tc->file_ok($file);
if ( -d $file ) {
push @files, $file->children;
next if !$option{dir};
}
warn "$file\n" if $option{verbose};
watch($file);
}
if ( $option{type} && @{ $option{type} } == 1 && $option{type}[0] eq 'ALL' ) {
$option{type} = $types;
}
else {
$option{type} ||= ['IN_MODIFY', 'IN_MOVE_SELF'];
}
if ( $option{report} ) {
#push @watchers, AE::signal INT => \&report;
$SIG{INT} = \&report;
}
my $refresh = AE::timer(1, 1, sub { report('changes'); });
AnyEvent::Loop::run;
return;
}
sub watch {
my ($file) = @_;
warn "The file '$file' no longer exists!\n" if !-e $file;
$watch{$file} = {
notify => scalar $inotify->watch( $file, Linux::Inotify2::IN_ALL_EVENTS(), \&changed ),
ae => scalar AE::io $inotify->fileno, 0, sub { $inotify->poll },
};
return;
}
my @refresh;
my %changed;
my %changes;
sub changed {
my ($evt) = @_;
my $file = $evt->{w}{name};
$changed{$file}{time} = time;
$changed{$file}{types} = {
%{ $changed{$file}{types} || {} },
map { $_ => 1 } grep { $evt->$_() } @$types
};
$changes{$file}{time} = time;
$changes{$file}{types} = {
%{ $changes{$file}{types} || {} },
map { $_ => 1 } grep { $evt->$_() } @$types
};
push @refresh, AE::timer(1, 0, sub { watch($file); });
return;
}
sub report {
my $changes = shift;
my %change = $changes eq 'changes' ? %changes : %changed;
for my $file ( sort keys %change ) {
print "$file\t", ( join ', ', sort keys %{ $change{$file}{types} } ), "\n";
}
if ($changes eq 'changes') {
if ($option{command}) {
local $ENV{CHANGED} = join ':', sort keys \%change;
system $option{command};
}
%changes = ();
return;
}
exit;
}
__DATA__
=head1 NAME
file-watch - Watch files and directories for changes
=head1 VERSION
This documentation refers to file-watch version 0.001
=head1 SYNOPSIS
file-watch [option] [file(s)]
OPTIONS:
-d --dir Check directories
--no-dir Don't check directories (Default)
-t --type[=]str
Specify the type of file events to listen for, more than
one event can be specified.
- IN_ACCESS
- IN_MODIFY
- IN_ATTRIB
- IN_CLOSE_WRITE
- IN_CLOSE_NOWRITE
- IN_OPEN
- IN_ALL_EVENTS
- IN_MOVED_FROM
- IN_MOVED_TO
- IN_CREATE
- IN_DELETE
- IN_DELETE_SELF
- IN_MOVE_SELF
- ALL - special pseudo event setting all events on so you can
see which ones are actually fired
-r --report When killed, a report will be generated of all files modified
-c --command[=]'command to run'
When a file is detected to have changed this command can be run
-v --verbose Show more detailed option
--version Prints the version information
--help Prints this help information
--man Prints the full documentation for file-watch
=head1 DESCRIPTION
C<file-watch> uses iNotify to track when files change. The types of changes
can be found in L<Linux::Inotify2>.
=head2 Running Commands
When you use the C<--command> option changes will be chunked and displayed
every second. The program you run can find the files that triggered it by
inspecting the environment variable C<$CHANGED> which is a colon (:)
separated list of files.
=head1 SUBROUTINES/METHODS
=head1 DIAGNOSTICS
=head1 DEPENDENCIES
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
There are no known bugs in this module.
Please report problems to Ivan Wills (ivan.wills@gmail.com).
Patches are welcome.
=head1 AUTHOR
Ivan Wills - (ivan.wills@gmail.com)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2014-2015 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
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<perlartistic>. This program is
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.
=cut