# Copyright (c) 2013-2014 David Caldwell.
# Copyright (c) 2014-2017 Marcel Greter.
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.

use strict;
use warnings;
use CSS::Sass;

################################################################################
package CSS::Sass::Watchdog;
our $VERSION = "3.6.3";
################################################################################

use Exporter 'import'; # gives you Exporter's import() method directly
our @EXPORT = qw(start_watchdog); # symbols to export by default

####################################################################################################
####################################################################################################

# load function from core module
use List::Util 1.45 qw(uniq);

# check if the benchmark module is available
my $benchmark = eval "use Benchmark; 1";

# declare package variables
my ($parent_pid, $child_pid) = ($$, 0);

####################################################################################################
# reset/reinit is needed to avoid a bug on windows
# version strawberry-perl-5.22.2.1-32bit-portable
# https://github.com/sass/perl-libsass/issues/33
####################################################################################################

sub reset_encoding()
{
	binmode(STDIN, ":raw");
	binmode(STDOUT, ":raw");
	binmode(STDERR, ":raw");
}

sub reinit_encoding()
{
	binmode(STDIN, ":encoding(console_in)");
	binmode(STDOUT, ":encoding(console_out)");
	binmode(STDERR, ":encoding(console_out)");
}

sub forks {
	reset_encoding();
	my $pid = fork();
	reinit_encoding();
	return $pid;
}

####################################################################################################
# the watchdog process (maybe put in own module)
####################################################################################################

# the parent is the main (current) process
# wait for events to arive to the message queue
# wait some time until we start the re-compilation
sub watchdog_parent ($$$)
{

	# Try to be smart here. We will not start the compilation after
	# each event right away. There are at least two scenarios where
	# this would be inefficient. First if a user clicks "save all"
	# in its editor, or if multiple files are copied over. We wait
	# for a certain period and only start the compilation when we
	# got no more change events.

	# get input variables
	my ($changes, $files, $compile) = @_;

	# aggregated events
	my @aggregated;

	# print delimiter line
	print '=' x 78, "\n";

	# go into endless loop
	while (1)
	{

		# check if we have something to
		# dequeue in the next seconds
		if ($changes->can_dequeue(0.25))
		{

			# dequeue a key from notifier
			my $item = $changes->dequeue();

			# wait for exit command
			exit if $item eq "stop";

			# push the real hash to the queue
			push(@aggregated, $item);

			# make aggregated list unique
			@aggregated = uniq @aggregated;

		}
		# nothing to dequeue, we waited 0.25 seconds
		# maybe we have something in our to do list
		else
		{

			# autoflush
			local $| = 1;

			# count errors
			my $beeps = 1;

			# do nothing of aggregated is empty
			next if scalar(@aggregated) == 0;

			# now call the compilation step
			my $t0 = $benchmark ? Benchmark->new : 0;
			print "compilation started\n";
			my ($css, $err, $stats) = $compile->();
			my $t1 = $benchmark ? Benchmark->new : 0;
			if (!$err) { print "sucessfully finished\n"; }
			else { print "finished with an error\n"; }

			# only print benchmark result when module is available
			if ($benchmark) { print timestr(timediff($t1, $t0)), "\n"; }

			my @includes = @{$stats->{'included_files'} || []};
			# use the simples equality test
			# should work since they are sorted
			if (!$err && "@{$files}" ne "@includes")
			{
				print "re-start file watcher\n";
				# make sure our child is terminated
				kill 9, $child_pid;
				waitpid($child_pid, 0);
				# new watch file list
				$files = \@includes;
				# start new child process
				unless ($child_pid = forks())
				{ watchdog_child($changes, $files); }
			}

			# beep more in case of errors
			$beeps += 2 if defined $err;

			# ring the bell now
			print "\a" x ($beeps);
			# clear aggregated
			undef @aggregated;
			# print delimiter line
			print '=' x 78, "\n";

		}
		# EO can dequeue

	}
	# EO endless loop

}
# EO sub watchdog_parent

# the child watches all registered files for changes
# changes will be sent to the parent via our fork queue
# the parent will decide when to start the next compilation
sub watchdog_child ($$)
{

	# get input variables
	my ($changes, $files) = @_;

	# try to load the watch module conditional
	unless (eval { require Filesys::Notify::Simple; 1 })
	{ die "module Filesys::Notify::Simple not found"; }

	# print message with watched files
	print "waiting for changes now\n";
	print map { ("  ", $_, "\n") } @{$files || []};
	# print delimiter line
	print '=' x 78, "\n";

	# create the watcher object on all filepaths
	my $watcher = Filesys::Notify::Simple->new($files);

	# go into endless loop
	while (1)
	{

		# watch for file changes
		# this will block forever
		$watcher->wait(sub
		{

			# get all events
			for my $event (@_)
			{
				# print a message when a change occurs
				printf "changed: %s\n", $event->{path};
				# get the normalized path string
				my $path = $event->{path};
				# enqueue changed file
				$changes->enqueue($path);

			}
			# EO all events

		});
		# EO wait for watcher

	}
	# EO endless loop

}
# EO sub watchdog_child

sub start_watchdog ($$)
{

	local $SIG{CHLD} = 'IGNORE';

	# pass compile stats
	my ($stats, $compile) = @_;

	# A simple sequence of compile, wait, compile etc. will not work
	# correctly, since we will miss changes while we are compiling.
	# So a change done while a compile is still running, will not
	# trigger any event, when the previous compilation is done.

	# This could also be solved by using File::ChangeNotify, since
	# it should provide an API that seems to be non blocking. I guess
	# that some platform-specific implementation does not support non-
	# blocking io, which should be the case, as otherwise I would expect
	# File::ChangeNotify::Simple to provide a non-blocking interface. But
	# I really like that deps are optional in File::ChangeNotify::Simple!

	# Therefore we create two "threads" that communicate via
	# a very simple queue object. This allows us to sync changes
	# and running compilations. Since this creates quite a lot
	# of additional dependencies, we try to load them only when
	# this feature is in use (no hard dependencies for core lib).

	# Most of the code and ideas have been copied from webmerge!
	# ToDo: reference optional (should have) deps in build file!

	# create new queue to pass commands/events around
	my $changes = CSS::Sass::Watchdog::Queue->new();

	# get the files from the previous compile stats
	my @files = @{$stats->{'included_files'} || []};

	# start child process
	if ($child_pid = forks())
	{ watchdog_parent($changes, \@files, $compile); }
	else { watchdog_child($changes, \@files); }

}
# EO sub start_watchdog

###################################################################################################

END
{
	# check if we actually are the parent
	if ($parent_pid && $parent_pid == $$)
	{
		# print "parent is terminating\n";
		# make sure our child is terminated
		kill 'TERM', $child_pid if $child_pid;
	}
	# check if we actually are the parent
	elsif ($parent_pid && $parent_pid != $$)
	{
		# print "file watcher was terminated\n";
	}
}

################################################################################
# from http://www.perlmonks.org/?node_id=49335
# 26.06.2012 added can_dequeue function (mgr@rtp.ch)
################################################################################
package CSS::Sass::Watchdog::Queue;
################################################################################

use Socket;

sub new {
    my($this) = @_;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->mksockpair();
    return $self;
}

# make the socketpair
sub mksockpair {
    my($self)=@_;
    socketpair(my $reader, my $writer, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
    if ($^O ne "MSWin32")
    {
      shutdown($reader,1);
      shutdown($writer,0);
    }
    $self->{'READER'}=$reader;
    $self->{'WRITER'}=$writer;
}

# method to put something on the queue
sub enqueue {
    my($self,@data)=@_;
    my($header,$buffer,$tosend);
    my($handle)=$self->{'WRITER'};
    foreach my $item (@data) {
        $header=pack("N",length($item));
        $buffer=$header . $item;
        $tosend=length($buffer);
        my $rv = print $handle $buffer;
        die "write error : $!" unless defined $rv;
        die "write disconnected" if $rv eq 0;
        $handle->flush;
    }
}

# method to pull something off the queue
sub dequeue {
    my($self)=@_;
    my($header,$data);
    my($toread)=4;
    my($bytes_read)=0;
    my($handle)=$self->{'READER'};
    # read 4 byte header
    while ($bytes_read < $toread) {
       my $rv=read($handle,$header,$toread);
       die "read error : $!" unless defined $rv;
       die "read disconnected" if $rv eq 0;
       $bytes_read+=$rv;
    }
    $toread=unpack("N",$header);
    $bytes_read=0;
    # read the actual data
    while ($bytes_read < $toread) {
       my $rv=read($handle,$data,$toread,0);
       die "read error : $!" unless defined $rv;
       die "read disconnected" if $rv eq 0;
       $bytes_read+=$rv;
    }
    return $data;
}

# method to check if something can be dequeued
sub can_dequeue {
    my($self,$timeout)=@_;
    my($handle)=$self->{'READER'};
    if (defined(my $fileno = $handle->fileno())) {
        vec(my $rbit = '', $fileno, 1) = 1; # enable fd in vector table
        vec(my $ebit = '', $fileno, 1) = 1; # enable fd in vector table
        my $rv = select($rbit, undef, $ebit, $timeout); # select for readable handles
        die "can dequeue errors" if vec($ebit, $fileno, 1);
        return vec($rbit, $fileno, 1); # check fd in vector table
    } else { return undef; }
    # my($io) = IO::Select->new($handle);
    # return $io->can_read($timeout);
}

################################################################################
package CSS::Sass::Watchdog;
################################################################################
1;

__END__

=head1 NAME

CSS::Sass::Watchdog - Watchdog plugin for perl-libsass

=head1 SEE ALSO

L<CSS::Sass>

=head1 AUTHOR

David Caldwell E<lt>david@porkrind.orgE<gt>  
Marcel Greter E<lt>perl-libsass@ocbnet.chE<gt>

=head1 LICENSE

The MIT License (MIT)

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

=cut
