package Filesys::Notify::Simple; use strict; use 5.008_001; our $VERSION = '0.14'; 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::carp("watch failed for $path: $!"); } 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. =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 method blocks. =back In return, this module doesn't depend on any non-core modules. Platform specific optimizations with L, L, L and L are truely optional. NOTE: Using L may put additional limitations. =over 4 =item * L 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 is not used. =item * If more than 64 directories are included under the specified paths, an error occurrs. =back =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE =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 L L L L =cut