selfforum-cgi/shared/Lock/Unlink.pm

   1 package Lock::Unlink;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Lock/Unlink.pm                                           #
   6 #                                                                              #
   7 # Authors:     Andre Malo       <nd@o3media.de>, 2001-05-25                    #
   8 #                                                                              #
   9 # Description: Locking and Filehandle class                                    #
  10 #              using the atomic behavior of unlinkig files                     #
  11 #                                                                              #
  12 ################################################################################
  13
  14 use strict;
  15 use vars qw(
  16   $VERSION
  17 );
  18
  19 use Fcntl;
  20
  21 ################################################################################
  22 #
  23 # Version check
  24 #
  25 $VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  26
  27 ### sub _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 ### sub _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 ### sub _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 ### sub 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 ### sub 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 ### sub 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 # keep 'require' happy
 120 1;
 121
 122 #
 123 #
 124 ### end of Lock::Unlink ########################################################