#!/usr/bin/perl

# ------------------------------------------------------------------------------
# filelock-sample - Show basic filelock.pm usage
# ------------------------------------------------------------------------------

use strict;

# ------------------------------------------------------------------------------
# Modules we use
# ------------------------------------------------------------------------------

use filelock;


# ------------------------------------------------------------------------------
# Constants (operationally, if not technically)
# ------------------------------------------------------------------------------

# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

my	$RET_SUCCESS	= 0;				# Return value for success
my	$RET_FAILURE	= 1;				# Return value for general failure
my	$RET_FATAL		= (-1);				# Return value for fatal failure

my	$TRUE	= 1;
my	$FALSE	= 0;

my	$PAUTIM	= 10;						# Pause time for testing

my $LCKFN1 = 'filelock-test1.dat';
my $LCKFN2 = 'filelock-test2.dat';
my $LCKFN3 = 'filelock-test3.dat';

my	$TLGFNM = 'filelock.testlog';		# Unit test logfile name
my	$TL2FNM = 'filelock2.testlog';		# Unit test logfile name for 2nd copy


# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


# ------------------------------------------------------------------------------
# Globals
# ------------------------------------------------------------------------------

my	$Fatflg;							# Fatal operation flag (end program ASAP)
my	$Wrkflg;							# Did we ever do any work?
my	$Tstflg = $FALSE;					# Are we in unit test mode?
my	$Fstflg = $FALSE;					# Do we do the tests the fast way?

my	$Tstfn1 = $LCKFN1;
my	$Tstfn2 = $LCKFN2;
my	$Tstfn3 = $LCKFN3;

my	$Tlgfnm = $TLGFNM;

# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


# ------------------------------------------------------------------------------
# Go Forth and Conquer.  No, wait -- that should be "Go Perl and Conquer"
# ------------------------------------------------------------------------------

	# --------------------------------------------------------------------------
	# Sorry this is so crude; I ripped it out of the unit test for this module.
	# --------------------------------------------------------------------------

eval {
	foreach my $curpar (@ARGV)
	{
		if ($curpar =~ /^\-/)
		{
			# Command line switch
			if ($curpar =~ /^\-fast/i)
			{
				# FAST mode
				$Fstflg = $TRUE;
			}
			else
			{
				# Invalid option
				&usage();
				print "Invalid option '$curpar'\n";
			}
		}
		else
		{
			# Regular parameter
			$Wrkflg = 1;	# Yes, we've actually asked for real work to be done
			my $retval = &filelocktest($curpar);
			if ($Fatflg)
			{
				return $retval;
			}
		}
	}

	# Check if there was ever a valid parameter
	if (!$Wrkflg)
	{
		# Nope.  Handle the "no valid parameter" condition.
		# Parameter is not required
		my $retval = &filelocktest();
		if ($Fatflg)
		{
			return $retval;
		}
	}
} ; # End eval{} error trap set REQUIRES a semicolon

if ($@)
{
	my $dsperr = $@;
	print "$dsperr";
}

exit;

# ==============================================================================
# Subroutines
# ==============================================================================


# ------------------------------------------------------------------------------
# filelocktest($curpar) - Unit test for the filelock module
# ------------------------------------------------------------------------------

sub filelocktest
{
	my ($curpar, @arglst) = @_;

	if ($curpar eq "2")
	{
		# User has indicated this is the second locking test

		# I cannot remember the scalar swap command name. Do it the hard way.
		my $tmpfn1 = $Tstfn1;
		$Tstfn1 = $Tstfn2;
		$Tstfn2 = $tmpfn1;
		# Change testing logfile name
		$Tlgfnm = $TL2FNM;
	}
	&test($curpar);

}


# -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


# ------------------------------------------------------------------------------
# test($curpar) - Perform unit testing.
#
# 	$curpar:	The parameter passed in from filelocktest() - if "2" I'm 2nd copy.
# 	Returns:  Nothing
# ------------------------------------------------------------------------------

sub test
{
	my ($curpar, @arglst) = @_;

	# --------------------------------------------------------------------------
	{
		print "TEST:  lock() works\n";

		my $EXPTST = $TRUE;

		my $dspret = '';

		print "Process $$ locking $Tstfn1\n";
		my $lckret = &filelock::lock($Tstfn1);
		print "Process $$ finished locking $Tstfn1\n";
		$dspret .= "lock #1 '$lckret'  ";
		if ($lckret ne $filelock::RET_SUCCESS)
		{
			# Failed in a detectable way.
			print "FAIL!\n";
		}
		else
		{
			# Seems to have worked.  Sleep awhile, lock #2.
			if (!$Fstflg)
			{
				print "Process $$ sleeping $PAUTIM seconds\n";
				sleep $PAUTIM;
			}

			print "Process $$ unlocking $Tstfn1\n";
			my $secret = &filelock::unlock($Tstfn1);
			print "Process $$ finished unlocking $Tstfn1\n";

			print "Process $$ locking $Tstfn2\n";
			my $secret = &filelock::lock($Tstfn2);
			print "Process $$ finished locking $Tstfn2\n";
			$dspret .= "lock #2 '$secret'  ";
			if ($secret ne $filelock::RET_SUCCESS)
			{
				# Failed in a detectable way.
				print "FAIL!\n";
			}
			else
			{
				# Seems to have worked.  1st Sleeps awhile.  Both lock #3.
				if ($curpar ne "2")
				{
					if (!$Fstflg)
					{
						print "Process $$ sleeping $PAUTIM seconds\n";
						sleep $PAUTIM;
					}
				}

				print "Process $$ locking $Tstfn3\n";
				my $secret = &filelock::lock($Tstfn3);
				print "Process $$ finished locking $Tstfn3\n";
				$dspret .= "lock #3 '$secret'  ";
				if ($secret ne $filelock::RET_SUCCESS)
				{
					# Failed in a detectable way.
					print "FAIL!\n";
				}
				else
				{
					# Seems to have worked.  Sleep awhile, unlock.

					if (!$Fstflg)
					{
						print "Process $$ sleeping $PAUTIM seconds\n";
						sleep $PAUTIM;
					}

					print "Process $$ unlocking $Tstfn2\n";
					my $secret = &filelock::unlock($Tstfn2);
					print "Process $$ finished unlocking $Tstfn2\n";

					if (!$Fstflg)
					{
						print "Process $$ sleeping $PAUTIM seconds\n";
						sleep $PAUTIM;
					}

					print "Process $$ unlocking $Tstfn3\n";
					my $secret = &filelock::unlock($Tstfn3);
					print "Process $$ finished unlocking $Tstfn3\n";
				}
			}
		}
		$dspret =~ s/^\s+//;
		$dspret =~ s/\s+$//;

		print "RESULTS:  $dspret\n";
	}

	# --------------------------------------------------------------------------
	{
		print "TEST:  duplicate locks stack properly\n";

		my $EXPTST = $TRUE;
		my $EXPCNT = 2;
		my $EXPCN2 = 1;
		my $EXPCN3 = 0;

		my $dspret = '';

		#print "DEBUG:  First lock...\n";
		my $lckret = &filelock::lock($Tstfn1);
		$dspret .= $lckret;
		if ($lckret ne $filelock::RET_SUCCESS)
		{
			# Failed in a detectable way.
			print "FAIL!\n";
		}
		else
		{
			# Seems to have worked.  Lock it again.
			#print "DEBUG:  First lock succeeded...Second lock...\n";
			my $secret = &filelock::lock($Tstfn1);
			$dspret .= "/$secret";
			if ($secret ne $filelock::RET_SUCCESS)
			{
				# Failed in a detectable way.
				print "FAIL!\n";
			}
			else
			{
				# Both worked.  Check lock depth.
				#print "DEBUG:  Second lock succeeded...Checking lock depth...\n";
				my $lckdep = &filelock::getLockCount($Tstfn1);
				$dspret .= "/$lckdep";
				if ($lckdep ne $EXPCNT)
				{
					# Lock depth is not what was expected.
					print "FAIL!\n";
				}
				else
				{
					# Right depth.  Release locks.
					#print "DEBUG:  Unlock second lock...\n";
					my $unlret = &filelock::unlock($Tstfn1);
					$dspret .= "/$unlret";
					my $unldep = &filelock::getLockCount($Tstfn1);
					if ($unldep ne $EXPCN2)
					{
						# Lock depth did not downwardly adjust properly.
						print "FAIL!\n";
					}
					else
					{
						# One more unlock to go.
						#print "DEBUG:  Unlock successful...unlock first lock...\n";
						my $un2ret = &filelock::unlock($Tstfn1);
						$dspret .= "/$un2ret";
						my $un2dep = &filelock::getLockCount($Tstfn1);
						if ($un2dep ne $EXPCN3)
						{
							# Lock depth did not downwardly adjust properly.
							print "FAIL!\n";
						}
						else
						{
							# Goodness, we're done!
							#print "DEBUG:  Unlock successful...Done with this test.\n";
						}
					}
				}
			}
		}

		print "RESULTS:  $dspret\n";
	}

	# --------------------------------------------------------------------------
}