# FILE: lockfile.pl
# DESCRIPTION: Older file-based file locking which we hope you don't have to use
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### file_based_file_unlock
###
### Unlocks a file or files
###

sub file_based_file_unlock {
	my @files = @_;
	my $tcache = time;
	undef my %files;
	foreach my $line (@files) {
		$line = (split(/\t/, $line))[0];
		$line = $1 if $line =~ m|.*/(.*)|;
		$files{$line} = 1;
	}
	open (LOCKS, "$DCONF->{admin_dir}/locks.txt");
	my @locks = <LOCKS>;
	close (LOCKS);
	foreach my $line (@locks) {
		$line =~ s/\s+$//;
		my ($x, $y) = split(/\t/, $line);
		$line = "" if $files{$x};
		$line = "" if $tcache > ($y + 15);
		$line .= "\n";
	}
	@locks = grep(/\S/, @locks);
	open (LOCKS, ">$DCONF->{admin_dir}/locks.txt");
	print LOCKS "#\n";
	print LOCKS @locks;
	close (LOCKS);
	return 1;
}

###
### file_based_file_lock
###
### Attempts to gain a file-based file lock on a given file
###

sub file_based_file_lock {
	my ($file) = @_;
	if (!-e "$DCONF->{'admin_dir'}/locks.txt") {
		error_message("File Locking Error", "The locks.txt file in administration directory does not exist.");
	}
	if (!-w "$DCONF->{'admin_dir'}/locks.txt") {
		my $msg = "The locks.txt file in your administration directory is not writable by the server.\n";
		$msg .= "On unix, make sure the permissions on the locks.txt\n";
		$msg .= "file are set to 0777 (rwxrwxrwx).  On NT, have the system\n";
		$msg .= "administrator make the administration directory writable by\n";
		$msg .= "the WWW server.  This is a permissions problem and is between\n";
		$msg .= "you and your web host to work out.  DiscusWare, LLC cannot help you\n";
		$msg .= "resolve this problem.  <A HREF=\"http://www.discusware.com/support/resources/errors/fle.html\" TARGET=_top>Click here</A> for assistance.\n";
		error_message("File Locking Error", $msg . "<P><B>\$!: <FONT COLOR=#ff0000>Permission Denied</FONT></B>", 0, 1);
	}
	my $begun_time = time;
	my $subr_locker = "";
	undef my %files;
	$files{$file} = 1;
	undef my @global;
	while (scalar(keys(%files))) {
		my $flag = 1; my $ctr = time;
		open (LOCKS, "$DCONF->{admin_dir}/locks.txt");
		my @global = <LOCKS>;
		close (LOCKS);
		undef my %lockfiles;
		foreach my $file (@global) {
			my ($filenm, $time, $ps) = split(/\t/, $file);
			$lockfiles{$filenm} = $time;
		}
I:		foreach my $kfile (keys(%files)) {
			undef my $filenm;
			if ($kfile =~ m|.*/(.*)|) {
				$filenm = $1;
			} else {
				$filenm = $kfile;
			}
			if ($lockfiles{$filenm} == 0 && $files{"*"} == 0) {
				push (@global, "$filenm\t$ctr\t$$\n");
				delete $files{$kfile};
				next I;
			}
			if ($ctr - $lockfiles{$filenm} >= 10 && $filenm ne "*") {
				push (@global, "$filenm\t$ctr\t$$\n");
				delete $files{$kfile};
				next I;
			}
			if ($ctr - $lockfiles{$filenm} >= 15 && $filenm eq "*") {
				push (@global, "$filenm\t$ctr\t$$\n");
				delete $files{$kfile};
				next I;
			}
		}
		if (time - $begun_time >= 5) {
			if (time > ($begun_time + 5)) {
				my $filenm = (keys(%files))[0];
				log_error("lockfile.pl", "file_based_file_lock", "Request for lock on $filenm failed... [$subr_locker,$$]");
				my $L = read_language();
				error_message("$L->{'FILELOCKERROR'}", "$L->{FILEISLOCKED}<BR>[$filenm]", 0, 1);
			}
		}
		return 0 if ($subr_locker eq "src-board-subs-common");
	}
	@global = grep(/\S/, @global);
	open (LOCKS, ">$DCONF->{admin_dir}/locks.txt") || error_message("File Locking Error", "Could not write locks.txt file!");
	print LOCKS @global;
	close (LOCKS);
	return 1;
}

1;
