selfforum-cgi/shared/Lock/Unlink.pm

   1 package Lock::Unlink;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Lock/Unlink.pm                                           #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>                                      #
   8 #                                                                              #
   9 # Description: Locking and Filehandle class                                    #
  10 #              using the atomic behavior of unlinkig files                     #
  11 #                                                                              #
  12 ################################################################################
  13
  14 use strict;
  15 use Fcntl;
  16
  17 ################################################################################
  18 #
  19 # Version check
  20 #
  21 # last modified:
  22 #    $Date$ (GMT)
  23 # by $Author$
  24 #
  25 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
  26
  27 ### _simple_lock () ############################################################
  28 #
  29 # simple file lock
  30 # (unlink lock file)
  31 #
  32 # Params: $filename - file to lock
  33 #         $timeout  - timeout
  34 #
  35 # Return: success (boolean)
  36 #
  37 sub _simple_lock {
  38   my ($self, $fh) = @_;
  39
  40   unlink $fh -> filename and return 1;
  41
  42   return;
  43 }
  44
  45 ### _simple_unlock () ##########################################################
  46 #
  47 # simple file unlock
  48 # (create lock file)
  49 #
  50 # Params: $filename - lockfile name
  51 #                     ^^^^^^^^
  52 #
  53 # Return: success (boolean)
  54 #
  55 sub _simple_unlock {
  56   my ($self, $filename) = @_;
  57   local *LF;
  58
  59   sysopen (LF, $filename, O_WRONLY | O_CREAT | O_TRUNC)
  60     and close LF
  61     and return 1;
  62
  63   # not able to create lock file, hmmm...
  64   #
  65   return;
  66 }
  67
  68 ### _reftime () ################################################################
  69 #
  70 # determine reference time for violent unlock
  71 #
  72 # Params: ~none~
  73 #
  74 # Return: time or zero, if no reference file found
  75 #
  76 sub _reftime {
  77   my $self = shift;
  78   my ($time, $reffile) = 0;
  79
  80   if (-f ($reffile = $self -> filename)) {
  81     $time = (stat $reffile)[9];}
  82
  83   elsif (-f ($reffile = $self -> lockfile)) {
  84     $time = (stat $reffile)[9];}
  85
  86   $time;
  87 }
  88
  89 ### masterlocked () ############################################################
  90 #
  91 # check on master lock status of the file
  92 #
  93 # Params: ~none~
  94 #
  95 # Return: status (boolean)
  96 #
  97 sub masterlocked {not -f shift -> masterlock}
  98
  99 ### excl_announced () ##########################################################
 100 #
 101 # check on exclusive lock announced status of the file
 102 #
 103 # Params: ~none~
 104 #
 105 # Return: status (boolean)
 106 #
 107 sub excl_announced {not -f shift -> lockfile}
 108
 109 ### exsh_announced () ##########################################################
 110 #
 111 # check on exclusive shared lock status of the file
 112 #
 113 # Params: ~none~
 114 #
 115 # Return: status (boolean)
 116 #
 117 sub exsh_announced {not -f shift -> exshlock}
 118
 119 ### purge () ###################################################################
 120 #
 121 # cover our traces after a file was removed
 122 #
 123 # Params: ~none~
 124 #
 125 # Return: ~none~
 126 #
 127 sub purge {
 128   my $self = shift;
 129
 130   $self -> set_ref (0);          # reference counter = 0
 131   unlink ($self -> reflock);     # remove reference counter lock
 132   unlink ($self -> lockfile);    # remove any write lock announce
 133   unlink ($self -> exshlock);    # remove any excl shared lock
 134   unlink ($self -> masterlock);  # remove master lock
 135
 136   return;
 137 }
 138
 139 # keep 'require' happy
 140 1;
 141
 142 #
 143 #
 144 ### end of Lock::Unlink ########################################################