################################################################################
#
#  kPerl Core Library Group
#  Library for Asynchronous File Access
#
#  copyright (c)
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 2001-2003
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @EXPORT
#   %_LibParam
#
# - physical object access and job control
#   $_LibParam{Mail*}
#   &PhysicalAccessCtrl
#
################################################################################

package MainLib::FileAccAsync;

# includes
#use strict; use warnings;  # OK 2003xxxx
use MainLib::StrRegexp qw(&TimeStr);
use MainLib::Path;
use MainLib::File;
use MainLib::Internet qw(&MailSimple);

# symbol export
use Exporter qw(import);
our @EXPORT = qw (
  &PhysicalAccessCtrl
  );

# package-wide constants and variables
my %_LibParam;


################################################################################
# physical object access and job control
################################################################################

$_LibParam{MailAcc} = <<"END_ACCBODY";
%s is asking to access the file %s.

You may make a backup (recommended) before leaving the file.
An additional message will inform you that the process has finished 
its work.
END_ACCBODY

$_LibParam{MailFree} = <<"END_FREEBODY";
%s has finished its work on %s.

If you detect corruptions or somehow decide to continue work with 
a backup copy you should reply on this message and report the 
problem. Otherwise the process erroneously assumes that the action 
has taken effects.
END_FREEBODY


# manage physical file access via lock-flag file
#
# INTERFACE
# - argument 1: path of target
#               the control process will look for the file $target$suffix
#
# - options:
#   -debug      print debug protocol to STDOUT/STDERR
#   -func       code reference, arguments via -FuncArg
#   -FuncArg    arguments for function call, option -func
#   -log        switch on event logging to STDOUT
#   -mail       send mail messages to owner of the lock file (or value of
#               'address'). opt value is a hash reference:
#               from       (optional) address of the sender
#               ProcStamp  (optional) ID stamp of the process
#               subject    (optional) subject text
#               to         (optional) address of the recipient
#   -mode       action mode
#               wait   wait for lock-flag file to disappear and return
#                      (default mode)
#               func   wait for unlock status and if unlocked set the
#                      lock-flag file by ourselves and call a function
#                      referenced by option -func. The return value will be
#                      the final operation status.
#   -noLock     don't create a lock file. The called process (mode 'func')
#               is assumed to create the appropriate lock-flag file.
#   -suffix     file suffix that flags locking, default: ".BUSY"
#
# - return val: - return value of called function, which should be a 
#                 boolean value reflecting success status
#               - operation status (boolean) for option -wait
#               - undef if an error occurs
#
sub PhysicalAccessCtrl {
  my ($target, %opt) = @_;
  my ($FuncMode, $debug, $dbg2, $log, %mail, $suffix);
  my ($bWait, $MaskSave, $owner, $RetVal);

  # function parameters
  $debug = $opt{-debug};
  $dbg2  = $debug ? $debug-1 : 0;
  $FuncMode  = $opt{-mode} || 'wait';
  $target = &PathExpand ($target);
  $log = $opt{-log} || $debug;
  %mail = %{$opt{-mail}||{}};
  $suffix = $opt{-suffix} || '.BUSY';

  # wait for project to be accessible
  # cp. Gap.pl -ReadMv
  while (-e "$target$suffix" or -e "$target$suffix") {  # double-check seems to be safe against gap4sh
    unless ($bWait) {
      $owner = &owner ("$target$suffix");
      $log and printf "%s: file %s locked by %s - waiting\n",
        &TimeStr(), $target, $owner;
      if (%mail) {
        $debug and printf STDERR "%s. owner of target %s is %s\n", (caller(0))[3], $target, $owner;
        &MailSimple (
          -to      => $owner,
          -subject => "asking to access $target",
          -body    => sprintf ($_LibParam{MailAcc},
                        ($mail{ProcStamp} ? "Process $mail{ProcStamp}" : 'A process') . " (pid $$)",
                        $target),
          );
      }
      $bWait = 1;
    }
    sleep 5;
  }
  if ($bWait and $log) {
    printf "%s: file %s unlocked\n", &TimeStr(), $target;
  }

  # access mode 'wait'
  if ($FuncMode eq 'wait') { return 1 }

  # access mode (func => call function)
  if ($FuncMode eq 'func') {
    if (ref($opt{-func}) ne 'CODE') {
      printf STDERR "%s. running in mode -func but i don't have a code reference\n", (caller(0))[3];
      return undef;
    }

    # lock against foreign access, run code, unlock
    unless ($opt{-noLock}) {
      $MaskSave = umask (0077);
      &touch ("$target$suffix");
      umask ($MaskSave);
    }
    $RetVal = &{$opt{-func}} (@{$opt{-FuncArg}});
    unless ($opt{-noLock}) {
      unlink ("$target$suffix");
    }

    # logging?, mailing mode?
    $log and printf "%s: process done on file %s\n", &TimeStr(), $target;
    if ($bWait and %mail) {
      &MailSimple (
        -to      => $owner,
        -subject => "work done on $target",
        -body    => sprintf ($_LibParam{MailFree},
                      $mail{ProcStamp} ? "Process $mail{ProcStamp}" : 'The process',
                      $target),
        );
    }

    # return
    return $RetVal;
  }

  # unknown access mode
  else {
    printf STDERR "%s. ERROR: unknown or missing access mode: %s\n", (caller(0))[3], $FuncMode;
    return undef;
  }
}


1;
# $Id: FileAccAsync.pm,v 1.8 2018/06/05 18:02:56 szafrans Exp $
