File Coverage

blib/lib/AnyEvent/Filesys/Watcher.pm

Criterion	Covered	Total	%
statement	151	172	87.7
branch	60	84	71.4
condition	14	30	46.6
subroutine	31	32	96.8
pod	5	5	100.0
total	261	323	80.8

#! /bin/false

# This next lines is here to make Dist::Zilla happy.
# ABSTRACT: Watch file system for changes

package AnyEvent::Filesys::Watcher;

use strict;

our $VERSION = 'v0.1.1'; # VERSION

use Locale::TextDomain ('AnyEvent-Filesys-Watcher');
use Scalar::Util qw(reftype);
use Path::Iterator::Rule;
use File::Spec;
use Cwd;
use Scalar::Util qw(reftype);

use AnyEvent::Filesys::Watcher::Event;

# This constructor is kind of doing reversed inheritance.  It first sets up
# the module, then selects a backend which is then instantiated.  The
# backend is expected to invoke the protected constructor _new() below.
#
# Using the factory pattern would be the cleaner approach but we want to
# retain a certain compatibility with the original AnyEvent::Filesys::Notify,
# because the module is easier to use that way.
sub new {
	my ($class, %args) = @_;

	my $backend_class = $args{backend};

	if (exists $args{cb} && !exists $args{callback}) {
		$args{callback} = delete $args{cb};
	}

	if (exists $args{dirs} && !exists $args{directories}) {
		$args{directories} = delete $args{dirs};
	}

	if ($backend_class) {
		# Use the AEFW:: prefix unless the backend starts with a plus.
		unless ($backend_class =~ s/^\+//) {
			$backend_class = "AnyEvent::Filesys::Watcher::"
				. $backend_class;
		}
	} elsif ($^O eq 'linux') {
		$backend_class = 'AnyEvent::Filesys::Watcher::Inotify2';
	} elsif ($^O eq 'darwin') {
		$backend_class = "AnyEvent::Filesys::Watcher::FSEvents";
	} elsif ($^O eq 'MSWin32') {
		$backend_class = "AnyEvent::Filesys::Watcher::ReadDirectoryChanges";
	} elsif ($^O =~ /bsd/) {
		$backend_class = "AnyEvent::Filesys::Watcher::KQueue";
	} else {
		$backend_class = "AnyEvent::Filesys::Watcher::Fallback";
	}

	my $backend_module = $backend_class . '.pm';
	$backend_module =~ s{::}{/}g;

	my $self;
	eval {
		require $backend_module;
		$self = $backend_class->new(%args);
	};
	if ($@) {
		if ($@ =~ /^Can't locate $backend_module in \@INC/) {
			warn __x(<<"EOF", class => $backend_class);
Missing backend module '{class}'!
You either have to install it or specify 'Fallback' as the backend but that is
not very efficient.

Original error message:
EOF
		}

		die $@;
	}

	return $self;
}

sub _new {
	my ($class, %args) = @_;

	my $self = bless {}, $class;

	# Resolve aliases once more.  This is necessary so that the backend classes
	# can be instantiated directly.
	if (exists $args{dirs} && !exists $args{directories}) {
		$args{directories} = delete $args{dirs};
	}

	if (exists $args{cb} && !exists $args{callback}) {
		$args{callback} = delete $args{cb};
	}

	if (!exists $args{callback}) {
		require Carp;
		Carp::croak(__"The option 'callback' is mandatory");
	}

	if (reftype $args{callback} ne 'CODE') {
		require Carp;
		Carp::croak(__"The argument to 'callback' must be a code reference");
	}

	if (exists $args{raw_events} && reftype $args{raw_events} ne 'CODE') {
		require Carp;
		Carp::croak(__"The argument to 'raw_events' must be a code reference");
	}

	if (!exists $args{base_dir}) {
		$args{base_dir} = Cwd::cwd();
	}

	if (!exists $args{directories}) {
		$args{directories} = $args{base_dir};
	}

	$args{interval} = 1 if !exists $args{interval};
	$args{directories} = [$args{directories}]
		if !ref $args{directories};
	if (exists $args{filter}
	    && defined $args{filter}
	    && length $args{filter}) {
		$args{filter} = $self->__compileFilter($args{filter});
	} else {
		$args{filter} = sub { 1 };
	}

	foreach my $arg (keys %args) {
		$self->{'__' . $arg} = $args{$arg};
	}

	$self->_oldFilesystem($self->_scanFilesystem($self->directories));

	return $self;
}

sub directories {
	my ($self) = @_;

	return [@{$self->{__directories}}];
}

sub interval {
	shift->{__interval};
}

sub callback {
	my ($self, $cb) = @_;

	if (@_ > 1) {
		$self->{__callback} = $cb;
	}

	return $self->{__callback};
}

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

	if (@_ > 1) {
		$self->{__filter} = $self->__compileFilter($filter);
	}

	return $self->{__filter};
}

# Taken from AnyEvent::Filesys::Notify.
sub _scanFilesystem {
	my ($self, @args) = @_;

	# Accept either an array of directories or an array reference of
	# directories.
	my @paths = ref $args[0] eq 'ARRAY' ? @{ $args[0] } : @args;

	my $fs_stats = {};

	my $rule = Path::Iterator::Rule->new;
	my $next = $rule->iter(@paths);
	while (my $file = $next->()) {
		my $path = $self->_makeAbsolute($file);
		my %stat = $self->_stat($path)
			or next; # Skip files that we cannot stat.
		$fs_stats->{$path} = \%stat;
	}

	return $fs_stats;
}

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

	$path = File::Spec->rel2abs($path, $self->{__base_dir});
	if ('MSWin32' eq $^O || 'cygwin' eq $^O || 'os2' eq $^O || 'dos' eq $^O) {
		# This is what Cwd does.
		$path =~ s{\\}{/}g;
	}

	return $path;
}

# Taken from AnyEvent::Filesys::Notify.
sub _diffFilesystem {
	my ($self, $old_fs, $new_fs) = @_;
	my @events = ();

	for my $path (keys %$old_fs) {
		if (not exists $new_fs->{$path}) {
			push @events,
				AnyEvent::Filesys::Watcher::Event->new(
					path => $path,
					type => 'deleted',
					is_directory => $old_fs->{$path}->{is_directory},
				);
		} elsif ($self->__isPathModified($old_fs->{$path}, $new_fs->{$path})) {
			push @events,
				AnyEvent::Filesys::Watcher::Event->new(
					path => $path,
					type => 'modified',
					is_directory => $old_fs->{$path}->{is_directory},
			);
		}
	}

	for my $path (keys %$new_fs) {
		if (not exists $old_fs->{$path}) {
			push @events,
				AnyEvent::Filesys::Watcher::Event->new(
					path => $path,
					type => 'created',
					is_directory => $new_fs->{$path}->{is_directory},
				);
		}
	}

	return @events;
}

sub _filesystemMonitor {
	my ($self, $value) = @_;

	if (@_ > 1) {
		$self->{__filesystem_monitor} = $value;
	}

	return $self->{__filesystem_monitor};
}

sub _watcher {
	my ($self, $watcher) = @_;

	if (@_ > 1) {
		$self->{__watcher} = $watcher;
	}

	return $self->{__watcher};
}

sub _processEvents {
	my ($self, @raw_events) = @_;

	if ($self->{__raw_events}) {
		@raw_events = $self->{__raw_events}->(@raw_events);
	}

	my @events = $self->_parseEvents(
		sub { $self->_applyFilter(@_) },
		@raw_events
	);

	if (@events) {
		$self->_postProcessEvents(@events);
		$self->callback->(@events) if @events;
	}

	return \@events;
}

sub _parseEvents {
	shift->_rescan;
}

sub _rescan {
	my ($self) = @_;

	my $new_fs = $self->_scanFilesystem($self->directories);

	my @events = $self->_applyFilter(
		$self->_diffFilesystem($self->_oldFilesystem, $new_fs));
	$self->_oldFilesystem($new_fs);

	return @events;
}

# Some backends need to add files (KQueue) or directories (Inotify2) to the
# watch list after they are
sub _postProcessEvents {}

sub _applyFilter {
	my ($self, @events) = @_;

	my $callback = $self->filter;
	return grep { $callback->($_) } @events;
}

sub _oldFilesystem {
	my ($self, $fs) = @_;

	if (@_ > 1) {
		$self->{__old_filesystem} = $fs;
	}

	return $self->{__old_filesystem};
}

sub _directoryWrites {
	shift->{__directory_writes};
}

sub __compileFilter {
	my ($self, $filter) = @_;

	if (!ref $filter) {
		$filter = qr/$filter/;
	}

	my $reftype = reftype $filter;
	if ('REGEXP' eq $reftype) {
		my $regexp = $filter;
		$filter = sub {
			my $event = shift;
			my $path = $event->path;
			my $result = $path =~ $regexp;
			return $result;
		};
	} elsif ($reftype ne 'CODE') {
		require Carp;
		Carp::confess(__("The filter must either be a regular expression or"
						. " code reference"));
	}

	return $filter;
}

# Originally taken from Filesys::Notify::Simple --Thanks Miyagawa
sub _stat {
	my ($self, $path) = @_;

	my @stat = stat $path;

	# Return undefined if no stats can be retrieved, as it happens with broken
	# symlinks (at least under ext4).
	return unless @stat;

	return (
		path => $path,
		mtime => $stat[9],
		size => $stat[7],
		mode => $stat[2],
		is_directory => -d _,
	);
}

# Taken from AnyEvent::Filesys::Notify.
sub __isPathModified {
	my ($self, $old_path, $new_path) = @_;

	return 1 if $new_path->{mode} != $old_path->{mode};
	return if $new_path->{is_directory};
	return 1 if $new_path->{mtime} != $old_path->{mtime};
	return 1 if $new_path->{size} != $old_path->{size};
	return;
}

1;