#=================================================================
# Notes:
#
# I would have used flock(), but there are portability issues
# when used across networks (see "perldoc -f flock").
#=================================================================

use strict;

my $LCK_FORMAT = "%s.LCK";
my $LCK_RETRIES = 10;
my $LCK_DELAY = .250; # in seconds (can be fractional).
my $LCK_STALE = 25; # seconds

#-----------------------------------------------------------------
# Read the lock data.
#-----------------------------------------------------------------
sub db_read_lock {
    my ($filename) = @_;

    my $lockfile = sprintf ($LCK_FORMAT, $filename);

    # Read the lock file
    open (INF, "< $lockfile");
    my $in_data = <INF>;
    close INF;

    my ($in_pid, $in_ts) = split ("\t", $in_data);

    return ($in_pid, $in_ts);
}

#-----------------------------------------------------------------
# Return 1 if the lock is stale, 0 otherwise.
#-----------------------------------------------------------------
sub db_is_stale {
    my ($filename) = @_;
    my $rc = 0;

    # Read the lock file
    my ($in_pid, $in_ts) = db_read_lock ($filename);

    my $now = time ();
    if (($in_ts > $now) || (($now - $in_ts) > $LCK_STALE)) {
	$rc = 1;
    }
    return $rc;
}

#-----------------------------------------------------------------
# Returns 1 if file is locked, 0 if not locked.
#-----------------------------------------------------------------
sub db_is_locked {
    my ($filename) = @_;
    my $rc = 0;
    
    # Read the lock file
    my ($in_pid, $in_ts) = db_read_lock ($filename);

    if ((defined $in_pid) && (defined $in_ts)) {
	$rc = 1;
    }
    return $rc;
}

#-----------------------------------------------------------------
# Wait up to n seconds for the file to become unlocked. Return 1 
# if unlocked, 0 otherwise.
#-----------------------------------------------------------------
sub db_wait_for_unlock {
    my ($filename, $seconds) = @_;
    my $i;
    my $rc = 0;

    for ($i=0; $i < ($seconds + $seconds); $i++) {
	if (db_is_locked ($filename) == 1) {
	    # wait half a sec...
	    select (undef, undef, undef, 0.5); 
	}
	else {
	    $rc = 1;
	    last;
	}
    }

    return $rc;
}

#-----------------------------------------------------------------
# Create a lockfile for $filename.
#-----------------------------------------------------------------
sub db_file_lock_simple {
    my ($filename) = @_;
    my $success = 0;
    my $lockfile = sprintf ($LCK_FORMAT, $filename);
    my $rc = 0;
    
#    if ((-e $filename) && (! -e $lockfile)) {
    if (! -e $lockfile) {
	# Write the lock file
	open (OUTF, "> $lockfile");
	my $now = time ();
	print OUTF "$$\t$now";
	if (close OUTF) {
	    $success = 1;
	}

	# Read the lock file
	#my ($in_pid, $in_ts) = db_read_lock ($filename);

	# Verify the lock file
	#if ($in_pid == $$) {
	#    $success = 1;
	#}
    }
    
    return $success;
}

#-----------------------------------------------------------------
# Attempt 
#-----------------------------------------------------------------
sub db_file_lock {
    my ($filename) = @_;
    my $success = 0;

    # If there's an existing lock file, and it's stale, then
    # remove it.
    if (db_is_locked ($filename)) {
	if (db_is_stale ($filename)) {
	    if (db_file_unlock ($filename, 1) == 0) {
		# Could not remove stale lock file.
		return $success;
	    }
	}
    }

    my $tries = 0;

    # Try to apply a new lock.
    while ((($success = db_file_lock_simple ($filename)) == 0) 
	   && ($tries++ < $LCK_RETRIES)) {
	select (undef, undef, undef, $LCK_DELAY);
    }
	
    return $success;
}

#-----------------------------------------------------------------
# Remove a lockfile for $filename.
#-----------------------------------------------------------------
sub db_file_unlock {
    my ($filename, $force) = @_;
    my $success = 1;
    my $lockfile = sprintf ($LCK_FORMAT, $filename);
    
    if (-e $lockfile) {
	# Read the lock file
	my ($in_pid, $in_ts) = db_read_lock ($filename);

	# Is this our lock file (or are we forcing a lock removal)?
	if (($in_pid == $$) || ($force == 1)) {
	    unlink $lockfile;
	}

	# Read the lock file again
	my ($chk_pid, $chk_ts) = db_read_lock ($filename);
	if ((defined $chk_pid) && (defined $chk_ts)) {
	    # If it hasn't changed, then we were unsuccessful
	    # at unlocking.
	    if (($chk_pid == $in_pid) && ($chk_ts == $in_ts)) {
		$success = 0;
	    }
	}
    }
    
    return $success;
}

1;