added version check and comments

[selfforum.git] / selfforum-cgi / shared / Lock.pm

diff --git a/selfforum-cgi/shared/Lock.pm b/selfforum-cgi/shared/Lock.pm
index b1e42d37120dff29660152d1f7ca0f8da205e763..88f9a5a8f27ec00f62ef1bd3f07f95547e407ba7 100644 (file)
--- a/selfforum-cgi/shared/Lock.pm
+++ b/selfforum-cgi/shared/Lock.pm
@@ -1,590 +1,845 @@
-# Lock.pm
-
-# ====================================================
-# Autor: n.d.p. / 2001-01-04
-# lm   : n.d.p. / 2000-01-05
-# ====================================================
-# Funktion:
-#      Sperren einer Datei
-# ====================================================
-
-use strict;
-

 package Lock;
 
 package Lock;
 

-use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $Timeout $violentTimeout $masterTimeout $iAmMaster);
+################################################################################
+#                                                                              #
+# File:        shared/Lock.pm                                                  #
+#                                                                              #
+# Authors:     Andre Malo       <nd@o3media.de>, 2001-04-01                    #
+#                                                                              #
+# Description: file locking                                                    #
+#                                                                              #
+################################################################################

 
 

-# ====================================================
-# Funktionsexport
-# ====================================================
-
-require Exporter;
-@ISA         = qw(Exporter);
-
-@EXPORT_OK   = qw(lock_file unlock_file write_lock_file write_unlock_file
-                  violent_unlock_file set_master_lock release_file);
+use strict;
+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_TAGS = (READ  => [qw(lock_file unlock_file violent_unlock_file)],
-                WRITE => [qw(write_lock_file 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)]);
+################################################################################
+#
+# Export
+#
+use base qw(Exporter);
+
+@EXPORT_OK   = qw(
+  lock_file
+  unlock_file
+  write_lock_file
+  write_unlock_file
+  violent_unlock_file
+  set_master_lock
+  release_file
+  file_removed
+);
+
+%EXPORT_TAGS = (
+  READ  => [qw(
+    lock_file
+    unlock_file
+    violent_unlock_file
+  )],
+  WRITE => [qw(
+    write_lock_file
+    write_unlock_file
+    violent_unlock_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)
 # Windows section (no symlinks)

-# ====================================================
-
-################################
-# sub w_lock_file

 #
 #

-# Schreibsperre setzen
-################################

 
 

+### w_lock_file () #############################################################
+#
+# set read lock (shared lock)
+# (for no-symlink-systems)
+#
+# Params: $filename - file to lock
+#         $timeout  - Lock Timeout (sec.)
+#
+# Return: Status Code (Bool)
+#

 sub w_lock_file ($;$) {
 sub w_lock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-  my $i;
-
-  if (-f &masterlockfile($filename)) {
-
-    for ($i=0 ; $i<=$timeout ; $i++) {
-      # Referenzzaehler um eins erhoehen
-      &set_ref($filename,1,$timeout) and return 1;
-      sleep (1);}}
-
-  else {
-    # Mastersperre
-    return undef;}
+  my $filename = shift;
+  my $timeout  = +shift || $Timeout;
+
+  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;
+    }
+  }

 
 

-  0; # Mist
+  # time out
+  # maybe the system is occupied
+  0;

 }
 
 }
 

-################################
-# sub w_unlock_file
+### w_unlock_file () ###########################################################
+#
+# remove read lock (shared lock)
+# (for no-symlink-systems)
+#
+# Params: $filename - locked file
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Schreibsperre aufheben
-################################
-

 sub w_unlock_file ($;$) {
 sub w_unlock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-
-  if (-f &masterlockfile($filename)) {
-    # Referenzzaehler um eins erniedrigen
-    &set_ref($filename,-1,$timeout) and return 1;}
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+
+  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;
+        }
+      }
+    }
+  }

 
 

-  0; # Mist
+  # time out
+  return;

 }
 
 }
 

-################################
-# sub w_write_lock_file
+### w_write_lock_file () #######################################################
+#
+# set write lock (exclusive lock)
+# (for no-symlink-systems)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Lese- und Schreibsperre
-# setzen
-################################
-

 sub w_write_lock_file ($;$) {
   my $filename=shift;
 sub w_write_lock_file ($;$) {
   my $filename=shift;

-  my ($timeout)=(shift (@_) or $Timeout);
-
-  if (-f &masterlockfile($filename) or $iAmMaster) {
-    # bevorstehenden Schreibzugriff anmelden
-    &simple_lock ($filename,$timeout) or return 0;
-
-    my $i;
-    for ($i=0 ; $i<=$timeout ; $i++) {
-      # Referenzdatei sperren
-      &simple_lock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
-
-      # Referenzzaehler = 0 ? => okay
-      return 1 if (&get_ref ($filename) == 0);
-
-      # Referenzdatei wieder freigeben
-      &simple_unlock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
-      sleep(1);}
-
-    &simple_unlock ($filename);}
+  my $timeout= shift || $Timeout;
+  my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
+
+  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 0;
+    for (1..$timeout) {
+      # lock reference counter
+      # or fail
+      #
+      unless (simple_lock (reffile($filename),$timeout)) {
+        simple_unlock($filename,$timeout);
+        return 0;
+      }
+
+      # ready if we have no shared locks
+      #
+      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 0;
+      }
+      sleep(1);
+    }
+
+    # write lock failed
+    # remove the announcement
+    #
+    simple_unlock ($filename);
+  }

 
   else {
 
   else {

-    # Mastersperre gesetzt
-    return undef;}
+    # master lock is set or file has not been released yet
+    return;
+  }

 
 

-  0; # Mist
+  # time out
+  0;

 }
 
 }
 

-################################
-# sub w_write_unlock_file
+### w_write_unlock_file () #####################################################
+#
+# remove write lock (exclusive lock)
+# (for no-symlink-systems)
+#
+# Params: $filename - locked file
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Lese- und Schreibsperre
-# aufheben
-################################
-

 sub w_write_unlock_file ($;$) {
 sub w_write_unlock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+
+  if (-f masterlockfile($filename) or $iAmMaster) {

 
 

-  if (-f &masterlockfile($filename) or $iAmMaster) {
-    &simple_unlock (&reffile($filename),$timeout) or return 0; # Referenzdatei freigeben
-    &simple_unlock ($filename,$timeout) or return 0;}          # Lesesperre aufheben
+    # remove reference counter lock
+    #
+    simple_unlock (reffile($filename),$timeout) or return;

 
 

-  1; # jawoll!
+    # remove the write lock announce
+    #
+    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)
+#
+# Params: $filename - locked file
+#
+# Return: -none- (the success is not defined)

 #
 #

-# Sperre brutal aufheben
-################################
-

 sub w_violent_unlock_file ($) {
 sub w_violent_unlock_file ($) {

-  my $filename=shift;
+  my $filename = shift;

 
 

-  if (-f &masterlockfile($filename)) {
+  if (-f masterlockfile($filename)) {

 
 

-    # Zeit der letzten Modifikation feststellen
-    # und abbrechen, wenn meine Zeit noch nicht gekommen ist
+    # find out last modification time
+    # and do nothing unless 'violent-timout' is over
+    #

     my $reffile;
     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];
       my $time = (stat $reffile)[9];

-      return if ((time - $time) < $violentTimeout);}
+      (time - $time) >= $violentTimeout   or return;
+    }

 
 

-    write_lock_file ($filename,1);       # letzter Versuch, exklusiven Zugriff zu bekommen
-    unlink (&reffile($filename));        # Referenzzaehler auf null
-    simple_unlock (&reffile($filename)); # Referenzdatei freigeben
-    simple_unlock ($filename);}          # Datei freigeben (Lesesperre aufheben)
+    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
+    delete $LOCKED{$filename};
+
+  return;

 }
 
 }
 

-################################
-# sub w_set_master_lock
+### w_set_master_lock () #######################################################
+#
+# set master lock
+# (for no-symlink-systems)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Mastersperre setzen
-################################
-

 sub w_set_master_lock ($;$) {
 sub w_set_master_lock ($;$) {

-  my $filename=shift;
-  my $timeout=(shift @_ or $masterTimeout);
+  my $filename = shift;
+  my $timeout  = shift || $masterTimeout;

 
 

-  # exklusiven Zugriff erlangen...oder abbrechen
-  return 0 unless (&write_lock_file ($filename,$timeout));
+  # set exclusive lock or fail
+  #
+  return unless (write_lock_file ($filename,$timeout));

 
 

-  # Mastersperre setzen und Erfolg melden
-  unlink &masterlockfile($filename) and return 1;
+  # set master lock
+  #
+  unlink masterlockfile($filename)    and return 1;

 
 

-  0; # Mist
+  # 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)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Alle Sperren inkl. Master-
-# sperre aufheben
-################################
-

 sub w_release_file ($) {
   my $filename=shift;
 
 sub w_release_file ($) {
   my $filename=shift;
 

-  unlink (&reffile($filename));                              # Referenzzaehler auf null
-  return 0 if (-f &reffile($filename));                      # wirklich?
-  return 0 unless (simple_unlock (&reffile($filename)));     # Referenzzaehler freigeben
-  return 0 unless (&simple_unlock ($filename));              # Datei selbst freigeben (Lesesperre)
-  return 0 unless (&simple_unlock (&masterfile($filename))); # Mastersperre aufheben
+  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};

 
 

-  1; # jup
+  # done
+  1;

 }
 
 }
 

-# ====================================================
-# *n*x section (symlinks possible)
-# ====================================================
+sub w_file_removed ($) {
+  my $filename = shift;

 
 

-################################
-# sub x_lock_file
+  unlink reffile($filename);
+  unlink lockfile($filename);
+  unlink lockfile(reffile($filename));
+  unlink masterlockfile($filename);
+}
+
+################################################################################
+#
+# *n*x section (symlinks possible)

 #
 #

-# Schreibsperre setzen
-################################

 
 

+### x_lock_file () #############################################################
+#
+# set read lock (shared lock)
+# (symlinks possible)
+#
+# Params: $filename - file to lock
+#         $timeout  - Lock Timeout (sec.)
+#
+# Return: Status Code (Bool)
+#

 sub x_lock_file ($;$) {
 sub x_lock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-  my $i;
-
-  unless (-l &masterlockfile($filename)) {
-
-    for ($i=0 ; $i<=$timeout ; $i++) {
-      # Referenzzaehler um eins erhoehen
-      &set_ref($filename,1,$timeout) and return 1;
-      sleep (1);}}
-
-  else {
-    # Mastersperre
-    return undef;}
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+
+  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;
+    }
+  }

 
 

-  0; # Mist
+  # time out
+  0;

 }
 
 }
 

-################################
-# sub x_unlock_file
+### x_unlock_file () ###########################################################
+#
+# remove read lock (shared lock)
+# (symlinks possible)
+#
+# Params: $filename - locked file
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Schreibsperre aufheben
-################################
-

 sub x_unlock_file ($;$) {
   my $filename=shift;
   my ($timeout)=(shift (@_) or $Timeout);
 
 sub x_unlock_file ($;$) {
   my $filename=shift;
   my ($timeout)=(shift (@_) or $Timeout);
 

-  unless (-l &masterlockfile($filename)) {
-    # Referenzzaehler um eins erniedrigen
-    &set_ref($filename,-1,$timeout) and return 1;}
-
-  0; # Mist
+  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
+      return;
+    }
+  }

 }
 
 }
 

-################################
-# sub x_write_lock_file
+### x_write_lock_file () #######################################################
+#
+# set write lock (exclusive lock)
+# (symlinks possible)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Lese- und Schreibsperre
-# setzen
-################################
-

 sub x_write_lock_file ($;$) {
 sub x_write_lock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-
-  unless (-l &masterlockfile($filename) and not $iAmMaster) {
-    # bevorstehenden Schreibzugriff anmelden
-    &simple_lock ($filename,$timeout) or return 0;
-
-    my $i;
-    for ($i=0 ; $i<=$timeout ; $i++) {
-      # Referenzdatei sperren
-      &simple_lock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
-
-      # Referenzzaehler = 0 ? => okay
-      return 1 if (&get_ref ($filename) == 0);
-
-      # Referenzdatei wieder freigeben
-      &simple_unlock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
-      sleep(1);}
-
-    &simple_unlock ($filename);}
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+  my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
+
+  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 0;
+    for (1..$timeout) {
+
+      # lock reference counter
+      # or fail
+      #
+      unless (simple_lock (&reffile($filename),$timeout)) {
+        simple_unlock($filename,$timeout);
+        return 0;
+      }
+
+      # ready if we have no shared locks
+      #
+      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 0;
+      }
+      sleep(1);
+    }
+
+    # write lock failed
+    # remove the announcement
+    #
+    simple_unlock ($filename);
+  }

 
   else {
 
   else {

-    # Mastersperre gesetzt
-    return undef;}
+    # master lock is set
+    # or file has not been released yet
+    #
+    return;
+  }

 
 

-  0; # Mist
+  # time out
+  # maybe the system is occupied
+  #
+  0;

 }
 
 }
 

-################################
-# sub x_write_unlock_file
+### x_write_unlock_file () #####################################################
+#
+# remove write lock (exclusive lock)
+# (symlinks possible)
+#
+# Params: $filename - locked file
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Lese- und Schreibsperre
-# aufheben
-################################
-

 sub x_write_unlock_file ($;$) {
 sub x_write_unlock_file ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;

 
   unless (-l &masterlockfile($filename) and not $iAmMaster) {
 
   unless (-l &masterlockfile($filename) and not $iAmMaster) {

-    &simple_unlock (&reffile($filename),$timeout) or return 0; # Referenzdatei freigeben
-    &simple_unlock ($filename,$timeout) or return 0;}          # Lesesperre aufheben
+    # remove reference counter lock
+    #
+    simple_unlock (reffile($filename),$timeout) or return;
+
+    # remove the write lock announce
+    #
+    simple_unlock ($filename,$timeout) or return;
+  }

 
 

-  1; # jawoll!
+  # done
+  delete $LOCKED{$filename};
+  1;

 }
 
 }
 

-################################
-# sub x_violent_unlock_file
+### x_violent_unlock_file () ###################################################
+#
+# remove any lock violent  (excl. master lock)
+# (symlinks possible)
+#
+# Params: $filename - locked file
+#
+# Return: -none- (the success is not defined)

 #
 #

-# Sperre brutal aufheben
-################################
-

 sub x_violent_unlock_file ($) {
   my $filename=shift;
 
   unless (-l &masterlockfile($filename)) {
 
 sub x_violent_unlock_file ($) {
   my $filename=shift;
 
   unless (-l &masterlockfile($filename)) {
 

-    # Zeit der letzten Modifikation feststellen
-    # und abbrechen, wenn meine Zeit noch nicht gekommen ist
+    # find out last modification time
+    # and do nothing unless 'violent-timout' is over
+    #

     my ($reffile,$time);
 
     if (-f ($reffile = $filename)) {
       $time = (stat $reffile)[9];}
 
     my ($reffile,$time);
 
     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);}
 
       $time = (lstat $reffile)[9];}
 
     if ($reffile) {
       return if ((time - $time) < $violentTimeout);}
 

-    write_lock_file ($filename,1);       # letzter Versuch, exklusiven Zugriff zu bekommen
-    unlink (&reffile($filename));        # Referenzzaehler auf null
-    simple_unlock (&reffile($filename)); # Referenzdatei freigeben
-    simple_unlock ($filename);}          # Datei freigeben (Lesesperre aufheben)
+    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
+    delete $LOCKED{$filename};

 }
 
 }
 

-################################
-# sub x_set_master_lock
+### x_set_master_lock () #######################################################
+#
+# set master lock
+# (symlinks possible)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Mastersperre setzen
-################################
-

 sub x_set_master_lock ($;$) {
 sub x_set_master_lock ($;$) {

-  my $filename=shift;
-  my $timeout=(shift @_ or $masterTimeout);
+  my $filename = shift;
+  my $timeout  = shift || $masterTimeout;

 
 

-  # exklusiven Zugriff erlangen...oder abbrechen
-  return 0 unless (&write_lock_file ($filename,$timeout));
+  # set exclusive lock or fail
+  #
+  return unless (write_lock_file ($filename,$timeout));

 
 

-  # Mastersperre setzen und Erfolg melden
-  symlink $filename, &masterlockfile($filename) and return 1;
+  # set master lock
+  #
+  symlink $filename, masterlockfile($filename) and return 1;

 
 

-  0; # Mist
+  # no chance (occupied?, master lock set yet?)
+  return;

 }
 
 }
 

-################################
-# sub x_release_file
+### x_release_file () ##########################################################
+#
+# remove any locks (incl. master lock)
+# (symlinks possible)
+#
+# Params: $filename - file to lock
+#         $timeout  - timeout (sec.)
+#
+# Return: Status Code (Bool)

 #
 #

-# Alle Sperren inkl. Master-
-# sperre aufheben
-################################
-

 sub x_release_file ($) {
   my $filename=shift;
 
 sub x_release_file ($) {
   my $filename=shift;
 

-  unlink (&reffile($filename));                              # Referenzzaehler auf null
-  return 0 if (-f &reffile($filename));                      # wirklich?
-  return 0 unless (simple_unlock (&reffile($filename)));     # Referenzzaehler freigeben
-  return 0 unless (&simple_unlock ($filename));              # Datei selbst freigeben (Lesesperre)
-  return 0 unless (&simple_unlock (&masterfile($filename))); # Mastersperre aufheben
+  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};

 
 

-  1; # jup
+  # done
+  1;

 }
 
 }
 

-# ====================================================
-# private subs
-# ====================================================
-
-################################
-# Dateinamen
-################################
-
-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);

 }
 
 }
 

-################################
-# einfaches Sperren/Entsperren
-# Windows
+### w_simple_lock () ###########################################################
+### 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)

 #
 #

-# (Lockdatei loeschen)
-################################
-

 sub w_simple_lock ($;$) {
 sub w_simple_lock ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-  my $lockfile=&lockfile($filename);
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+  my $lockfile = lockfile $filename;

 
 

-  my $i;
-  for ($i=$timeout; $i>=0; $i--) {
-    unlink("$lockfile") and return 1;
-    sleep(1);}
+  for (0..$timeout) {
+    unlink $lockfile and return 1;
+    sleep(1);
+  }

 
 

-  0; # Mist
+  # timeout
+  # occupied?
+  return;

 }
 
 sub w_simple_unlock ($) {
 }
 
 sub w_simple_unlock ($) {

-  my $filename=shift;
-  my $lockfile=&lockfile($filename);
-  my $flag=1;
+  my $filename = shift;
+  my $lockfile = lockfile $filename;

   local *LF;
 
   local *LF;
 

-  open(LF, ">$lockfile") or $flag=0;
-  close(LF) or $flag=0;
+  if (sysopen(LF, $lockfile, O_WRONLY|O_CREAT|O_TRUNC)) {
+    return 1 if close (LF);
+  }

 
 

-  # Rueckgabe
-  $flag;
+  # not able to create lockfile, hmmm...
+  #
+  return;

 }
 
 }
 

-################################
-# einfaches Sperren/Entsperren
-# *n*x
+### x_simple_lock () ###########################################################
+### x_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)

 #
 #

-# (symlink setzen)
-################################
-

 sub x_simple_lock ($;$) {
 sub x_simple_lock ($;$) {

-  my $filename=shift;
-  my ($timeout)=(shift (@_) or $Timeout);
-  my $lockfile=&lockfile($filename);
+  my $filename = shift;
+  my $timeout  = shift || $Timeout;
+  my $lockfile = lockfile $filename;

 
 

-  my $i;
-  for ($i=$timeout; $i>=0; $i--) {
+  for (0..$timeout) {

     symlink $filename,$lockfile and return 1;
     symlink $filename,$lockfile and return 1;

-    sleep(1);}
+    sleep(1);
+  }

 
 

-  0; # Mist
+  # time out
+  return;

 }
 
 sub x_simple_unlock ($) {
   my $filename=shift;
 
 }
 
 sub x_simple_unlock ($) {
   my $filename=shift;
 

-  unlink (&lockfile($filename)) and return 1;
+  unlink (lockfile $filename) and return 1;

 
 

-  0; # hmmm...
+  # not able to unlink symlink, hmmm...
+  #
+  return;

 }
 
 }
 

-################################
-# sub w_set_ref
-# Windows
+### 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)

 #
 #

-# Referenzzaehler um $_[1]
-# erhoehen
-# (kann auch negativ sein...)
-################################
-

 sub w_set_ref ($$$) {
 sub w_set_ref ($$$) {

-  my ($filename,$z)=@_;
-  my $timeout=(shift @_ or $Timeout);
-  my $old;
-  my $reffile=&reffile($filename);
+  my $filename = shift;
+  my $z        = shift;
+  my $timeout  = shift || $Timeout;
+  my $reffile  = reffile $filename;

   local *REF;
 
   local *REF;
 

+  # if write lock announced, only count down allowed
+  #
+  ($z < 0 or -f lockfile ($filename))                     or return;

 
 

-  # runterzaehlen - ja, neue Leseversuche - nein
-  if ($z > 0) {
-    return 0 unless(-e &lockfile($filename));}
+  # lock reference counter file
+  #
+  simple_lock ($reffile,$timeout)                         or return;

 
 

-  # Referenzdatei locken
-  return 0 unless(&simple_lock ($reffile,$timeout));
+  # load reference counter
+  #
+  my $old = get_ref ($filename);

 
 

-  # Referenzdatei auslesen
-  unless (open REF,"<$reffile") {
-    $old=0;}
-  else {
-    $old=<REF>;
-    chomp $old;
-    close REF or return 0;}
-
-  # Neuen Referenzwert schreiben
-  $old+=$z;
-  $old=0 if ($old < 0);
-  if ($old == 0)
-  {
-    unlink $reffile or return 0;
+  # 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 0;
-    print REF $old or return 0;
-    close REF or return 0;
+  else {
+    local $\;
+    sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
+    print REF $old                                        or do {
+                                                            close REF;
+                                                            return
+                                                          };
+    close REF                                             or return;

   }
 
   }
 

-  # wieder entsperren
-  return 0 unless(&simple_unlock($reffile));
+  # release ref. counter file
+  #
+  simple_unlock($reffile)                                 or return;

 
 

+  # done

   1;
 }
 
   1;
 }
 

-################################
-# sub x_set_ref
-# *n*x
+### 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)

 #
 #

-# Referenzzaehler um $_[1]
-# erhoehen
-# (kann auch negativ sein...)
-################################
-

 sub x_set_ref ($$$) {
 sub x_set_ref ($$$) {

-  my ($filename,$z)=@_;
-  my $timeout=(shift @_ or $Timeout);
-  my $old;
-  my $reffile=&reffile($filename);
+  my $filename = shift;
+  my $z        = shift;
+  my $timeout  = shift || $Timeout;
+  my $reffile  = reffile $filename;

   local *REF;
 
   local *REF;
 

-
-  # runterzaehlen - ja, neue Leseversuche - nein
+  # if write lock announced, only count down allowed
+  #

   if ($z > 0) {
   if ($z > 0) {

-    return 0 if(-l &lockfile($filename));}
+    return if(-l lockfile($filename));
+  }

 
 

-  # Referenzdatei locken
-  return 0 unless(&simple_lock ($reffile,$timeout));
+  # lock reference counter file
+  #
+  return unless(simple_lock ($reffile,$timeout));

 
 

-  # Referenzdatei auslesen
-  unless (open REF,"<$reffile") {
-    $old=0;}
-  else {
-    $old=<REF>;
-    chomp $old;
-    close REF or return 0;}
+  # load reference counter
+  #
+  my $old = get_ref ($filename);

 
 

-  # Neuen Referenzwert schreiben
+  # compute and write new ref. counter
+  #

   $old += $z;
   $old = 0 if ($old < 0);
   $old += $z;
   $old = 0 if ($old < 0);

-  if ($old == 0)
-  {
-    unlink $reffile or return 0;
+
+  if ($old == 0) {
+    unlink $reffile                                       or return;

   }
   }

-  else
-  {
-    open REF,">$reffile" or return 0;
-    print REF $old or return 0;
-    close REF or return 0;
+  else {
+    local $\;
+    sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
+    print REF $old                                        or do {
+                                                            close REF;
+                                                            return
+                                                          };
+    close REF                                             or return;

   }
 
   }
 

-  # wieder entsperren
-  return 0 unless(&simple_unlock($reffile));
+  # release ref. counter file
+  #
+  simple_unlock($reffile)                                 or return;

 
 

+  # done

   1;
 }
 
   1;
 }
 

-################################
-# sub get_ref
+### get_ref () #################################################################

 #
 #

-# Referenzzaehler auslesen
+# read out the reference counter
+# (system independant)
+# no locking here!

 #
 #

-# Das Locking muss an
-# anderer Stelle ausgefuehrt
-# werden!
-################################
-
-sub get_ref ($$) {
-  my $filename=shift;
-  my $reffile=&reffile($filename);
+# 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;
   my $old;
   local *REF;

+  local $/;

 
 

-  unless (open REF,"<$reffile") {
-    $old=0;}
-  else {
-    $old=<REF>;
-    chomp $old;
-    close REF or return 0;}
+  sysopen (REF, $reffile, O_RDONLY)    or return 0;
+    $old = <REF>;
+  close REF;

 
 

-  # Rueckgabe
+  # return value

   $old;
 }
 
   $old;
 }
 

-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
+################################################################################
+#
+# initializing the module
+#

 BEGIN {
 BEGIN {

-  # Globale Variablen (Zeiten in Sekunden)
-  $Timeout        =  10; # normaler Timeout
-  $violentTimeout = 600; # zum gewaltsamen Entsperren (10 Minuten)
-  $masterTimeout  =  20; # fuer die Mastersperre
+  # global variables (time in seconds)
+  #
+  $Timeout        =  10; # normal timeout
+  $violentTimeout = 600; # violent timeout (10 minutes)
+  $masterTimeout  =  20; # master timeout
+
+  $iAmMaster = 0;        # default: I am nobody

 
 

-  $iAmMaster = 0;        # erstmal bin ich kein Master :-)
+  %LOCKED = ();

 
 

-  # wirkliche Funktionen ihren Bezeichnern zuweisen
+  # assign the aliases to the needed functions

   # (perldoc -f symlink)
 
   if ( eval {local $SIG{__DIE__}; symlink('',''); 1 } ) {
   # (perldoc -f symlink)
 
   if ( eval {local $SIG{__DIE__}; symlink('',''); 1 } ) {


@@ -595,10 +850,12 @@ BEGIN {
     *violent_unlock_file = \&x_violent_unlock_file;
     *set_master_lock     = \&x_set_master_lock;
     *release_file        = \&x_release_file;
     *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;
 
     *simple_lock         = \&x_simple_lock;
     *simple_unlock       = \&x_simple_unlock;

-    *set_ref             = \&x_set_ref;}
+    *set_ref             = \&x_set_ref;
+  }

 
   else {
     *lock_file           = \&w_lock_file;
 
   else {
     *lock_file           = \&w_lock_file;


@@ -608,15 +865,17 @@ BEGIN {
     *violent_unlock_file = \&w_violent_unlock_file;
     *set_master_lock     = \&w_set_master_lock;
     *release_file        = \&w_release_file;
     *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;
 
     *simple_lock         = \&w_simple_lock;
     *simple_unlock       = \&w_simple_unlock;

-    *set_ref             = \&w_set_ref;}
+    *set_ref             = \&w_set_ref;
+  }

 }
 
 }
 

-# making require happy
+# keep 'require' happy

 1;
 
 1;
 

-# ====================================================
-# end of Lock
-# ====================================================
\ No newline at end of file
+#
+#
+### end of Lock ################################################################
\ No newline at end of file