package NFSLock;
require 5.001;

##############################################################################
# $Id: web.pm,v 1.35 2000/08/17 10:00:22 unrzc9 Exp $                 
# 
# Copyright 1999 Wolfgang Wiese.  All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module as you 
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
#
##############################################################################
# Last Modified on:	$Date: 2000/08/17 10:00:22 $
# By:			$Author: unrzc9 $
# Version:		$Revision: 1.35 $ 
##############################################################################

use strict;

BEGIN {
    use Exporter   ();
    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $revision);

    # if using RCS/CVS, this may be preferred
    $VERSION = do { my @r = (q$Revision: 1.35 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
    $revision = '$Id: web.pm,v 1.35 2000/08/17 10:00:22 unrzc9 Exp $';
    # The above must be all one line, for MakeMaker

    @ISA         = qw(Exporter);
    @EXPORT      = qw(&NUnlock &NLock);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
    @EXPORT_OK   = qw();

    use vars qw( $LOCK_LOCATION $LOCK_CRIT_SLEEPTIME $MAX_LOCKTIME
	$MAX_WAITLOCK %lockliste $OS);

    $LOCK_LOCATION = "/tmp";	# Where do we put our lockfiles

	# How long will i wait for the lock beeing freed doing nothing.
	# After this time, i'll start to check if the previous setted lock is 
	# still valid.
	# This time has to be smaller as MAX_WAITLOCK.
    $LOCK_CRIT_SLEEPTIME = 2;

	# How long till a setted lock is going invalid and will be removed
	# by the next try to lock this file.
    $MAX_LOCKTIME = 10;

	# How long will i wait for the lock to get freed.
	# Notice, that this time has to be smaller as MAX_LOCKTIME.
    $MAX_WAITLOCK = 4;

	# This list will be filled and emptied by the locking
	# procedures. The list will be used for the function NUnlockAll().
    %lockliste = ();

    $ENV{PATH} =~ /^(.*)$/;
    $ENV{PATH} = $1;
    $OS = `/usr/bin/uname -s `;
    $OS =~ s/[\r\n]+$//;

} # BEGIN

		
##############################################################################
# SubRoutines
##############################################################################

sub NLock {
  my ($file) = $_[0];
  my $SLEEP_COUNT=0;
  my @FULL_PATH = split("/", $file);
  my $LOCK_NAME = pop(@FULL_PATH);
  my $LOCK_PATH = join('', $LOCK_LOCATION, '/', $LOCK_NAME, '.lck');
  my($timecount, $seektime, @time, @info);
  my $result;
 
  if ($OS =~ /Windows/i) {
    return 1;
    # No link() and unlink() under windows :(
    # We don't want this be a reason to make the whole program fail.
    # Instead we only make this function obsolet then...
  }
 
  if (not $file) {
    return 0;
  }
  (@time) = localtime(time());

  $time[4]++; # Month
  $time[5] += 1900; # Year
  # Secs + (Min * 60) + (Hours * 3600)
  $seektime = $time[0] + $time[1] * 60 + $time[2] * 3600;

  while (-l $LOCK_PATH) {
    $SLEEP_COUNT++;
    sleep 1;
    if ($SLEEP_COUNT == $LOCK_CRIT_SLEEPTIME) {

	(@info) = lstat($LOCK_PATH);
	(@time) = localtime($info[9]);
	$timecount = $time[0]+$time[1]*60+$time[2]*3600 + $MAX_LOCKTIME;
      
	if ($seektime > $timecount) {
	    unlink $LOCK_PATH;
	    if (symlink($file, $LOCK_PATH)) {
		$lockliste{$file} =1;
		return 1;
	    } else {
		return 0;
	    }
	}
    }
    if( $SLEEP_COUNT >= $MAX_WAITLOCK ){
	return 0;
    }
  }
  if( symlink($file, $LOCK_PATH) ){
      $lockliste{$file} =1;
      return 1;
  } else {
      return 0;
  }
} # Nlock

sub NUnlock {
  my ($file) = $_[0];
  my @FULL_PATH = split("/", $file);
  my $LOCK_NAME = pop(@FULL_PATH);
  my $LOCK_PATH = $LOCK_LOCATION."/$LOCK_NAME.lck";
  
  if ($OS =~ /Windows/i) {
    return 1;
    # No link() and unlink() under windows :(
    # We don't want this be a reason to make the whole program fail.
    # Instead we only make this function obsolet then...
  }
  delete $lockliste{$file};
  return (unlink $LOCK_PATH);
}

sub NUnlockAll {
  my $key;
  my @FULL_PATH;
  my $LOCK_NAME;
  my $LOCK_PATH;

  if ($OS =~ /Windows/i) {
    return 1;
    # No link() and unlink() under windows :(
    # We don't want this be a reason to make the whole program fail.
    # Instead we only make this function obsolet then...
  }
  
  foreach $key (keys %lockliste) {
    @FULL_PATH = split("/", $key);
    $LOCK_NAME = pop(@FULL_PATH);
    $LOCK_PATH = $LOCK_LOCATION."/$LOCK_NAME.lck";
    unlink $LOCK_PATH;
    delete $lockliste{$key};
  }
  return 1;
}

END { }       # module clean-up code here (global destructor)
1; # return true

##############################################################################
__END__

=head1 NAME

Web - A set of useful routines for many webworking purposes

=head1 SYSTEM REQUIREMENTS

This module was primarily made for UNIX/Linux-Systems.
Parts of it cannot be used on other systems. E.g. the
procedures for file locking demand systems that
can use symlinks. 
If you use the modul on systems where symlinks
cannot be used, fatal errors may happen.

=head1 SYNOPSIS

use web;

=head1 ABSTRACT

This perl module serves users with several useful routines for many
purposes, like generating webpages, processing CGI scripts, working
with XML datafiles and net-connections.
It also uses own variants of routines, that was invented first in the 
famous libraries CGI.pm and cgi-lib.pl.

=head1 INSTALLATION

If you don't have sufficient privileges to install web.pm in the Perl
library directory, you can put web.pm into some convenient spot, such
as your home directory, or in cgi-bin itself and prefix all Perl
scripts that call it with something along the lines of the following
preamble:

        use lib '/home/myname/perl/lib';
        use web;

=head1 DESCRIPTION

=head2 NLock

This routine allows to set a filelock across NFS-boundaries.
The common used perl-routine flock() fails at this point, so this routine
is a useable alternative for bigger file-systems.
It uses the modular functions link() and unlink() to mark a file
locked. 
In addition to this, it also gives the locked file a counter: 
A file that is locked for more than $MAX_LOCKTIME seconds
will be freed by the next process that calls NLock() on this file.
A calling process gets either 0 or 1 as a return value, where 1
is returned if the file-locking was successful.
0 is returned only if the process waits for more than $MAX_WAITLOCK
seconds or if symlink() fails.

Example 1:

	$filename = "data.txt";
	NLock($filename);
	open(f1,"$filename");
	# do something
	close f1;
	NUnlock($filename);
	
Example 2:

	#!/local/bin/perl5
	use web;

	$stat= &NLock("jump.pl");
	print "Lock: stat= $stat\n";
	$stat= &NLock("jump.pl");
	print "Lock this file again: stat= $stat\n";
	sleep 8;
	$stat= &NLock("jump.pl");
	print "Lock this file again: stat= $stat\n";
	$stat= &NUnlock("jump.pl");
	print "Unlock: stat= $stat\n";
	exit;

=head2 NUnlock

This routine removes the filelock that was set with NLock().
See NLock().

=head2 NUnlockAll

In using this command, you can remove all file-locks, that was set with 
NLock() and which wasn't removed before.
It takes the list of file-locks out of the hash %lockliste.

=head1 AUTHOR INFORMATION

Copyright 1999-2000 Wolfgang Wiese.  All rights reserved.
It may be used and modified freely, but I do request that this copyright
notice remain attached to the file.  You may modify this module as you 
wish, but if you redistribute a modified version, please attach a note
listing the modifications you have made.

Address bug reports and comments to:
xwolf@xwolf.com

=head1 CREDITS

Thanks very much to:

=over 4

=item Johannes Schritz (johannes@schritz.de)

=item Gert Buettner (g.buettner@rrze.uni-erlangen.de)

=item Manfred Abel (m.abel@rrze.uni-erlangen.de)

=item Rolf Rost (rolfrost@yahoo.com)

=cut



# EOF
##############################################################################