#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::FileLock;

use strict;

use Fcntl qw(:DEFAULT :flock);

# user defined globals (set by Init call)
use vars qw(@REQUIRED_USER_DEFINED_GLOBALS $FILELOCK_FILEPATH);
@REQUIRED_USER_DEFINED_GLOBALS = ('FILELOCK_FILEPATH');
$FILELOCK_FILEPATH             = '';

# package globals
use vars qw(%VALID_LOCK_TYPES $DISABLE_FILELOCKING $FILE_LOCK_DEPTH $CURRENT_LOCK_TYPE $MAX_WAITTIME $INIT_CALLED);
%VALID_LOCK_TYPES          = map { $_ => 1 } qw(exclusive shared nolock);
$DISABLE_FILELOCKING       = 0;   # for debugging only, don't do this.
$MAX_WAITTIME              = 5;   # seconds to wait for a lock before giving up
$CURRENT_LOCK_TYPE         = '';  # 'exclusive' or 'shared'
$FILE_LOCK_DEPTH           = 0;   # current number of nested filelocks
$INIT_CALLED               = 0;   # indicated whether init() has been called or not

# ----------------------------------------------------------------------------
# Function    : init
# Description : define filepaths and globals required by library
# Usage       : &IT::FileLock::init({
#                 'FILELOCK_FILEPATH'    => "$DATADIR/filelock.lock",
#               });
#
# Note: Don't call any functions that call &die_unless_init_called()
#       from this function because then we'll get a confusing error about the init
#       function not being called instead of the actual error.
# ----------------------------------------------------------------------------

sub init {
  my $args = shift;
  if (!$args)                     { die("no arguments specified!"); }
  if (ref $args ne 'HASH')        { die("args must be passed by hash ref!"); }

  # check error module initialized
  &IT::Error::die_unless_init_called();

  # error checking
  my($thisSubroutine) = (caller(0))[3];
  foreach (@REQUIRED_USER_DEFINED_GLOBALS) {
    unless (exists $args->{$_}) { &IT::Error::dieAsCaller("required $thisSubroutine argument '$_' not defined"); }
  }

  # set user defined globals
  $FILELOCK_FILEPATH = $args->{'FILELOCK_FILEPATH'};

  # create lockfile if needed
  unless (-f $FILELOCK_FILEPATH) {
    open(FILELOCK, ">$FILELOCK_FILEPATH") || die "Can't create filelock file '$FILELOCK_FILEPATH' : $!";
    close(FILELOCK)                       || die "Can't close filelock file '$FILELOCK_FILEPATH' : $!";
  }

  # set package globals
  $INIT_CALLED = 1;
}

# ----------------------------------------------------------------------------
# Function    : die_unless_init_called()
# Description : Dies unless &init() has been called.  This is called
#               first by many public function to make sure the init function
#               for the module has been called.
# Usage       : &die_unless_init_called();
# ----------------------------------------------------------------------------

sub die_unless_init_called {
  if ($INIT_CALLED) { return; }

  my($thisPackage) = (caller(0))[0];
  my($subroutine) = (caller(1))[3];
  &IT::Error::dieAsCaller("You must call &IT::FileLock::init() before calling $subroutine",2);

}

# ----------------------------------------------------------------------------
# Function    : getLock
# Description : Get an 'exclusive' or 'shared' lock.  Uses flock on a file.
#               Locks can't be upgraded but can be nested.  You request a
#               "downgraded" lock, but you'll still have the higher lock type.
#
#               Filelocks are held open until they are closed or the process
#               is terminated (at which point open filehandles are automatically
#               closed).
#
# Usage       : &IT::FileLock::getLock('shared');
#               &IT::FileLock::getLock('exclusive');
# ----------------------------------------------------------------------------

sub getLock {
  if ($DISABLE_FILELOCKING) { return; }
  my $requestedLockType  = shift || &IT::Error::dieAsCaller("No locktype supplied to &IT::FileLock::getLock()!\n");;

  # error checking
  &die_unless_init_called();
  if (!$VALID_LOCK_TYPES{$requestedLockType}) { &IT::Error::dieAsCaller("locktype must be either 'exclusive' or 'shared', not '$requestedLockType'"); }
  my $lockUpgradeAttempted = ($FILE_LOCK_DEPTH > 0 && $CURRENT_LOCK_TYPE eq 'shared' && $requestedLockType eq 'exclusive');
  if ($lockUpgradeAttempted) { &IT::Error::dieAsCaller("Can't upgrade locks! ($CURRENT_LOCK_TYPE to $requestedLockType)\n"); }
  # NOTE: Windows doesn't seem to support upgrading a flock lock from shared to exclusive

  # update lock counter
  if (++$FILE_LOCK_DEPTH > 1) { return; }

  ### Open/Create lockfile
  sysopen(FILELOCK, $FILELOCK_FILEPATH, O_RDWR|O_CREAT) || &IT::Error::dieAsCaller("error opening $requestedLockType file lock $FILELOCK_FILEPATH: $!\n");

  # get flags
  my $operation;
  if ($requestedLockType eq 'shared')     { $operation = LOCK_SH; }    # shared
  if ($requestedLockType eq 'exclusive')  { $operation = LOCK_EX; }    # exclusive
  if ($MAX_WAITTIME > 0)                  { $operation |= LOCK_NB; }   # non blocking

  ### Keep trying to get a flock on the semaphore until we timeout
  my $giveup_time = time() + $MAX_WAITTIME;
  until (flock(FILELOCK, $operation)) {
    if (time() < $giveup_time) { sleep(1); }
    else {
      close(FILELOCK);
      &IT::Error::logErrorAndDie("SERVERBUSY: Timed out waiting for a filelock\n", "Tried for $MAX_WAITTIME seconds");
    }
  }

  ### On success
  $CURRENT_LOCK_TYPE = $requestedLockType;
}

# ----------------------------------------------------------------------------
# Function    : releaseLock
# Description : Release one level of locking on a semaphore.  When all levels
#               are gone, the lock is released.
#
# Usage       : &IT::FileLock::releaseLock();
#
# Inputs      : none
# Outputs     : Dies on failure
#
# Caveats     : dies if a lock can not be released
#               dies if there is no lock to be released for the process
# ----------------------------------------------------------------------------

sub releaseLock {
  # optimizations
  if ($FILE_LOCK_DEPTH > 1) { $FILE_LOCK_DEPTH--; return; }
  if ($DISABLE_FILELOCKING) { return; }

  # error checking
  &die_unless_init_called();
  if (@_)                    { die "releaseLock doesn't take any arguments!"; }
  if ($FILE_LOCK_DEPTH == 0) { die "There is no active filelock to release!"; }

  ### Explicitly unlock semaphore (apparently, this releases locks faster than just closing)
  flock(FILELOCK, LOCK_UN) || &IT::Error::logErrorAndDie("error releasing a flock() on file lock '$FILELOCK_FILEPATH': $!\n");

  ### Close semaphore (supposed to automatically disable flocks, but not as fast as doing so explicitly)
  close(FILELOCK) || &IT::Error::logErrorAndDie("error closing file lock '$FILELOCK_FILEPATH': $!\n");

  # reset globals
  $CURRENT_LOCK_TYPE      = '';
  $FILE_LOCK_DEPTH--;
}


# ----------------------------------------------------------------------------
# Function    : lockExists
# Description : Return false if no lock exists, the depth of the locks otherwise.
#
# Usage       : ($lockDepth, $lockType) = &IT::FileLock::lockExists();
#
# Inputs      : none
# Outputs     : Returns 1 on success
# ----------------------------------------------------------------------------

sub lockExists {
  if ($DISABLE_FILELOCKING) { return; }

  # error checking
  &die_unless_init_called();

  return ($FILE_LOCK_DEPTH, $CURRENT_LOCK_TYPE);
}

# ------------------------------------------------------------------------
# Function    : lockRequired
# Description : Raise an error if the specified lock type (or better) isn't
#               already set. (eg: is shared if required but we have exclusive that's ok)
# Usage       : &IT::FileLock::lockRequired('exclusive');
# Note        : unspecified lock type will return true for any lock type
# ------------------------------------------------------------------------

sub lockRequired {
  if ($DISABLE_FILELOCKING) { return; }
  my $requiredType = shift;

  # error checking
  &die_unless_init_called();
  unless ($VALID_LOCK_TYPES{$requiredType}) { die "lockRequired: invalid lock type '$requiredType'!"; };

  # require no lock (absence of lock)
  my $thisFunction     = (caller(1))[3];
  my $callingFunction  = (caller(2))[3];
  if ($requiredType eq 'nolock' && $CURRENT_LOCK_TYPE) {
    die "$thisFunction requires no filelock be active.  A '$CURRENT_LOCK_TYPE' filelock is currently active.";
  }

  # require shared
  elsif ($requiredType eq 'shared' && $CURRENT_LOCK_TYPE ne 'shared' && $CURRENT_LOCK_TYPE ne 'exclusive') {
    die("$thisFunction requires a shared or exclusive filelock to have been acquired by the calling function ($callingFunction)");
  }

  # require exclusive locks
  elsif ($requiredType eq 'exclusive' && $CURRENT_LOCK_TYPE ne 'exclusive') {
    die("$thisFunction requires an exclusive filelock to have been acquired by the calling function ($callingFunction)");
  }

}


# ----------------------------------------------------------------------------
# Function    : emergencyLockCleanup
# Description : Not used.  Function stub exists for compatability with old code.
# Usage       : &emergencyLockCleanup()
# ----------------------------------------------------------------------------

sub emergencyLockCleanup {
}
# ----------------------------------------------------------------------------
# Function    : renewLockTimeout
# Description : Not used.  Function stub exists for compatability with old code.
# Usage       : &IT::FileLock::renewLockTimeout()
# ----------------------------------------------------------------------------

sub renewLockTimeout {

}

# ----------------------------------------------------------------------------
# end of file
1;

