File Coverage

blib/lib/POEx/DirNotify.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

## $Id$
#####################################################################
package POEx::DirNotify;

use 5.008008;
use strict;
use warnings;

our $VERSION = '0.02_00';
$VERSION = eval $VERSION;  # see L

use POE;
use POE::Session::PlainCall;

use Digest::MurmurHash qw( murmur_hash );
use Storable qw( dclone );
use POSIX qw( sigaction );
use Fcntl qw/F_NOTIFY O_RDONLY
            DN_CREATE DN_ACCESS DN_MODIFY DN_RENAME
            DN_DELETE DN_ATTRIB DN_MULTISHOT
           /;

sub DEBUG () { 0 }

#############################################
sub spawn
{
    my( $package, %init ) = @_;

    my $options = delete $init{options};
    $options ||= {};

    POE::Session::PlainCall->create(
                    package   => $package,
                    ctor_args => [ \%init ],
                    options   => $options,
                    states    => [ qw( _start _stop shutdown
                                       monitor unmonitor
                                       sig_notify
                                 ) ]
                );

}

#############################################
sub new
{
    my( $package, $args ) = @_;

    my $self = bless {
                       path=>{}         # path => $notifies
                     }, $package;
    $self->{alias} = $args->{alias} || 'dnotify';
    return $self;
}


#############################################
sub _start
{
    my( $self ) = @_;
    poe->kernel->alias_set( $self->{alias} );
    poe->kernel->sig( IO => 'sig_notify' );
    poe->kernel->sig( shutdown => 'shutdown' );
}

#############################################
sub _stop
{
}


#############################################
sub sig_notify
{
    my( $self, $signame ) = @_;
    DEBUG and warn "Notify $signame";
    poe->kernel->sig_handled;
    foreach my $event ( $self->_find_changes ) {
        DEBUG and warn "Call @$event";
        poe->kernel->post( @$event );
    }
}

#############################################
sub _find_path
{
    my( $self, $path ) = @_;
    return $self->{path}{ $path };
}


sub _build_details
{
    my( $self, $path ) = @_;
    my @stat = stat $path;
    return 0 unless @stat;
    $stat[11] = 0;
    $stat[12] = 0;
    return murmur_hash( join '-', @stat );
}

#############################################
sub _find_changes
{
    my( $self ) = @_;
    my @ret;
    foreach my $notify ( values %{ $self->{path} } ) {
        my $details = $self->_build_details( $notify->{path} );
        my $op = 'change';
        $op = 'delete' unless $details;
        if( $details ne $notify->{details} ) {
            foreach my $event ( @{ $notify->{call} } ) {
                my $E = dclone $event;
                $E->[2] = { op=>$op,
                            path=>$notify->{path}
                          };
                push @ret, $E;
            }
        }
    }
    return @ret;
}

#############################################
sub monitor
{
    my( $self, $args ) = @_;
    my $path = $args->{path};
    my $caller = join ' ', at => poe->caller_file,
                               line => poe->caller_line;

    my $flags = DN_MODIFY|DN_CREATE|DN_RENAME|DN_DELETE|DN_ATTRIB|DN_MULTISHOT; # XXX

    my $call = $self->_build_call( $args );

    my $notify = $self->_find_path( $path );
    if( $notify ) {
        DEBUG and warn "Monitor $path again\n";
        push @{ $notify->{call} }, $call;
        poe->kernel->refcount_increment( poe->sender, "NOTIFY $path" );
        return 1;
    }


    unless( -d $path ) {
        die "$path isn't a directory $caller\n";
    }

    DEBUG and warn "Monitor $path\n";

    my $details = $self->_build_details( $path );

    $notify = {
                path => $path,
                call => [ $call ],
                details => $details,
                fd   => undef,
            };

    $self->{path}{$path} = $notify;

    my $fd;
    sysopen( $fd, $path, O_RDONLY ) or die "sysopen $path: $! $caller\n";
    fcntl( $fd, F_NOTIFY, $flags ) or warn "fcntl F_NOTIFY: $!";

    $notify->{fd} = $fd;
    poe->kernel->refcount_increment( poe->session->ID, "NOTIFY $path" );
    poe->kernel->refcount_increment( poe->sender, "NOTIFY $path" );

    return 1;
}

sub _build_call
{
    my( $self, $args ) = @_;
    my $event = $args->{event};
    my $A     = $args->{args};
    my $session = poe->sender;

    my $call = [ $session, $event, undef ];
    if( $A ) {
        $A = dclone $A if ref $A;
        if( 'ARRAY' eq ref $A ) {
            push @$call, @$A;
        }
        else {
            push @$call, $A;
        }
    }
    return $call;
}


#############################################
sub unmonitor
{
    my( $self, $args ) = @_;
    my $path = $args->{path};
    my $session = poe->sender;
    my $caller = join ' ', at => poe->caller_file,
                               line => poe->caller_line;
    my $notify = $self->_find_path( $path );
    unless( $notify ) {
        warn "$path wasn't monitored $caller\n";
        return;
    }

    my @calls;
    foreach my $call ( @{ $notify->{call} } ) {
        if( $call->[0] eq $session or $self->{force} ) {
            poe->kernel->refcount_decrement( $session, "NOTIFY $notify->{path}" );
        }
        else {
            push @calls, $call;
        }
    }

    if( @calls ) {
        $notify->{call} = \@calls;
        DEBUG and warn "$path still being monitored\n";
        return;
    }
    DEBUG and warn "Unmonitor $path\n";

    fcntl( $notify->{fd}, F_NOTIFY, 0 ) or warn "fcntl F_NOTIFY: $! $caller\n";

    poe->kernel->refcount_decrement( poe->session->ID, "NOTIFY $notify->{path}" );
    delete $notify->{fd};
    delete $self->{path}{ $path };
    return;
}

#############################################
sub shutdown
{
    my( $self ) = @_;
    DEBUG and warn "Shutdown $self->{alias}\n";
    foreach my $path ( keys %{ $self->{path} } ) {
        local $self->{force} = 1;
        $self->unmonitor( { path=>$path } );
    }
}




1;
__END__