use vars qw(
@EXPORT_OK
%EXPORT_TAGS
+ %LOCKED
$Timeout
$violentTimeout
$masterTimeout
$iAmMaster
+ $VERSION
);
+use Carp;
+use Fcntl;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
################################################################################
#
# Export
violent_unlock_file
set_master_lock
release_file
+ file_removed
);
%EXPORT_TAGS = (
write_unlock_file
violent_unlock_file
)],
- ALL => [qw(
- lock_file
- unlock_file
- write_lock_file
- write_unlock_file
- violent_unlock_file
- set_master_lock
- release_file
- )]
+ ALL => \@EXPORT_OK
);
+### ~file () ###################################################################
+#
+# create lock file names
+#
+sub reffile ($) {
+ return $_[0].'.lock.ref';
+}
+sub lockfile ($) {
+ return $_[0].'.lock';
+}
+sub masterfile ($) {
+ return $_[0].'.master';
+}
+sub masterlockfile ($) {
+ return lockfile(masterfile $_[0]);
+}
+
################################################################################
#
# Windows section (no symlinks)
#
-### sub w_lock_file ($;$) ######################################################
+### w_lock_file () #############################################################
#
# set read lock (shared lock)
# (for no-symlink-systems)
my $filename = shift;
my $timeout = +shift || $Timeout;
- if (-f &masterlockfile($filename)) {
- for (0..$timeout) {
-
- # try to increment the reference counter
- #
- &set_ref($filename,1,$timeout) and return 1;
- sleep (1);
+ unless ($LOCKED{$filename}) {
+ if (-f masterlockfile($filename)) {
+ for (1..$timeout) {
+
+ # try to increment the reference counter
+ #
+ if (set_ref($filename,1,$timeout)) {
+ $LOCKED{$filename}=1;
+ return 1;
+ }
+ sleep (1);
+ }
+ }
+ else {
+ # master lock is set or file has not been released yet
+ return;
}
- }
-
- else {
- # master lock is set
- # or file has not been realeased yet
- #
- return;
}
# time out
0;
}
-### sub w_unlock_file ($;$) ####################################################
+### w_unlock_file () ###########################################################
#
# remove read lock (shared lock)
# (for no-symlink-systems)
my $filename = shift;
my $timeout = shift || $Timeout;
- if (-f &masterlockfile($filename)) {
-
- # try do decrement the reference counter
- #
- &set_ref($filename,-1,$timeout) and return 1;
+ if ($LOCKED{$filename}) {
+ if ($LOCKED{$filename} == 3) {
+ return unless write_unlock_file($filename, $timeout);
+ $LOCKED{$filename} = 1;
+ }
+ if ($LOCKED{$filename} == 1) {
+ if (-f masterlockfile($filename)) {
+
+ # try do decrement the reference counter
+ #
+ if (set_ref($filename, -1, $timeout)) {
+ delete $LOCKED{$filename};
+ return 1;
+ }
+ }
+ }
}
# time out
- # maybe the system is occupied
- # or file has not been released yet
- #
return;
}
-### sub w_write_lock_file ($;$) ################################################
+### w_write_lock_file () #######################################################
#
# set write lock (exclusive lock)
# (for no-symlink-systems)
sub w_write_lock_file ($;$) {
my $filename=shift;
my $timeout= shift || $Timeout;
+ my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
- if (-f &masterlockfile($filename) or $iAmMaster) {
+ if (-f masterlockfile($filename) or $iAmMaster) {
# announce the write lock
# and wait $timeout seconds for
# references == 0 (no shared locks set)
#
- &simple_lock ($filename,$timeout) or return;
- for (0..$timeout) {
+ simple_lock ($filename,$timeout) or return 0;
+ for (1..$timeout) {
# lock reference counter
# or fail
#
- unless (&simple_lock (&reffile($filename),$timeout)) {
- &simple_unlock($filename,$timeout);
- return;
+ unless (simple_lock (reffile($filename),$timeout)) {
+ simple_unlock($filename,$timeout);
+ return 0;
}
# ready if we have no shared locks
#
- return 1 if (&get_ref ($filename) == 0);
+ if (get_ref ($filename) == $rest) {
+ $LOCKED{$filename} = 2 | ($rest ? 1 : 0);
+ return 1;
+ };
# release reference counter
# shared locks get the chance to be removed
#
- unless (&simple_unlock (&reffile($filename),$timeout)) {
- &simple_unlock($filename,$timeout);
- return;
+ unless (simple_unlock (reffile($filename),$timeout)) {
+ simple_unlock($filename,$timeout);
+ return 0;
}
sleep(1);
}
# write lock failed
# remove the announcement
#
- &simple_unlock ($filename);}
+ simple_unlock ($filename);
+ }
else {
- # master lock is set
- # or file has not been released yet
- #
- return;}
+ # master lock is set or file has not been released yet
+ return;
+ }
# time out
- # maybe the system is occupied
- #
0;
}
-### sub w_write_unlock_file ($;$) ##############################################
+### w_write_unlock_file () #####################################################
#
# remove write lock (exclusive lock)
# (for no-symlink-systems)
my $filename = shift;
my $timeout = shift || $Timeout;
- if (-f &masterlockfile($filename) or $iAmMaster) {
+ if (-f masterlockfile($filename) or $iAmMaster) {
# remove reference counter lock
#
- &simple_unlock (&reffile($filename),$timeout) or return;
+ simple_unlock (reffile($filename),$timeout) or return;
# remove the write lock announce
#
- &simple_unlock ($filename,$timeout) or return;}
+ simple_unlock ($filename,$timeout) or return;
+ }
# done
+ delete $LOCKED{$filename};
1;
}
-### sub w_violent_unlock_file ($) ##############################################
+### w_violent_unlock_file () ###################################################
#
# remove any lock violent (excl. master lock)
# (for no-symlink-systems)
sub w_violent_unlock_file ($) {
my $filename = shift;
- if (-f &masterlockfile($filename)) {
+ if (-f masterlockfile($filename)) {
# find out last modification time
# and do nothing unless 'violent-timout' is over
#
my $reffile;
- if (-f ($reffile = $filename) or -f ($reffile = &lockfile($filename))) {
+ if (-f ($reffile = $filename) or -f ($reffile = lockfile($filename))) {
my $time = (stat $reffile)[9];
- return if ((time - $time) < $violentTimeout);}
+ (time - $time) >= $violentTimeout or return;
+ }
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
+ unlink (reffile($filename)); # reference counter = 0
+ simple_unlock (reffile($filename)); # release reference counter file
simple_unlock ($filename);} # release file
+ delete $LOCKED{$filename};
return;
}
-### sub w_set_master_lock ($;$) ################################################
+### w_set_master_lock () #######################################################
#
# set master lock
# (for no-symlink-systems)
# set exclusive lock or fail
#
- return unless (&write_lock_file ($filename,$timeout));
+ return unless (write_lock_file ($filename,$timeout));
# set master lock
#
- unlink &masterlockfile($filename) and return 1;
+ unlink masterlockfile($filename) and return 1;
# no chance (occupied?, master lock set yet?)
return;
}
-### sub w_release_file ($) #####################################################
+### w_release_file () ##########################################################
#
# remove any locks (incl. master lock)
# (for no-symlink-systems)
sub w_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
+ 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
+ delete $LOCKED{$filename};
# done
1;
}
+sub w_file_removed ($) {
+ my $filename = shift;
+
+ unlink reffile($filename);
+ unlink lockfile($filename);
+ unlink lockfile(reffile($filename));
+ unlink masterlockfile($filename);
+}
+
################################################################################
#
# *n*x section (symlinks possible)
#
-### sub x_lock_file ($;$) ######################################################
+### x_lock_file () #############################################################
#
# set read lock (shared lock)
# (symlinks possible)
my $filename = shift;
my $timeout = shift || $Timeout;
- unless (-l &masterlockfile($filename)) {
- for (0..$timeout) {
-
- # try to increment the reference counter
- #
- &set_ref($filename,1,$timeout) and return 1;
- sleep (1);
+ unless ($LOCKED{$filename}) {
+ unless (-l masterlockfile($filename)) {
+ for (1..$timeout) {
+
+ # try to increment the reference counter
+ #
+ if (set_ref($filename,1,$timeout)) {
+ $LOCKED{$filename} = 1;
+ return 1;
+ }
+ sleep (1);
+ }
}
- }
- else {
- # master lock is set
- # or file has not been realeased yet
- #
- return;
+ else {
+ # master lock is set or file has not been realeased yet
+ return;
+ }
}
# time out
- # maybe the system is occupied
0;
}
-### sub x_unlock_file ($;$) ####################################################
+### x_unlock_file () ###########################################################
#
# remove read lock (shared lock)
# (symlinks possible)
my $filename=shift;
my ($timeout)=(shift (@_) or $Timeout);
- unless (-l &masterlockfile($filename)) {
- # try do decrement the reference counter
- #
- &set_ref($filename,-1,$timeout) and return 1;}
+ if ($LOCKED{$filename}) {
+ if ($LOCKED{$filename} == 3) {
+ return unless write_unlock_file($filename, $timeout);
+ $LOCKED{$filename} = 1;
+ }
+ if ($LOCKED{$filename} == 1) {
+ unless (-l masterlockfile($filename)) {
+ # try to decrement the reference counter
+ #
+ set_ref($filename,-1,$timeout) and do {
+ delete $LOCKED{$filename};
+ return 1;
+ }
+ }
- # time out
- # maybe the system is occupied
- # or file has not been released yet
- #
- return;
+ # time out
+ return;
+ }
+ }
}
-### sub x_write_lock_file ($;$) ################################################
+### x_write_lock_file () #######################################################
#
# set write lock (exclusive lock)
# (symlinks possible)
sub x_write_lock_file ($;$) {
my $filename = shift;
my $timeout = shift || $Timeout;
+ my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
- unless (-l &masterlockfile($filename) and not $iAmMaster) {
+ unless (-l masterlockfile($filename) and not $iAmMaster) {
# announce the write lock
# and wait $timeout seconds for
# references == 0 (no shared locks set)
#
- &simple_lock ($filename,$timeout) or return;
- for (0..$timeout) {
+ simple_lock ($filename,$timeout) or return 0;
+ for (1..$timeout) {
# lock reference counter
# or fail
#
- unless (&simple_lock (&reffile($filename),$timeout)) {
- &simple_unlock($filename,$timeout);
- return;
+ unless (simple_lock (&reffile($filename),$timeout)) {
+ simple_unlock($filename,$timeout);
+ return 0;
}
# ready if we have no shared locks
#
- return 1 if (&get_ref ($filename) == 0);
+ if (get_ref ($filename) == $rest) {
+ $LOCKED{$filename} = 2 | ($rest ? 1 : 0);
+ return 1;
+ };
# release reference counter
# shared locks get the chance to be removed
#
- unless (&simple_unlock (&reffile($filename),$timeout)) {
- &simple_unlock($filename,$timeout);
- return;
+ unless (simple_unlock (&reffile($filename),$timeout)) {
+ simple_unlock($filename,$timeout);
+ return 0;
}
sleep(1);
}
# write lock failed
# remove the announcement
#
- &simple_unlock ($filename);}
+ simple_unlock ($filename);
+ }
else {
# master lock is set
0;
}
-### sub x_write_unlock_file ($;$) ##############################################
+### x_write_unlock_file () #####################################################
#
# remove write lock (exclusive lock)
# (symlinks possible)
unless (-l &masterlockfile($filename) and not $iAmMaster) {
# remove reference counter lock
#
- &simple_unlock (&reffile($filename),$timeout) or return;
+ simple_unlock (reffile($filename),$timeout) or return;
# remove the write lock announce
#
- &simple_unlock ($filename,$timeout) or return;
+ simple_unlock ($filename,$timeout) or return;
}
# done
+ delete $LOCKED{$filename};
1;
}
-### sub x_violent_unlock_file ($) ##############################################
+### x_violent_unlock_file () ###################################################
#
# remove any lock violent (excl. master lock)
# (symlinks possible)
if (-f ($reffile = $filename)) {
$time = (stat $reffile)[9];}
- elsif (-l ($reffile = &lockfile($filename))) {
+ 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
+ unlink (reffile($filename)); # reference counter = 0
+ simple_unlock (reffile($filename)); # release reference counter file
simple_unlock ($filename);} # release file
+ delete $LOCKED{$filename};
}
-### sub x_set_master_lock ($;$) ################################################
+### x_set_master_lock () #######################################################
#
# set master lock
# (symlinks possible)
# set exclusive lock or fail
#
- return unless (&write_lock_file ($filename,$timeout));
+ return unless (write_lock_file ($filename,$timeout));
# set master lock
#
- symlink $filename, &masterlockfile($filename) and return 1;
+ symlink $filename, masterlockfile($filename) and return 1;
# no chance (occupied?, master lock set yet?)
return;
}
-### sub x_release_file ($) #####################################################
+### x_release_file () ##########################################################
#
# remove any locks (incl. master lock)
# (symlinks possible)
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
+ 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
+ delete $LOCKED{$filename};
# 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 ($) {
- "$_[0].master";
+sub x_file_removed ($) {
+ release_file (shift);
}
-### sub w_simple_lock ($;$) ####################################################
-### sub w_simple_unlock ($) ####################################################
+### w_simple_lock () ###########################################################
+### w_simple_unlock () #########################################################
#
# simple file lock/unlock
# (for no-symlink-systems: kill/create lockfile)
my $lockfile = lockfile $filename;
local *LF;
- if (open(LF, "> $lockfile")) {
+ if (sysopen(LF, $lockfile, O_WRONLY|O_CREAT|O_TRUNC)) {
return 1 if close (LF);
}
return;
}
-### sub w_simple_lock ($;$) ####################################################
-### sub w_simple_unlock ($) ####################################################
+### x_simple_lock () ###########################################################
+### x_simple_unlock () #########################################################
#
# simple file lock/unlock
# (symlinks possible: create/unlink symlink)
}
# time out
- # locking failed (occupied?)
- #
return;
}
sub x_simple_unlock ($) {
my $filename=shift;
- unlink (&lockfile($filename)) and return 1;
+ unlink (lockfile $filename) and return 1;
# not able to unlink symlink, hmmm...
#
return;
}
-### sub w_set_ref ($$$) ########################################################
+### w_set_ref () ###############################################################
#
# add $_[1] to reference counter
# (may be negative...)
my $filename = shift;
my $z = shift;
my $timeout = shift || $Timeout;
- my $old;
- my $reffile = reffile $filename;
+ my $reffile = reffile $filename;
local *REF;
# if write lock announced, only count down allowed
#
- if ($z > 0) {
- return unless(-f lockfile($filename));
- }
+ ($z < 0 or -f lockfile ($filename)) or return;
# lock reference counter file
#
- return unless(&simple_lock ($reffile,$timeout));
+ simple_lock ($reffile,$timeout) or return;
# load reference counter
#
- unless (open REF,"<$reffile") {
- $old=0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF or return;
- }
+ my $old = get_ref ($filename);
# compute and write new ref. counter
#
# if ref. counter == 0
#
if ($old == 0) {
- unlink $reffile or return;
+ unlink $reffile or return;
}
else {
- open REF,">$reffile" or return;
- print REF $old or return;
- close REF or return;
+ local $\;
+ sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
+ print REF $old or do {
+ close REF;
+ return
+ };
+ close REF or return;
}
# release ref. counter file
#
- return unless(&simple_unlock($reffile));
+ simple_unlock($reffile) or return;
# done
1;
}
-### sub x_set_ref ($$$) ########################################################
+### x_set_ref () ###############################################################
#
# add $_[1] to reference counter
# (may be negative...)
my $filename = shift;
my $z = shift;
my $timeout = shift || $Timeout;
- my $old;
- my $reffile = reffile $filename;
+ my $reffile = reffile $filename;
local *REF;
# if write lock announced, only count down allowed
#
if ($z > 0) {
- return if(-l &lockfile($filename));
+ return if(-l lockfile($filename));
}
# lock reference counter file
#
- return unless(&simple_lock ($reffile,$timeout));
+ return unless(simple_lock ($reffile,$timeout));
# load reference counter
#
- unless (open REF,"<$reffile") {
- $old=0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF or return;
- }
+ my $old = get_ref ($filename);
# compute and write new ref. counter
#
$old += $z;
$old = 0 if ($old < 0);
+
if ($old == 0) {
- unlink $reffile or return;
+ unlink $reffile or return;
}
else {
- open REF,">$reffile" or return;
- print REF $old or return;
- close REF or return;
+ local $\;
+ sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
+ print REF $old or do {
+ close REF;
+ return
+ };
+ close REF or return;
}
# release ref. counter file
#
- return unless(&simple_unlock($reffile));
+ simple_unlock($reffile) or return;
# done
1;
}
-### sub get_ref ($) ############################################################
+### get_ref () #################################################################
#
# read out the reference counter
# (system independant)
#
# Return: reference counter
#
-sub get_ref ($$) {
+sub get_ref ($) {
my $filename = shift;
my $reffile = reffile $filename;
my $old;
local *REF;
+ local $/;
- unless (open REF,"< $reffile") {
- $old = 0;
- }
- else {
- $old=<REF>;
- chomp $old;
- close REF;
- }
+ sysopen (REF, $reffile, O_RDONLY) or return 0;
+ $old = <REF>;
+ close REF;
# return value
$old;
$iAmMaster = 0; # default: I am nobody
+ %LOCKED = ();
+
# assign the aliases to the needed functions
# (perldoc -f symlink)
*violent_unlock_file = \&x_violent_unlock_file;
*set_master_lock = \&x_set_master_lock;
*release_file = \&x_release_file;
+ *file_removed = \&x_file_removed;
*simple_lock = \&x_simple_lock;
*simple_unlock = \&x_simple_unlock;
*violent_unlock_file = \&w_violent_unlock_file;
*set_master_lock = \&w_set_master_lock;
*release_file = \&w_release_file;
+ *file_removed = \&w_file_removed;
*simple_lock = \&w_simple_lock;
*simple_unlock = \&w_simple_unlock;
}
}
-# keeping require happy
+# keep 'require' happy
1;
#
#
-### end of Lock ################################################################
+### end of Lock ################################################################
\ No newline at end of file
git.p6c8.net / selfforum.git / blobdiff