File Coverage

blib/lib/File/Hotfolder.pm

Criterion	Covered	Total	%
statement	29	111	26.1
branch	0	62	0.0
condition	0	39	0.0
subroutine	10	32	31.2
pod	4	7	57.1
total	43	251	17.1

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

our $VERSION = '0.06';

use Carp;
use File::Find;
use File::Spec;
use File::Basename qw(basename);
use Linux::Inotify2;
use Scalar::Util qw(blessed);

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

use constant {
    WATCH_DIR   => 1,
    UNWATCH_DIR => 2,
    FOUND_FILE  => 4,
    KEEP_FILE   => 8,
    DELETE_FILE => 16,
    CATCH_ERROR => 32,
    WATCH_ERROR => 64,
    HOTFOLDER_ALL => 128-1,
    HOTFOLDER_ERROR => 32 | 64,
};

# 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},
        fork       => !!$args{fork},
        print      => 0+($args{print} || 0),
        filter     => _build_filter($args{filter},
                                    sub { $_[0] !~ qr{^(.*/)?\.[^/]*$} }),
        filter_dir => _build_filter($args{filter_dir}, qr{^[^.]|^.$}),
        scan       => $args{scan},
        catch      => _build_catch($args{catch}),
        logger     => _build_logger($args{logger}),
        event_mask => ($args{event_mask} || ( IN_CLOSE_WRITE | IN_MOVED_TO )),
    }, $class;

    $self->watch_recursive( $path, 1 );

    $self;
}

sub _build_catch {
    my ($catch) = @_;
    return $catch if ref $catch // '' eq 'CODE';
    return $catch ? sub { } : undef;
}

sub _build_filter {
    my $filter = $_[0] // $_[1];
    return unless $filter;
    return sub { $_[0] =~ $filter } if ref $filter eq ref qr//;
    $filter;
}

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

    my $args = {
        no_chdir => 1,
        wanted => sub {
            if (-d $_) {
                $self->_watch_directory($_);
            } elsif( !$is_root || $self->{scan} ) {
                # TODO: check if not open or modified (lsof or fuser)
                $self->_callback($_);
            }
        },
    };

    if ($self->{filter_dir}) {
        return unless $self->{filter_dir}->(basename($path));
        $args->{preprocess} = sub {
            grep { $self->{filter_dir}->($_) } @_
        };
    }

    find( $args, $path );
}

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

    $self->log( WATCH_DIR, $path );

    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;

            if ( $e->IN_Q_OVERFLOW ) {
                $self->log( WATCH_ERROR, $path, "event queue overflowed" );
            }

            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 ) {
                    $self->log( UNWATCH_DIR, $path );
                    $e->w->cancel;
                }
            } elsif ( $e->mask & $self->{event_mask} ) {
                $self->_callback($path);
            }

        }
    ) ) {
        $self->log( WATCH_ERROR, $path, "failed to create watch: $!" );
    };
}

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

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

    my $fork = $self->{fork} ? fork : undef;
    return if $fork; # parent

    $self->log( FOUND_FILE, $path );

    my $status;
    if ($self->{catch}) {
        $status = eval { $self->{callback}->($path) };
        if ($@) {
            $self->log( CATCH_ERROR, $path, $@ );
            $self->{catch}->($path, $@);
            return;
        }
    } else {
        $status = $self->{callback}->($path);
    }

    if ( $status && $self->{delete} ) {
        unlink $path;
        $self->log( DELETE_FILE, $path );
    } else {
        $self->log( KEEP_FILE, $path );
    }

    exit if (defined $fork and !$fork); # child
}

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

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

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

## LOGGING

our %LOGS = (
    WATCH_DIR   , "watching %s",
    UNWATCH_DIR , "unwatching %s",
    FOUND_FILE  , "found %s",
    KEEP_FILE   , "keep %s",
    DELETE_FILE , "delete %s",
    CATCH_ERROR , "error %s",
    WATCH_ERROR , "failed %s",
);

sub _build_logger {
    my ($logger) = @_;

    if ( not defined $logger ) {
        sub {
            my (%args) = @_;
            my $fh = $args{event} & HOTFOLDER_ERROR ? *STDERR : *STDOUT;
            say $fh $args{message};
        }
    } elsif (blessed $logger && $logger->can('log')) {
        sub {
            my (%args) = @_;
            $logger->log(
                level   => $args{event} & HOTFOLDER_ERROR ? 'error' : 'info',
                message => $args{message}
            );
        }
    } elsif (ref $logger // '' eq 'CODE') {
        $logger;
    } else {
        croak "logger must be code or provide a log method!";
    }
}

sub log {
    my ($self, $event, $path, $error) = @_;
    if ( $event & $self->{print} ) {
        $self->{logger}->(
            event   => $event,
            path    => $path,
            message => sprintf($LOGS{$event}, $path),
        );
    }
}

1;
__END__