package Filesys::Notify::Simple;
use strict;
use 5.008_001;
our $VERSION = '0.13';
use Carp ();
use Cwd;
use constant NO_OPT => $ENV{PERL_FNS_NO_OPT};
sub new {
my($class, $path) = @_;
unless (ref $path eq 'ARRAY') {
Carp::croak('Usage: Filesys::Notify::Simple->new([ $path1, $path2 ])');
}
my $self = bless { paths => $path }, $class;
$self->init;
$self;
}
sub wait {
my($self, $cb) = @_;
$self->{watcher} ||= $self->{watcher_cb}->(@{$self->{paths}});
$self->{watcher}->($cb);
}
sub init {
my $self = shift;
local $@;
if ($^O eq 'linux' && !NO_OPT && eval { require Linux::Inotify2; 1 }) {
$self->{watcher_cb} = \&wait_inotify2;
} elsif ($^O eq 'darwin' && !NO_OPT && eval { require Mac::FSEvents; 1 }) {
$self->{watcher_cb} = \&wait_fsevents;
} elsif (($^O eq 'freebsd' || $^O eq 'openbsd') && !NO_OPT && eval { require Filesys::Notify::KQueue; 1 }) {
$self->{watcher_cb} = \&wait_kqueue;
} elsif ($^O eq 'MSWin32' && !NO_OPT && eval { require Win32::ChangeNotify; 1 }) {
$self->{watcher_cb} = mk_wait_win32(0); # Not cygwin
} elsif ($^O eq 'cygwin' && !NO_OPT && eval { require Win32::ChangeNotify; 1 }) {
$self->{watcher_cb} = mk_wait_win32(1); # Cygwin
} else {
$self->{watcher_cb} = \&wait_timer;
}
}
sub wait_inotify2 {
my @path = @_;
Linux::Inotify2->import;
my $inotify = Linux::Inotify2->new;
my $fs = _full_scan(@path);
for my $path (keys %$fs) {
$inotify->watch($path, &IN_MODIFY|&IN_CREATE|&IN_DELETE|&IN_DELETE_SELF|&IN_MOVE_SELF|&IN_MOVE)
or Carp::croak("watch failed: $!");
}
return sub {
my $cb = shift;
$inotify->blocking(1);
my @events = $inotify->read;
$cb->(map { +{ path => $_->fullname } } @events);
};
}
sub wait_fsevents {
require IO::Select;
my @path = @_;
my $fs = _full_scan(@path);
my $sel = IO::Select->new;
my %events;
for my $path (@path) {
my $fsevents = Mac::FSEvents->new({ path => $path, latency => 1, file_events => 1 });
my $fh = $fsevents->watch;
$sel->add($fh);
$events{fileno $fh} = $fsevents;
}
return sub {
my $cb = shift;
my @ready = $sel->can_read;
my @events;
for my $fh (@ready) {
my $fsevents = $events{fileno $fh};
my %uniq;
my @path = grep !$uniq{$_}++, map { $_->path } $fsevents->read_events;
my $new_fs = _full_scan(@path);
my $old_fs = +{ map { ($_ => $fs->{$_}) } keys %$new_fs };
_compare_fs($old_fs, $new_fs, sub { push @events, { path => $_[0] } });
$fs->{$_} = $new_fs->{$_} for keys %$new_fs;
last if @events;
}
$cb->(@events);
};
}
sub wait_kqueue {
my @path = @_;
my $kqueue = Filesys::Notify::KQueue->new(
path => \@path
);
return sub { $kqueue->wait(shift) };
}
sub mk_wait_win32 {
my ($is_cygwin) = @_;
return sub {
my @path = @_;
my $fs = _full_scan(@path);
my (@notify, @fskey);
for my $path (keys %$fs) {
my $winpath = $is_cygwin ? Cygwin::posix_to_win_path($path) : $path;
# 0x1b means 'DIR_NAME|FILE_NAME|LAST_WRITE|SIZE' = 2|1|0x10|8
push @notify, Win32::ChangeNotify->new($winpath, 0, 0x1b);
push @fskey, $path;
}
return sub {
my $cb = shift;
my @events;
while(1) {
my $idx = Win32::ChangeNotify::wait_any(\@notify);
Carp::croak("Can't wait notifications, maybe ".scalar(@notify)." directories exceeds limitation.") if ! defined $idx;
if($idx > 0) {
--$idx;
my $new_fs = _full_scan($fskey[$idx]);
$notify[$idx]->reset;
my $old_fs = +{ map { ($_ => $fs->{$_}) } keys %$new_fs };
_compare_fs($old_fs, $new_fs, sub { push @events, { path => $_[0] } });
$fs->{$_} = $new_fs->{$_} for keys %$new_fs;
last if @events; # Actually changed
}
}
$cb->(@events);
}
}
}
sub wait_timer {
my @path = @_;
my $fs = _full_scan(@path);
return sub {
my $cb = shift;
my @events;
while (1) {
sleep 2;
my $new_fs = _full_scan(@path);
_compare_fs($fs, $new_fs, sub { push @events, { path => $_[0] } });
$fs = $new_fs;
last if @events;
};
$cb->(@events);
};
}
sub _compare_fs {
my($old, $new, $cb) = @_;
for my $dir (keys %$old) {
for my $path (keys %{$old->{$dir}}) {
if (!exists $new->{$dir}{$path}) {
$cb->($path); # deleted
} elsif (!$new->{$dir}{$path}{is_dir} &&
( $old->{$dir}{$path}{mtime} != $new->{$dir}{$path}{mtime} ||
$old->{$dir}{$path}{size} != $new->{$dir}{$path}{size})) {
$cb->($path); # updated
}
}
}
for my $dir (keys %$new) {
for my $path (sort grep { !exists $old->{$dir}{$_} } keys %{$new->{$dir}}) {
$cb->($path); # new
}
}
}
sub _full_scan {
my @paths = @_;
require File::Find;
my %map;
for my $path (@paths) {
my $fp = eval { Cwd::realpath($path) } or next;
File::Find::finddepth({
wanted => sub {
my $fullname = $File::Find::fullname || File::Spec->rel2abs($File::Find::name);
$map{Cwd::realpath($File::Find::dir)}{$fullname} = _stat($fullname);
},
follow_fast => 1,
follow_skip => 2,
no_chdir => 1,
}, $path);
# remove root entry
# NOTE: On MSWin32, realpath and rel2abs disagree with path separator.
delete $map{$fp}{File::Spec->rel2abs($fp)};
}
return \%map;
}
sub _stat {
my $path = shift;
my @stat = stat $path;
return { path => $path, mtime => $stat[9], size => $stat[7], is_dir => -d _ };
}
1;
__END__
=encoding utf-8
=for stopwords
=head1 NAME
Filesys::Notify::Simple - Simple and dumb file system watcher
=head1 SYNOPSIS
use Filesys::Notify::Simple;
my $watcher = Filesys::Notify::Simple->new([ "." ]);
$watcher->wait(sub {
for my $event (@_) {
$event->{path} # full path of the file updated
}
});
=head1 DESCRIPTION
Filesys::Notify::Simple is a simple but unified interface to get
notifications of changes to a given filesystem path. It utilizes
inotify2 on Linux, fsevents on OS X, kqueue on FreeBSD and
FindFirstChangeNotification on Windows if they're installed, with a
fallback to the full directory scan if they're not available.
There are some limitations in this module. If you don't like it, use
L<File::ChangeNotify>.
=over 4
=item *
There is no file name based filter. Do it in your own code.
=item *
You can not get types of events (created, updated, deleted).
=item *
Currently C<wait> method blocks.
=back
In return, this module doesn't depend on any non-core
modules. Platform specific optimizations with L<Linux::Inotify2>,
L<Mac::FSEvents>, L<Filesys::Notify::KQueue> and L<Win32::ChangeNotify>
are truely optional.
NOTE: Using L<Win32::ChangeNotify> may put additional limitations.
=over 4
=item *
L<Win32::ChangeNotify> uses FindFirstChangeNotificationA so that
Unicode characters can not be handled.
On cygwin (1.7 or later), Unicode characters should be able to be handled
when L<Win32::ChangeNotify> is not used.
=item *
If more than 64 directories are included under the specified paths,
an error occurrs.
=back
=head1 AUTHOR
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<File::ChangeNotify> L<Mac::FSEvents> L<Linux::Inotify2> L<Filesys::Notify::KQueue>
L<Win32::ChangeNotify>
=cut