The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
## $Id$
#####################################################################
package POEx::Inotify;

use 5.008008;
use strict;
use warnings;

our $VERSION = '0.0100';
$VERSION = eval $VERSION;  # see L<perlmodstyle>

use POE;
use POE::Session::PlainCall;
use Storable qw( dclone );

use Linux::Inotify2;

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
                                       poll inotify
                                       monitor unmonitor
                                 ) ]
                );
}


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

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

#############################################
sub _start
{
    my( $self ) = @_;
    DEBUG and warn "$self->{alias}: _start";
    poe->kernel->alias_set( $self->{alias} );
    poe->kernel->sig( shutdown => 'shutdown' );
    $self->setup_inotify;
}

#############################################
sub _stop
{
    my( $self ) = @_;
    DEBUG and warn "$self->{alias}: _stop";
}

#############################################
sub shutdown
{
    my( $self ) = @_;
    DEBUG and warn "$self->{alias}: shutdown";
    $self->{shutdown} = 1;
    foreach my $path ( keys %{ $self->{path} } ) {
        local $self->{force} = 1;
        $self->unmonitor( { path=>$path } );
    }
    poe->kernel->select_read( $self->{fh} ) if $self->{fh};
    poe->kernel->alias_remove( $self->{alias} );
    delete $self->{fh};
}

#############################################
sub build_inotify
{
    my( $self ) = @_;
    $self->{inotify} = Linux::Inotify2->new;
}

#############################################
sub setup_inotify
{
    my( $self ) = @_;
    $self->{inotify}->blocking( 0 );
    $self->{fh} = IO::Handle->new_from_fd( $self->{inotify}->fileno, "r" );
    poe->kernel->select_read( $self->{fh}, 'poll' );
}

sub add_inotify
{
    my( $self, $path, $mask ) = @_;
    DEBUG and warn sprintf "$self->{alias}: mask=%08x path=$path", $mask;
    return $self->{inotify}->watch( $path, $mask, 
                                    poe->session->callback( inotify=>$path ) );
}

#############################################
# Poll the Inotify object
sub poll
{
    my( $self ) = @_;
    return if $self->{shutdown};
    DEBUG and warn "$self->{alias}: poll";
    $self->{inotify}->poll
}

#############################################
# Callback from Inotify object
sub inotify
{
    my( $self, $N, $E ) = @_;
    my $notify = $self->_find_path( $N->[0] );
    next unless $notify;

    foreach my $e ( @$E ) {
        DEBUG and warn "$self->{alias}: inotify ", $e->fullname;
        foreach my $call ( @{ $notify->{call} } ) {
            DEBUG and do {
                warn sprintf "$self->{alias}: %08x vs %08x", $e->mask, $call->{tmask};
                foreach my $flag ( qw( ACCESS MODIFY ATTRIB CLOSE_WRITE CLOSE_NOWRITE 
                       OPEN MOVED_FROM MOVED_TO CREATE DELETE DELETE_SELF
                       MOVE_SELF ALL_EVENTS ONESHOT ONLYDIR DONT_FOLLOW
                       MASK_ADD CLOSE MOVE ) ) {
                    my $method = "IN_$flag";
                    warn "$self->{alias}: $flag" if $e->$method();
                }
            };
            
            next unless $e->mask & $call->{tmask};

            my $CB = dclone $call->{cb};
            $CB->[2] = $e;
            poe->kernel->call( @$CB );
        }
    }
}

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


sub _build_call
{
    my( $self, $args ) = @_;
    my $event = $args->{event};
    return "No event specified" unless $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 { cb   => $call, 
             mask => $args->{mask},                     # user specified mask
             tmask => $self->_const2mask( $args ),      # true mask
           };
}

sub _const2mask
{
    my( $self, $args ) = @_;
    my $mask = $args->{mask}; 
    if( -f $args->{path} and $mask | IN_DELETE ) {
        $mask |= IN_DELETE_SELF;    # IN_DELETE is useless on a file
    }
    return $mask;
}

#############################################
sub monitor
{
    my( $self, $args ) = @_;
    return if $self->{shutdown};

    my $path = $args->{path};
    my $caller = join ' ', at => poe->caller_file,
                               line => poe->caller_line;
    $args->{mask} = IN_ALL_EVENTS unless defined $args->{mask};

    my $notify = $self->_find_path( $path );
    my $in_mask = $args->{mask};
    if( $notify ) {
        $in_mask |= $notify->{mask};
    }

    my $watch = $self->add_inotify( $path, $in_mask );

    my $call = $self->_build_call( $args, $watch );
    die "Unable to build call: $call $caller" unless ref $call;

    if( $notify ) {
        DEBUG and warn "$self->{alias}: monitor $path again";
        push @{ $notify->{call} }, $call;
        $notify->{watch} = $watch;
    }
    else {
        DEBUG and warn "$self->{alias}: monitor $path";

        unless( $watch ) {
            die "Unable to watch $path: $! $caller";
        }

        $notify = {
                    path => $path,
                    call => [ $call ],
                    mask => $args->{mask},
                    watch => $watch
                };
        $self->{path}{$path} = $notify;
        poe->kernel->refcount_increment( poe->session->ID, "NOTIFY $path" );
    }

    poe->kernel->refcount_increment( poe->sender, "NOTIFY $path" );

    return;
}

sub unmonitor
{
    my( $self, $args ) = @_;
    my $path = $args->{path};
    $args->{mask} = 0xFFFFFFFF unless defined $args->{mask};
    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 $changed = 0;
    my @calls;
    foreach my $call ( @{ $notify->{call} } ) {
        if( $self->{force} or ( $call->{cb}[0] eq $session 
                                    and $call->{mask} == $args->{mask} ) ) {
            poe->kernel->refcount_decrement( $session, "NOTIFY $path" );
            $changed = 1;
        }
        else {
            push @calls, $call;
        }
    }
    $notify->{call} = \@calls;
    if( @calls ) {
        if( $changed ) {
            $notify->{mask} = $self->_notify_mask( $notify );
            $self->add_inotify( $path, $notify->{mask} );
        }
        
        DEBUG and warn "$path still being monitored\n";
    }
    else {
        DEBUG and warn "$self->{alias}: unmonitor $path";
        $notify->{watch}->cancel; 
        poe->kernel->refcount_decrement( poe->session->ID, "NOTIFY $path" );
        delete $self->{path}{ $path };
    }
    return;
}

sub _notify_mask
{
    my( $self, $notify ) = @_;
    my $mask = 0;
    foreach my $call ( @{ $notify->{call} } ) {
        $mask |= $call->{mask};
    }
    return $mask;
}

1;


__END__

=head1 NAME

POEx::Inotify - inotify interface for POE

=head1 SYNOPSIS

    use strict;

    use POE;
    use POEx::Inotify;

    POEx::Inotify->new( alias=>'notify' );

    POE::Session->create(
        package_states => [ 
                'main' => [ qw(_start notification) ],
        ],
    );

    $poe_kernel->run();
    exit 0;

    sub _start {
        my( $kernel, $heap ) = @_[ KERNEL, HEAP ];

        $kernel->post( 'notify' => monitor => {
                path => '.',
                mask  => IN_CLOSE_WRITE,
                event => 'notification',
                args => [ $args ]
             } );
        return;  
    }

    sub notification {
        my( $kernel, $e, $args ) = @_[ KERNEL, ARG0, ARG1];
        print "File ready: ", $e->fullname, "\n";
        $kernel->post( notify => 'shutdown' );
        return;
    }

=head1 DESCRIPTION

POEx::Inotify is a simple interface to the Linux file and directory change
notification interface, also called C<inotify>.

It can monitor an existing directory for new files, deleted files, new
directories and more.  It can monitor an existing file to see if it changes,
is deleted or moved.

=head1 METHODS

=head2 spawn

    POEx::Inotify->spawn( %options );

Creates the C<POEx::Inotify> session.  It takes a number of arguments, all
of which are optional.

=over 4

=item alias

The session alias to register with the kernel.  Defaults to C<inotify>.

=item options

A hashref of POE::Session options that are passed to the component's 
session creator.

=back




=head1 EVENTS

=head2 monitor

    $poe_kernel->call( inotify => 'monitor', $arg );

Starts monitoring the specified path for the specified types of changes.

Accepts one argument, a hashref containing the following keys: 

=over 4

=item path

The filesystem path to the directory to be monitored.  Mandatory.

=item mask

A mask of events that you wish to monitor.  May be any of the following constants
(exported by L<Linux::Inotify2>) ORed together.  Defaults to C<IN_ALL_EVENTS>.

=back

=over 8

=item IN_ACCESS

object was accessed

=item IN_MODIFY

object was modified

=item IN_ATTRIB

object metadata changed

=item IN_CLOSE_WRITE

writable fd to file / to object was closed

=item IN_CLOSE_NOWRITE

readonly fd to file / to object closed

=item IN_OPEN

object was opened

=item IN_MOVED_FROM

file was moved from this object (directory)

=item IN_MOVED_TO

file was moved to this object (directory)

=item IN_CREATE

file was created in this object (directory)

=item IN_DELETE

file was deleted from this object (directory)

=item IN_DELETE_SELF

object itself was deleted

=item IN_MOVE_SELF

object itself was moved

=item IN_ALL_EVENTS

all of the above events


=item IN_ONESHOT

only send event once

=item IN_ONLYDIR

only watch the path if it is a directory

=item IN_DONT_FOLLOW

don't follow a sym link

=item IN_MASK_ADD

not supported with the current version of this module

=item IN_CLOSE

same as IN_CLOSE_WRITE | IN_CLOSE_NOWRITE

=item IN_MOVE

same as IN_MOVED_FROM | IN_MOVED_TO

=back

=over 4

=item event

The name of the event handler in the current session to post changes back
to.  Mandatory.

The event handler will receive an L<Linux::Inotify2::Event> as its first argument.  Other
arguments are the L</args>.

=item args

An arrayref of arguments that will be passed to the event handler.

=back


=head3 Example

    use Linux::Inotify2;

    my $dir = '/var/ftp/incoming';

    my $arg = {
            path => $path
            mask => IN_DELETE|IN_CLOSE,
            event => 'uploaded',
            args  => [ $dir ]
        };
    $poe_kernel->call( inotify => 'monitor', $arg );

    sub uploaded 
    {
        my( $e, $path ) = @_[ARG0, ARG1];
        warn $e->fullname, " was uploaded to $path";
    }

=head2 unmonitor

    $poe_kernel->call( inotify => 'unmonitor', $arg );

Ends monitoring of the specified path for the current session.

Accepts one argument, a hashref containing the following keys: 

=over 4

=item path

The filesystem path to the directory to be unmonitored.  Mandatory.

=back

=head3 Note

Multiple sessions may monitor the same path at the same time.  A single
session may monitor multiple paths.  However, if a single session is
monitoring the same path multiple times, care must be taken when
unmonitoring.  For instance, if you have one monitor on C<IN_ALL_EVENTS> and
another on C<IN_DELETE>, then unmonitoring C<IN_DELETE> will prevent any
C<IN_DELETE> event from getting to the first monitor.


=head2 shutdown

    $poe_kernel->call( inotify => 'shutdown' );
    # OR
    $poe_kernel->signal( $poe_kernel => 'shutdown' );
 
Shuts down the component gracefully. All monitored paths will be closed. Has
no arguments.


=head1 SEE ALSO

L<POE>, L<Linux::Inotify2>.

This module's API was heavily inspired by
L<POE::Component::Win32::ChangeNotify>.

=head1 AUTHOR

Philip Gwyn, E<lt>gwyn -at- cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Philip Gwyn.  All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut