##---------------------------------------------------------------------------##
##  File:
##      $Id: mhlock.pl,v 1.3 2001/09/17 16:10:40 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##	Lock functions for MHonArc.
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1997-1999	Earl Hood, mhonarc@mhonarc.org
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

package mhonarc;

#############################################################################
##	Constants
#############################################################################

sub MHA_LOCK_MODE_DIR () { 0; }
## -- Directory method: Works on all platforms, but lock dir can be
##	    left around if abnormal termination.
sub MHA_LOCK_MODE_FLOCK () { 1; }
## -- flock() method: Works on select platforms.  Can have problems
##	    if writing to an NFS mount depending on how perl is built.
##	    If available, and not writing to NFS (or reliable over NFS)
##	    this method is better than directory method.

#############################################################################
##	Variables
#############################################################################

my $_lock_file = undef;
my $_flock_fh  = undef;

$LockFunc   = undef;
$UnlockFunc = undef;

#############################################################################
##	Functions
#############################################################################

##---------------------------------------------------------------------------
##	set_lock_mode(): Set locking method used by MHonArc.
##
sub set_lock_mode {
    my $mode = shift;
    if ($mode =~ /\D/) {
    STR2NUM: {
            if ($mode =~ /^\s*flock/) {
                $mode = &MHA_LOCK_MODE_FLOCK;
                last STR2NUM;
            }
            $mode = &MHA_LOCK_MODE_DIR;
            last STR2NUM;
        }
    }
    if ($mode == &MHA_LOCK_MODE_FLOCK) {
        $LockFunc   = \&flock_file;
        $UnlockFunc = \&unflock_file;
        return;
    }
    $mode       = &MHA_LOCK_MODE_DIR;
    $LockFunc   = \&create_lock_dir;
    $UnlockFunc = \&remove_lock_dir;

    $mode;
}

#############################################################################
##	Directory Method of Locking Functions
#############################################################################

##---------------------------------------------------------------------------
##	create_lock_dir() creates a directory to act as a lock.
##
sub create_lock_dir {
    my ($file, $tries, $sleep, $force) = @_;
    my $prtry = 0;
    my $ret   = 0;
    $_lock_file = $file;
    while ($tries > 0) {
        if (mkdir($file, 0777)) { $ISLOCK = 1; $ret = 1; last; }
        sleep($sleep) if $sleep > 0;
        $tries--;
        if (!$prtry && ($tries > 0)) {
            print STDOUT qq/Trying to create lock ...\n/ unless $QUIET;
            $prtry = 1;
        }
    }
    if ($force) { $ISLOCK = 1; $ret = 1; }
    $ret;
}

##---------------------------------------------------------------------------
##	remove_lock_dir removes the lock directory
##
sub remove_lock_dir {
    if ($ISLOCK) {
        if (!rmdir($_lock_file)) {
            warn "Warning: Unable to remove $LOCKFILE: $!\n";
            return 0;
        }
        $ISLOCK = 0;
    }
    1;
}

#############################################################################
##	Flock Functions
#############################################################################

##---------------------------------------------------------------------------
##	flock_file(): Create archive lock using flock(2).
##
sub flock_file {
    my ($file, $tries, $sleep, $force) = @_;

    eval {
        require Symbol;
        require Fcntl;
        Fcntl->import(':DEFAULT', ':flock');
    };
    if ($@) {
        warn qq/Warning: Unable to require modules for flock() lock method: /,
            qq/$@\n/,
            qq/\tFalling back to directory method.\n/;
        set_lock_mode(MHA_LOCK_MODE_DIR);
        return &$LockFunc(@_);
    }

    $_lock_file = $file;
    $_flock_fh  = Symbol::gensym;

    if (!sysopen($_flock_fh, $file, (&O_WRONLY | &O_CREAT), 0666)) {
        warn(qq/ERROR: Unable to create "$file": $!\n/);
        return 0;
    }

    my $prtry = 0;
    my $ret   = 0;
    while ($tries > 0) {
        if (flock($_flock_fh, &LOCK_EX | &LOCK_NB)) {
            $ISLOCK = 1;
            $ret    = 1;
            last;
        }
        sleep($sleep) if $sleep > 0;
        $tries--;
        if (!$prtry && ($tries > 0)) {
            print STDOUT qq/Trying to create lock ...\n/ unless $QUIET;
            $prtry = 1;
        }
    }
    if (!$ISLOCK && $force) { $_flock_fh = undef; $ISLOCK = 1; $ret = 1; }

    $ret;
}

##---------------------------------------------------------------------------

sub unflock_file {
    if (defined($_flock_fh)) {
        flock($_flock_fh, &LOCK_UN);
        close($_flock_fh);
        $_flock_fh = undef;
    }
    $ISLOCK = 0;
}

##---------------------------------------------------------------------------

#############################################################################

BEGIN {
    set_lock_mode(MHA_LOCK_MODE_DIR);
}

1;
