Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhlock.pl

##---------------------------------------------------------------------------##
##  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;