-# Return: Status Code (Bool)
-#
-sub x_write_unlock_file ($;$) {
- my $filename = shift;
- my $timeout = shift || $Timeout;
-
- unless (-l &masterlockfile($filename) and not $iAmMaster) {
- # remove reference counter lock
- #
- &simple_unlock (&reffile($filename),$timeout) or return;
-
- # remove the write lock announce
- #
- &simple_unlock ($filename,$timeout) or return;
- }
-
- # done
- 1;
-}
-
-### sub x_violent_unlock_file ($) ##############################################
-#
-# remove any lock violent (excl. master lock)
-# (symlinks possible)
-#
-# Params: $filename - locked file
-#
-# Return: -none- (the success is not defined)
-#
-sub x_violent_unlock_file ($) {
- my $filename=shift;
-
- unless (-l &masterlockfile($filename)) {
-
- # find out last modification time
- # and do nothing unless 'violent-timout' is over
- #
- my ($reffile,$time);
-
- if (-f ($reffile = $filename)) {
- $time = (stat $reffile)[9];}
-
- elsif (-l ($reffile = &lockfile($filename))) {
- $time = (lstat $reffile)[9];}
-
- if ($reffile) {
- return if ((time - $time) < $violentTimeout);}
-
- write_lock_file ($filename,1); # last try, to set an exclusive lock on $filename
- unlink (&reffile($filename)); # reference counter = 0
- simple_unlock (&reffile($filename)); # release reference counter file
- simple_unlock ($filename);} # release file
-}
-
-### sub x_set_master_lock ($;$) ################################################
-#
-# set master lock
-# (symlinks possible)
-#
-# Params: $filename - file to lock
-# $timeout - timeout (sec.)
-#
-# Return: Status Code (Bool)
-#
-sub x_set_master_lock ($;$) {
- my $filename = shift;
- my $timeout = shift || $masterTimeout;
-
- # set exclusive lock or fail
- #
- return unless (&write_lock_file ($filename,$timeout));
-
- # set master lock
- #
- symlink $filename, &masterlockfile($filename) and return 1;
-
- # no chance (occupied?, master lock set yet?)
- return;
-}
-
-### sub x_release_file ($) #####################################################
-#
-# remove any locks (incl. master lock)
-# (symlinks possible)
-#
-# Params: $filename - file to lock
-# $timeout - timeout (sec.)
-#
-# Return: Status Code (Bool)
-#
-sub x_release_file ($) {
- my $filename=shift;
-
- unlink (&reffile($filename)); # reference counter = 0
- return if (-f &reffile($filename)); # really?
- return unless (simple_unlock (&reffile($filename))); # release reference counter
- return unless (&simple_unlock ($filename)); # remove any write lock announce
- return unless (&simple_unlock (&masterfile($filename))); # remove master lock
-
- # done
- 1;
-}
-
-################################################################################
-#
-# private subs
-#
-
-### sub ~file ($) ##############################################################
-#
-# create lock file names
-#
-sub reffile ($) {
- "$_[0].lock.ref";
-}
-sub lockfile ($) {
- "$_[0].lock";
-}
-sub masterlockfile ($) {
- &lockfile(&masterfile($_[0]));
-}
-sub masterfile ($) {
- confess unless defined $_[0];
- "$_[0].master";
-}
-
-### sub w_simple_lock ($;$) ####################################################
-### sub w_simple_unlock ($) ####################################################
-#
-# simple file lock/unlock
-# (for no-symlink-systems: kill/create lockfile)
-#
-# Params: $filename - file to lock
-# [ $timeout - Lock time out (sec.) ]
-#
-# Return: Status Code (Bool)
-#
-sub w_simple_lock ($;$) {
- my $filename = shift;
- my $timeout = shift || $Timeout;
- my $lockfile = lockfile $filename;
-
- for (0..$timeout) {
- unlink $lockfile and return 1;
- sleep(1);
- }
-
- # timeout
- # occupied?
- return;
-}
-
-sub w_simple_unlock ($) {
- my $filename = shift;
- my $lockfile = lockfile $filename;
- local *LF;
-
- if (open(LF, "> $lockfile")) {
- return 1 if close (LF);
- }
-
- # not able to create lockfile, hmmm...
- #
- return;
-}
-
-### sub w_simple_lock ($;$) ####################################################
-### sub w_simple_unlock ($) ####################################################
-#
-# simple file lock/unlock
-# (symlinks possible: create/unlink symlink)
-#
-# Params: $filename - file to lock
-# [ $timeout - Lock time out (sec.) ]
-#
-# Return: Status Code (Bool)
-#
-sub x_simple_lock ($;$) {
- my $filename = shift;
- my $timeout = shift || $Timeout;
- my $lockfile = lockfile $filename;
-
- for (0..$timeout) {
- symlink $filename,$lockfile and return 1;
- sleep(1);
- }
-
- # time out
- # locking failed (occupied?)
- #
- return;
-}
-
-sub x_simple_unlock ($) {
- my $filename=shift;
-
- unlink (&lockfile($filename)) and return 1;
-
- # not able to unlink symlink, hmmm...
- #
- return;
-}
-
-### sub w_set_ref ($$$) ########################################################
-#
-# add $_[1] to reference counter
-# (may be negative...)
-# (for no-symlink-systems)
-#
-# Params: $filename - file, reference counter belongs to
-# $z - value, added to reference counter
-# $timeout - lock time out
-#
-# Return: Status Code (Bool)
-#
-sub w_set_ref ($$$) {
- my $filename = shift;
- my $z = shift;
- my $timeout = shift || $Timeout;
- my $old;
- my $reffile = reffile $filename;
- local *REF;
-
- # if write lock announced, only count down allowed
- #
- if ($z > 0) {
- return unless(-f lockfile($filename));
- }
-
- # lock reference counter file
- #
- return unless(&simple_lock ($reffile,$timeout));
-
- # load reference counter
- #
- unless (open REF,"<$reffile") {
- $old=0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF or return;
- }
-
- # compute and write new ref. counter
- #
- $old += $z;
- $old = 0 if ($old < 0);
-
- # kill reference counter file
- # if ref. counter == 0
- #
- if ($old == 0) {
- unlink $reffile or return;
- }
- else {
- open REF,">$reffile" or return;
- print REF $old or return;
- close REF or return;
- }
-
- # release ref. counter file
- #
- return unless(&simple_unlock($reffile));
-
- # done
- 1;
-}
-
-### sub x_set_ref ($$$) ########################################################
-#
-# add $_[1] to reference counter
-# (may be negative...)
-# (symlinks possible)
-#
-# Params: $filename - file, reference counter belongs to
-# $z - value, added to reference counter
-# $timeout - lock time out
-#
-# Return: Status Code (Bool)
-#
-sub x_set_ref ($$$) {
- my $filename = shift;
- my $z = shift;
- my $timeout = shift || $Timeout;
- my $old;
- my $reffile = reffile $filename;
- local *REF;
-
- # if write lock announced, only count down allowed
- #
- if ($z > 0) {
- return if(-l &lockfile($filename));
- }
-
- # lock reference counter file
- #
- return unless(&simple_lock ($reffile,$timeout));
-
- # load reference counter
- #
- unless (open REF,"<$reffile") {
- $old=0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF or return;
- }
-
- # compute and write new ref. counter
- #
- $old += $z;
- $old = 0 if ($old < 0);
- if ($old == 0) {
- unlink $reffile or return;
- }
- else {
- open REF,">$reffile" or return;
- print REF $old or return;
- close REF or return;
- }
-
- # release ref. counter file
- #
- return unless(&simple_unlock($reffile));
-
- # done
- 1;
-}
-
-### sub get_ref ($) ############################################################
-#
-# read out the reference counter
-# (system independant)
-# no locking here!
-#
-# Params: $filename - file, the ref. counter belongs to
-#
-# Return: reference counter
-#
-sub get_ref ($$) {
- my $filename = shift;
- my $reffile = reffile $filename;
- my $old;
- local *REF;
-
- unless (open REF,"< $reffile") {
- $old = 0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF;
- }
-
- # return value
- $old;
-}
git.p6c8.net / selfforum.git / blobdiff