File Coverage

blib/lib/AnyEvent/Filesys/Notify.pm

Criterion	Covered	Total	%
statement	97	105	92.3
branch	38	44	86.3
condition	5	6	83.3
subroutine	22	27	81.4
pod	0	1	0.0
total	162	183	88.5

package AnyEvent::Filesys::Notify;

# ABSTRACT: An AnyEvent compatible module to monitor files/directories for changes

use Moo;
use Moo::Role ();
use MooX::late;
use namespace::autoclean;
use AnyEvent;
use Path::Iterator::Rule;
use Cwd qw/abs_path/;
use AnyEvent::Filesys::Notify::Event;
use Carp;
use Try::Tiny;

our $VERSION = '1.23';
my $AEFN = 'AnyEvent::Filesys::Notify';

has dirs         => ( is => 'ro', isa => 'ArrayRef[Str]', required => 1 );
has cb           => ( is => 'rw', isa => 'CodeRef',       required => 1 );
has interval     => ( is => 'ro', isa => 'Num',           default  => 2 );
has no_external  => ( is => 'ro', isa => 'Bool',          default  => 0 );
has backend      => ( is => 'ro', isa => 'Str',           default  => '' );
has filter       => ( is => 'rw', isa => 'RegexpRef|CodeRef' );
has parse_events => ( is => 'rw', isa => 'Bool',          default  => 0 );
has skip_subdirs => ( is => 'ro', isa => 'Bool',          default  => 0 );
has _fs_monitor  => ( is => 'rw', );
has _old_fs => ( is => 'rw', isa => 'HashRef' );
has _watcher => ( is => 'rw', );

sub BUILD {
    my $self = shift;

    $self->_old_fs( $self->_scan_fs( $self->dirs ) );

    $self->_load_backend;
    return $self->_init;    # initialize the backend
}

sub _process_events {
    my ( $self, @raw_events ) = @_;

    # Some implementations provided enough information to parse the raw events,
    # other require rescanning the file system (ie, Mac::FSEvents).
    # The original behavior was to rescan in all implementations, so we
    # have added a flag to avoid breaking old code.

    my @events;

    if ( $self->parse_events and $self->can('_parse_events') ) {
        @events =
          $self->_parse_events( sub { $self->_apply_filter(@_) }, @raw_events );
    } else {
        my $new_fs = $self->_scan_fs( $self->dirs );
        @events =
          $self->_apply_filter( $self->_diff_fs( $self->_old_fs, $new_fs ) );
        $self->_old_fs($new_fs);

        # Some backends (when not using parse_events) need to add files
        # (KQueue) or directories (Inotify2) to the watch list after they are
        # created. Give them a chance to do that here.
        $self->_post_process_events(@events)
          if $self->can('_post_process_events');
    }

    $self->cb->(@events) if @events;

    return \@events;
}

sub _apply_filter {
    my ( $self, @events ) = @_;

    if ( ref $self->filter eq 'CODE' ) {
        my $cb = $self->filter;
        @events = grep { $cb->( $_->path ) } @events;
    } elsif ( ref $self->filter eq 'Regexp' ) {
        my $re = $self->filter;
        @events = grep { $_->path =~ $re } @events;
    }

    return @events;
}

# Return a hash ref representing all the files and stats in @path.
# Keys are absolute path and values are path/mtime/size/is_dir
# Takes either array or arrayref
sub _scan_fs {
    my ( $self, @args ) = @_;

    # Accept either an array of dirs or a array ref of dirs
    my @paths = ref $args[0] eq 'ARRAY' ? @{ $args[0] } : @args;

    my $fs_stats = {};

    my $rule = Path::Iterator::Rule->new;
    $rule->skip_subdirs(qr/./)
        if (ref $self) =~ /^AnyEvent::Filesys::Notify/
        && $self->skip_subdirs;
    my $next = $rule->iter(@paths);
    while ( my $file = $next->() ) {
        my $stat = $self->_stat($file)
          or next; # Skip files that we can't stat (ie, broken symlinks on ext4)
        $fs_stats->{ abs_path($file) } = $stat;
    }

    return $fs_stats;
}

sub _diff_fs {
    my ( $self, $old_fs, $new_fs ) = @_;
    my @events = ();

    for my $path ( keys %$old_fs ) {
        if ( not exists $new_fs->{$path} ) {
            push @events,
              AnyEvent::Filesys::Notify::Event->new(
                path   => $path,
                type   => 'deleted',
                is_dir => $old_fs->{$path}->{is_dir},
              );
        } elsif (
            $self->_is_path_modified( $old_fs->{$path}, $new_fs->{$path} ) )
        {
            push @events,
              AnyEvent::Filesys::Notify::Event->new(
                path   => $path,
                type   => 'modified',
                is_dir => $old_fs->{$path}->{is_dir},
              );
        }
    }

    for my $path ( keys %$new_fs ) {
        if ( not exists $old_fs->{$path} ) {
            push @events,
              AnyEvent::Filesys::Notify::Event->new(
                path   => $path,
                type   => 'created',
                is_dir => $new_fs->{$path}->{is_dir},
              );
        }
    }

    return @events;
}

sub _is_path_modified {
    my ( $self, $old_path, $new_path ) = @_;

    return 1 if $new_path->{mode} != $old_path->{mode};
    return   if $new_path->{is_dir};
    return 1 if $new_path->{mtime} != $old_path->{mtime};
    return 1 if $new_path->{size} != $old_path->{size};
    return;
}

# Originally taken from Filesys::Notify::Simple --Thanks Miyagawa
sub _stat {
    my ( $self, $path ) = @_;

    my @stat = stat $path;

    # Return undefined if no stats can be retrieved, as it happens with broken
    # symlinks (at least under ext4).
    return unless @stat;

    return {
        path   => $path,
        mtime  => $stat[9],
        size   => $stat[7],
        mode   => $stat[2],
        is_dir => -d _,
    };

}

# Figure out which backend to use:
# I would prefer this to be done at compile time not object build, but I also
# want the user to be able to force the Fallback role. Something like an
# import flag would be great, but Moose creates an import sub for us and
# I'm not sure how to cleanly do it. Maybe need to use traits, but the
# documentation suggests traits are for application of roles by object.
# This will work for now.
sub _load_backend {
    my $self = shift;

    if ( $self->backend ) {

        # Use the AEFN::Role prefix unless the backend starts with a +
        my $prefix  = "${AEFN}::Role::";
        my $backend = $self->backend;
        $backend = $prefix . $backend unless $backend =~ s{^\+}{};

        try { Moo::Role->apply_roles_to_object( $self, $backend ); }
        catch {
            croak "Unable to load the specified backend ($backend). You may "
              . "need to install Linux::INotify2, Mac::FSEvents or IO::KQueue:"
              . "\n$_";
        }
    } elsif ( $self->no_external ) {
        Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
    } elsif ( $^O eq 'linux' ) {
        try {
            Moo::Role->apply_roles_to_object( $self,
                "${AEFN}::Role::Inotify2" );
        }
        catch {
            croak "Unable to load the Linux plugin. You may want to install "
              . "Linux::INotify2 or specify 'no_external' (but that is very "
              . "inefficient):\n$_";
        }
    } elsif ( $^O eq 'darwin' ) {
        try {
            Moo::Role->apply_roles_to_object( $self,
                "${AEFN}::Role::FSEvents" );
        }
        catch {
            croak "Unable to load the Mac plugin. You may want to install "
              . "Mac::FSEvents or specify 'no_external' (but that is very "
              . "inefficient):\n$_";
        }
    } elsif ( $^O =~ /bsd/ ) {
        try {
            Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::KQueue" );
        }
        catch {
            croak "Unable to load the BSD plugin. You may want to install "
              . "IO::KQueue or specify 'no_external' (but that is very "
              . "inefficient):\n$_";
        }
    } else {
        Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
    }

    return 1;
}

1;

__END__