view release on metacpan or  search on metacpan

lib/App/watchdo.pm  view on Meta::CPAN

package App::watchdo;

# Created on: 2015-03-07 08:21:28
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use Moo;
use warnings;
use version;
use Carp;
use List::MoreUtils qw/uniq/;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use AnyEvent;
use AnyEvent::Loop;
use AnyEvent::Filesys::Notify;
use Path::Tiny;

our $VERSION = version->new('0.1.1');

has [qw/git run done/] => ( is => 'rw' );
has [qw/dirs files exclude changed/] => (
    is      => 'rw',
    default => sub {[]},
);
has wait => (
    is      => 'rw',
    default => 1,
);
has vcs => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        require VCS::Which;
        return VCS::Which->new;
    },
);

sub watch {
    my ($self) = @_;

    my $notify = AnyEvent::Filesys::Notify->new(
        dirs => [ $self->get_dirs ],
        cb   => sub {
            my @changed = @_;
            $self->changed([ @{ $self->changed }, @changed ]);

            if ( ! $self->done ) {
                $self->done( AE::timer $self->wait, 0, sub { $self->doit() } );
            }
        },
        parse_events => 1,
    );

    return AnyEvent::Loop::run();
}

sub doit {
    my ($self) = @_;
    my %files = map { $_ => 1 } $self->get_files();
    my %dirs  = map { $_ => 1 } @{ $self->dirs() };
    my %seen;

    my @monitored;
    for my $changed (@{ $self->changed() }) {
        my $path = $changed->path;
        push @monitored, $changed if (
            !$seen{$path}++
            || $files{$path}
            || $dirs{$path}
        ) && (
            ! @{ $self->exclude }
            || ! grep { $path =~ /$_/ } @{ $self->exclude }
        );
    }

    $self->run()->(@monitored) if @monitored;
    $self->done(undef);
    $self->changed([]);
}

sub get_dirs {
    my ($self) = @_;

    return uniq sort +(
        @{ $self->dirs || [] },
        map {path($_)->parent . ''}
        $self->get_files,
    );
}

sub get_files {
    my ($self) = @_;

    return ( $self->_files_from_fs, $self->_files_from_git );
}

sub _files_from_fs {
    my ($self) = @_;

    return map { -d $_ ? _recurse($_) : $_ }
        @{ $self->files };
}

sub _files_from_git {
    my ($self) = @_;

    return if !$self->git;