File Coverage

blib/lib/IO/Lambda/Inotify.pm

Criterion	Covered	Total	%
statement	91	107	85.0
branch	27	50	54.0
condition	11	18	61.1
subroutine	19	22	86.3
pod	2	6	33.3
total	150	203	73.8

package IO::Lambda::Inotify;

use strict;
use warnings;
use IO::Handle;
use IO::Lambda qw(:all :dev);
use Linux::Inotify2;
use base qw(Exporter);
our $VERSION = '1.01';
our @EXPORT_OK = qw(
	inotify
	inotify_server
	inotify_auto
	inotify_timeout
	inotify_plain
);
our %EXPORT_TAGS = ( all => [ qw(inotify) ] );
our $INOTIFY;

our $DEBUG = $IO::Lambda::DEBUG{inotify} || 0;

sub inotify_one_server
{
	my ($inotify, $fh) = @_;

        unless ($fh) {
	        open $fh, "<&", $inotify-> fileno or die "can't dup inotify handle:$!";
        }

	$inotify-> blocking(0);

	lambda {
		context $fh;
		readable {
			$inotify-> poll;
			if ($inotify-> {io_lambda_condvar}) {
				$inotify-> {io_lambda_condvar}-> terminate;
				delete $inotify-> {io_lambda_condvar};
			}
			again;
		}
	}
}

sub inotify_server
{
	my @k = @_;
	lambda {
		context map { inotify_one_server $_ } @k;
		&tails();
	};
}

sub inotify
{
	return inotify_auto(@_) unless $_[0] and ref($_[0]) and $_[0]->isa('Linux::Inotify2');
	return inotify_timeout(@_) if 4 == @_ and defined $_[3];
	return inotify_plain(@_);
}

sub inotify_plain
{
	my ( $inotify, $path, $flags ) = @_;

	my @queue;
	my $watch = $inotify-> watch( $path, $flags, sub {
		my $event = shift;
		push @queue, $event || $!;
		if ( $DEBUG ) {
			if ( $event ) {
				warn "event $inotify.". $event-> w . " $event\n" if $DEBUG;
			} else {
				warn "event on $inotify failed :$!\n" if $DEBUG;
			}
		}
	} );

	unless ( $watch ) {
		my $error = $!;
		warn "$inotify.watch($path,$flags) = $error\n" if $DEBUG;
		return lambda { (undef, $error) };
	}

	warn "new $watch\n" if $DEBUG;

	unless ( $inotify-> {io_lambda_server} ) {
	        my $fh;
		warn "auto-start $inotify\n" if $DEBUG;
                unless ( open $fh, , "<&", $inotify-> fileno) {
                        my $error = $!;
                        $watch-> cancel;
                        return lambda{ (undef, "can't dup inotify handle:$error") };
                }
		$inotify-> {io_lambda_server} = inotify_one_server($inotify);
		$inotify-> {io_lambda_server}-> start;
	}
	$inotify-> {io_lambda_refcnt}++;

	my $scope_exit = bless sub {
		warn "auto-cancel $watch\n" if $DEBUG;

		unless (--$inotify-> {io_lambda_refcnt}) {
			warn "auto-stop $inotify\n" if $DEBUG;
			$inotify-> {io_lambda_server}-> terminate;
			undef $inotify-> {io_lambda_server};
		}
		$watch-> cancel;
	}, __PACKAGE__;


	# this lambda will be called on again and again
	return lambda {
		unless ( $watch-> {inotify} ) {
			warn "$watch was cancelled\n" if $DEBUG;
			return undef, 'watcher is expired';
		}

		my $scope_keeper = $scope_exit;

		my $listener = $inotify-> {io_lambda_condvar} //= lambda {};
		$listener-> bind;
		context $listener;
		tail {
			unless (@queue) {
				this-> start;
				return; # not our watcher
			}

			my $event = shift @queue;
			warn "[$event]\n" if $DEBUG;
			return ref($event) ? ($event) : (undef, $event);
		}
	}
}

sub inotify_auto
{
	my @stuff = @_;

	$INOTIFY ||= Linux::Inotify2-> new;
	unless ( $INOTIFY ) {
		my $error = $!;
		warn "Linux::Inotify2-> new(): $error\n" if $DEBUG;
		return lambda { (undef, $error) };
	}

	return inotify( $INOTIFY, @stuff );
}

sub inotify_timeout
{
	my ( $inotify, $path, $flags, $timeout ) = @_;

	my $watch = inotify_plain($inotify, $path, $flags);

	return lambda {
		context $watch;
		tail    { this-> terminate; return @_ };

		context $timeout;
		timeout { this-> terminate; return undef, 'timeout' };
	}
}

sub DESTROY { shift-> () }

1;

__DATA__