Filesys::Notify::KQueue

KQueue.pm

package Filesys::Notify::KQueue;
use strict;
use warnings;

use File::Find;
use IO::File;
use IO::KQueue;
use List::MoreUtils qw/any/;

sub new {
    my $class = shift;
    my $self  = bless(+{} => $class);

    $self->add(@_) if(@_);

    return $self;
}

sub kqueue {
    my $self = shift;
    $self->{_kqueue} ||= IO::KQueue->new;
}

sub timeout {
    my $self = shift;
    (@_ == 1) ? ($self->{_timeout} = shift) : $self->{_timeout};
}

sub add {
    my $self = shift;

    foreach my $path (@_) {
        next if exists($self->{_files}{$path});
        if (-f $path) {
            $self->add_file($path);
        }
        elsif (-d $path) {
            $self->add_dir($path);
        }
        else {
            die "Unknown file '$path'";
        }
    }
}

sub add_file {
    my($self, $file) = @_;

    $self->{_files}{$file} = do {
        my $fh = IO::File->new($file, 'r') or die("Can't open '$file': $!");
        die "Can't get fileno '$file'" unless defined $fh->fileno;

        # add to watch
        $self->kqueue->EV_SET(
            $fh->fileno,
            EVFILT_VNODE,
            EV_ADD | EV_CLEAR,
            NOTE_DELETE | NOTE_WRITE | NOTE_RENAME | NOTE_REVOKE,
            0,
            $file,
        );

        $fh;
    };
}

sub add_dir {
    my($self, $dir) = @_;

    $self->{_files}{$dir} = do {
        my $fh = IO::File->new($dir, 'r') or die("Can't open '$dir': $!");
        die "Can't get fileno '$dir'" unless defined $fh->fileno;

        # add to watch
        $self->kqueue->EV_SET(
            $fh->fileno,
            EVFILT_VNODE,
            EV_ADD | EV_CLEAR,
            NOTE_DELETE | NOTE_WRITE | NOTE_RENAME | NOTE_REVOKE,
            0,
            $dir,
        );

        $fh;
    };

    find(+{
        wanted => sub { $self->add($File::Find::name) },
        no_chdir => 1,
    }, $dir);
}

sub files { keys %{shift->{_files}} }

sub wait {
    my ($self, $cb) = @_;
    $self->kqueue->kevent($self->timeout);

    while (1) {
        my $events = $self->get_events;
        $cb->(@$events) if(@$events);
    }
}

sub get_events {
    my $self = shift;

    my @kevents = $self->kqueue->kevent($self->timeout);

    my @events;
    foreach my $kevent (@kevents) {
        my $path  = $kevent->[KQ_UDATA];
        my $flags = $kevent->[KQ_FFLAGS];

        if ($flags & NOTE_DELETE) {
            delete($self->{_files}{$path});
            push(@events,  +{
                event => 'delete',
                path  => $path,
            });
        }
        elsif($flags & NOTE_RENAME) {
            push(@events, +{
                event => 'rename',
                path  => $path,
            });
            if (-d $path) {
                foreach my $stored_path ( $self->files ) {
                    next if $stored_path !~ /^$path/;
                    delete($self->{_files}{$stored_path});
                    push(@events, +{
                        event => 'rename',
                        path  => $path,
                    });
                }
            }
        }
        elsif ($flags & NOTE_WRITE) {
            if (-f $path) {
                push(@events, +{
                    event => 'modify',
                    path  => $path,
                });
            }
            elsif (-d $path) {
                find(+{
                    wanted => sub {
                        return if any { $File::Find::name eq $_ } $self->files;
                        push(@events, +{
                            event => 'create',
                            path  => $File::Find::name,
                        });
                        $self->add($File::Find::name);
                    },
                    no_chdir => 1,
                }, $path);
            }
        }
    }

    return \@events;
}

1;
__END__

test.pl

use strict;
use warnings;

use Filesys::Notify::KQueue;
use Data::Dumper;

my $kqueue = Filesys::Notify::KQueue->new('testdir');
$kqueue->timeout(1);
$kqueue->wait(sub {
    warn Dumper \@_;
});