#!/usr/bin/perl

use Carp;
use FileHandle;
use File::Slurp;
use strict;
use warnings;
use Time::HiRes;

our $dir;  # set in wrap.tm
die unless $dir;

my $counter = "$dir/counter";
my $lock    = "$dir/lock";
my $lock2   = "$dir/lock2";
my $lock3   = "$dir/lock3";
my $lock4   = "$dir/lock4";
my $lock5   = "$dir/lock5";
my $lock6   = "$dir/lock6";
my $lock7   = "$dir/lock7";

STDOUT->autoflush(1);

my $children = 6;
my $count = 120;
die unless $count % 2 == 0;
die unless $count % 3 == 0;
print "1..".($count*1.5+$children*2+7)."\n";

my %locks;
my $acquiring = '';
my $releasing = '';

my $parent;
my $child = 0;
my $i;
for $i (1..$children) {
	my $p = fork();
	croak unless defined $p;
	$parent = $p or $child = $i;
	last unless $parent;
}

my $pdesc = "process $$, " . ($parent ? "the parent" : "child # $child");
print "# $pdesc\n";

my $lastline;
my $lastdebug = 0;

$SIG{WINCH} = sub {
	if (time - $lastdebug > .5) {
		$lastdebug = time;
		debugprint();
	}
};

sub debugprint {
	print STDERR "# $pdesc at $lastline"
		. (scalar(keys %locks) ? " holding locks on " . join(' ', map { "$_$locks{$_}" } sort keys %locks) : '')
		. ($acquiring ? " trying to acquire lock on $acquiring" : "")
		. ($releasing ? " trying to release lock on $releasing" : "")
		. "\n";
}

STDOUT->autoflush(1);

sub dolock;
sub dounlock;

dp();

if ($parent) {
	print "ok 1\n";
	&write_file($counter, "2");
	&write_file($lock, "");
	&write_file($lock4, "");
	dolock($lock4);
} else {
	my $e = 1;
	while (! -e $lock) {
		# spin
		print "# $pdesc spinning\n" if $e %2000 == 0;
		die if $e++ > 1000000;
	}
	dp();
	dolock($lock3, 'shared');
}

dp();
dolock($lock2, 'shared');
dp();

my $c;
my $ee;
while (($c = &read_file($counter)) < $count) {
	die if $ee++ > 10000000;
	if ($c < $count*.25 || $c > $count*.75) {
		dolock($lock);
	} else {
		dolock($lock, 0, 1) || next;
	}
	$c = &read_file($counter);

	# make sure each child increments it at least once.
	if ($c < $children+2 && $c != $child+2) {
		dounlock($lock);
		next;
	}

	if ($c < $count) {
		print "ok $c\n";
		$c++;
		&overwrite_file($counter, "$c");
	}

	# one of the children will exit (and thus need to clean up)
	if ($c == $count/3) {
		exit(0) if fork() == 0;
	}

	# deal with a missing lock file
	if ($c == $count/2) {
		unlink($lock)
			or croak "unlink $lock: $!";
	}

	# make sure the lock file doesn't get deleted
	if ($c == int($count*.9)) {
		&overwrite_file($lock, "keepme");
	}

	dounlock($lock);
}

dp();
dolock($lock);
$c = &read_file($counter);
print "ok $c\n";
$c++;
&overwrite_file($counter, "$c");
dounlock($lock);
dp();

if ($c == $count+$children+1) {
	print "ok $c\n";
	$c++;
	if (&read_file($lock) eq 'keepme') 
		{print "ok $c\n";} else {print "not ok $c\n"};
	unlink($lock);
	$c++;
}

dounlock($lock2);

if ($parent) {
	dolock($lock2);
	dounlock($lock2);

	$c = $count+$children+3;

	&write_file($counter, $c);
	dounlock($lock4);
}


# okay, now that that's all done, lets try some locks using
# the object interface...

my $start = $c;

for(;;) {
	my $l = dolock2($lock4);

	$c = &read_file($counter);

	last if $c > $count/2+$start;

	print "ok $c\n";
	$c++;
	&overwrite_file($counter, "$c");
}

delete $locks{$lock4}; # unlocked by going out of scope

#
# now let's make sure nonblocking works
#
if ($parent) {
	my $e;
	dolock $lock6;
	for(;;) {
		dp();
		dolock($lock7, undef, 'nonblocking')
			or last;
		dp();
		dounlock($lock7);
		dp();
		die if $e++ > 1000;
		sleep(1);
	}
	dp();
	dounlock $lock6;
	dp();
	dolock $counter;
	dp();
	$c = &read_file($counter);
	print "ok $c\n";
	$c++;
	&overwrite_file($counter, "$c");
	dp();
	dounlock $counter;
	dp();
} elsif ($child == 1) {
	dp();
	my $e;
	for(;;) {
		dolock($lock6, undef, 'nonblocking')
			or last;
		dounlock($lock6);
		die if $e++ > 1000;
		sleep(1);
	}
	dolock $lock7;
	dolock $lock6;
	dolock $counter;
	$c = &read_file($counter);
	print "ok $c\n";
	$c++;
	&overwrite_file($counter, "$c");
	dounlock $counter;
	dounlock $lock7;
	dounlock $lock6;
} 

dp();

#
# Shut everything down
#
if ($parent) {
	dp();
	my $l = new File::Flock $lock3;
	$c = &read_file($counter);
	if ($l) { print "ok $c\n" } else {print "not ok $c\n"}
	$c++;
	unlink($counter);
	unlink($lock4);
	unlink($lock);
	dolock($lock5);
	dounlock($lock5);
	if (-e $lock5) { print "not ok $c\n" } else {print "ok $c\n"}
	$c++;
	my $x = '';
	for (1..$children) {
		dp();
		wait();
		dp();
		my $status = $? >> 8;
		if ($status) { $x .= "not ok $c\n";} else {$x .= "ok $c\n"}
		$c++;
	}
	$releasing = $lock3;
	$l->unlock();
	undef $releasing;
	delete $locks{$lock3};
	print $x;
	dp();
} else {
	dp();
	dounlock($lock3);
}
dp();
exit(0);

sub dolock {
	$lastline = (caller())[2];
	my $s = "";
	$s .= ":" if ($_[1] || $_[2]);
	$s .= ":Shared" if $_[1];
	$s .= ":Nonblocking" if $_[2];
	my $r = lock(@_);
	$locks{$_[0]} = $s if $r;
	undef $acquiring;
	return $r;
}

sub dolock2 {
	$lastline = (caller())[2];
	my $s = "";
	$s .= ":" if ($_[1] || $_[2]);
	$s .= ":Shared" if $_[1];
	$s .= ":Nonblocking" if $_[2];
	$acquiring = "$_[0]$s";
	my $r = File::Flock->new(@_);
	$locks{$_[0]} = $s if $r;
	undef $acquiring;
	return $r;
}

sub dounlock {
	$lastline = (caller())[2];
	$releasing = "$_[0]$locks{$_[0]}";
	delete $locks{$_[0]};
	unlock(@_);
	undef $releasing;
}

sub dp
{
	$lastline = (caller())[2];
	# debugprint();
}

1;