File Coverage

blib/lib/File/Hotfolder.pm

Criterion	Covered	Total	%
statement	27	80	33.7
branch	0	46	0.0
condition	0	26	0.0
subroutine	9	22	40.9
pod	4	7	57.1
total	40	181	22.1

package File::Hotfolder;
use strict;
use warnings;
use v5.10;

our $VERSION = '0.03';

use Carp;
use File::Find;
use File::Spec;
use Linux::Inotify2;

use parent 'Exporter';
our %EXPORT_TAGS = (print => [qw(WATCH_DIR FOUND_FILE DELETE_FILE CATCH_ERROR)]);
our @EXPORT = ('watch', @{$EXPORT_TAGS{'print'}});
$EXPORT_TAGS{all} = \@EXPORT;

use constant {
    WATCH_DIR   => 1,
    FOUND_FILE  => 2,
    DELETE_FILE => 4,
    CATCH_ERROR => 8,
};

# function interface
sub watch {
    shift if $_[0] eq 'File::Hotfolder';
    File::Hotfolder->new( @_ % 2 ? (watch => @_) : @_ );
}

# object interface
sub new {
    my ($class, %args) = @_;

    my $path = $args{watch} // '';
    $path = File::Spec->rel2abs($path) if $args{fullname};
    croak "Missing watch directory: $path" unless -d $path,

    my $self = bless {
        inotify  => (Linux::Inotify2->new
                    or croak "Unable to create new inotify object: $!"),
        callback => ($args{callback} || sub { 1 }),
        delete   => !!$args{delete},
        print    => 0+($args{print} || 0),
        filter   => $args{filter},
        scan     => $args{scan},
        catch    => $args{catch},
    }, $class;

    $self->{catch} //= sub { } if ($self->{print} & CATCH_ERROR);

    $self->watch_recursive( $path );

    $self;
}

sub watch_recursive {
    my ($self, $path) = @_;

    find({
        no_chdir => 1,
        wanted => sub {
            if (-d $_) {
                $self->watch_directory($_);
            } elsif( $self->{scan} ) {
                # TODO: check if not open or modified (lsof or fuser)
                $self->_callback($_);
            }
        },
    }, $path );
}

sub watch_directory {
    my ($self, $path) = @_;

    unless (-d $path) {
        warn "missing watch directory: $path\n";
        return;
    }

    say "watching $path" if ($self->{print} & WATCH_DIR);

    unless ( $self->inotify->watch(
        $path,
        IN_CREATE | IN_CLOSE_WRITE | IN_MOVE | IN_DELETE | IN_DELETE_SELF | IN_MOVE_SELF,
        sub {
            my $e = shift;
            my $path  = $e->fullname;

            warn "event queue overflowed\n" if $e->IN_Q_OVERFLOW;

            if ( $e->IN_ISDIR ) {
                if ( $e->IN_CREATE || $e->IN_MOVED_TO) {
                    $self->watch_recursive($path);
                } elsif ( $e->IN_DELETE_SELF || $e->IN_MOVE_SELF ) {
                    say "unwatching $path" if ($self->{print} & WATCH_DIR);
                    $e->w->cancel;
                }
            } elsif ( $e->IN_CLOSE_WRITE || $e->IN_MOVED_TO ) {
                $self->_callback($path);
            }

        }
    ) ) {
        warn "watching $path failed: $!\n";
    };
}

sub _callback {
    my ($self, $path) = @_;

    if ($self->{filter} && $path !~ $self->{filter}) {
        return;
    }

    say $path if ($self->{print} & FOUND_FILE);

    my $delete;
    if ($self->{catch}) {
        $delete = eval { $self->{callback}->($path) };
        if ($@) {
            print "$path: $@" if $self->{print} & CATCH_ERROR;
            $self->{catch}->($path, $@);
            return;
        }
    } else {
        $delete = $self->{callback}->($path);
    }

    if ( $delete && $self->{delete} ) {
        say $path if ($self->{print} & DELETE_FILE);
        unlink $path;
    }
}

sub inotify {
    $_[0]->{inotify};
}

sub loop {
    1 while $_[0]->inotify->poll;
}

sub anyevent {
    my $inotify = $_[0]->inotify;
    AnyEvent->io (
        fh => $inotify->fileno, poll => 'r', cb => sub { $inotify->poll }
    );
}

1;
__END__