]>
git.p6c8.net - selfforum.git/blob - selfforum-cgi/shared/Lock.pm
3 ################################################################################
5 # File: shared/Lock.pm #
7 # Authors: Andre Malo <nd@o3media.de>, 2001-04-01 #
9 # Description: file locking #
11 ################################################################################
27 ################################################################################
31 use base
qw(Exporter);
58 ### sub ~file ($) ##############################################################
60 # create lock file names
63 return $_[0].'.lock.ref';
69 return $_[0].'.master';
71 sub masterlockfile
($) {
72 return lockfile
(masterfile
$_[0]);
75 ################################################################################
77 # Windows section (no symlinks)
80 ### sub w_lock_file ($;$) ######################################################
82 # set read lock (shared lock)
83 # (for no-symlink-systems)
85 # Params: $filename - file to lock
86 # $timeout - Lock Timeout (sec.)
88 # Return: Status Code (Bool)
90 sub w_lock_file
($;$) {
92 my $timeout = +shift || $Timeout;
94 unless ($LOCKED{$filename}) {
95 if (-f masterlockfile
($filename)) {
98 # try to increment the reference counter
100 if (set_ref
($filename,1,$timeout)) {
101 $LOCKED{$filename}=1;
108 # master lock is set or file has not been released yet
114 # maybe the system is occupied
118 ### sub w_unlock_file ($;$) ####################################################
120 # remove read lock (shared lock)
121 # (for no-symlink-systems)
123 # Params: $filename - locked file
124 # $timeout - timeout (sec.)
126 # Return: Status Code (Bool)
128 sub w_unlock_file
($;$) {
129 my $filename = shift;
130 my $timeout = shift || $Timeout;
132 if ($LOCKED{$filename}) {
133 if ($LOCKED{$filename} == 3) {
134 return unless write_unlock_file
($filename, $timeout);
135 $LOCKED{$filename} = 1;
137 if ($LOCKED{$filename} == 1) {
138 if (-f masterlockfile
($filename)) {
140 # try do decrement the reference counter
142 if (set_ref
($filename, -1, $timeout)) {
143 delete $LOCKED{$filename};
154 ### sub w_write_lock_file ($;$) ################################################
156 # set write lock (exclusive lock)
157 # (for no-symlink-systems)
159 # Params: $filename - file to lock
160 # $timeout - timeout (sec.)
162 # Return: Status Code (Bool)
164 sub w_write_lock_file
($;$) {
166 my $timeout= shift || $Timeout;
167 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ?
1 : 0;
169 if (-f masterlockfile
($filename) or $iAmMaster) {
171 # announce the write lock
172 # and wait $timeout seconds for
173 # references == 0 (no shared locks set)
175 simple_lock
($filename,$timeout) or return 0;
177 # lock reference counter
180 unless (simple_lock
(reffile
($filename),$timeout)) {
181 simple_unlock
($filename,$timeout);
185 # ready if we have no shared locks
187 if (get_ref
($filename) == $rest) {
188 $LOCKED{$filename} = 2 | ($rest ?
1 : 0);
192 # release reference counter
193 # shared locks get the chance to be removed
195 unless (simple_unlock
(reffile
($filename),$timeout)) {
196 simple_unlock
($filename,$timeout);
203 # remove the announcement
205 simple_unlock
($filename);
209 # master lock is set or file has not been released yet
217 ### sub w_write_unlock_file ($;$) ##############################################
219 # remove write lock (exclusive lock)
220 # (for no-symlink-systems)
222 # Params: $filename - locked file
223 # $timeout - timeout (sec.)
225 # Return: Status Code (Bool)
227 sub w_write_unlock_file
($;$) {
228 my $filename = shift;
229 my $timeout = shift || $Timeout;
231 if (-f masterlockfile
($filename) or $iAmMaster) {
233 # remove reference counter lock
235 simple_unlock
(reffile
($filename),$timeout) or return;
237 # remove the write lock announce
239 simple_unlock
($filename,$timeout) or return;
243 delete $LOCKED{$filename};
247 ### sub w_violent_unlock_file ($) ##############################################
249 # remove any lock violent (excl. master lock)
250 # (for no-symlink-systems)
252 # Params: $filename - locked file
254 # Return: -none- (the success is not defined)
256 sub w_violent_unlock_file
($) {
257 my $filename = shift;
259 if (-f masterlockfile
($filename)) {
261 # find out last modification time
262 # and do nothing unless 'violent-timout' is over
265 if (-f
($reffile = $filename) or -f
($reffile = lockfile
($filename))) {
266 my $time = (stat $reffile)[9];
267 (time - $time) >= $violentTimeout or return;
270 write_lock_file
($filename,1); # last try, to set an exclusive lock on $filename
271 unlink (reffile
($filename)); # reference counter = 0
272 simple_unlock
(reffile
($filename)); # release reference counter file
273 simple_unlock
($filename);} # release file
274 delete $LOCKED{$filename};
279 ### sub w_set_master_lock ($;$) ################################################
282 # (for no-symlink-systems)
284 # Params: $filename - file to lock
285 # $timeout - timeout (sec.)
287 # Return: Status Code (Bool)
289 sub w_set_master_lock
($;$) {
290 my $filename = shift;
291 my $timeout = shift || $masterTimeout;
293 # set exclusive lock or fail
295 return unless (write_lock_file
($filename,$timeout));
299 unlink masterlockfile
($filename) and return 1;
301 # no chance (occupied?, master lock set yet?)
305 ### sub w_release_file ($) #####################################################
307 # remove any locks (incl. master lock)
308 # (for no-symlink-systems)
310 # Params: $filename - file to lock
311 # $timeout - timeout (sec.)
313 # Return: Status Code (Bool)
315 sub w_release_file
($) {
318 unlink (reffile
($filename)); # reference counter = 0
319 return if (-f reffile
($filename)); # really?
320 return unless (simple_unlock
(reffile
($filename))); # release reference counter
321 return unless (simple_unlock
($filename)); # remove any write lock announce
322 return unless (simple_unlock
(masterfile
($filename))); # remove master lock
323 delete $LOCKED{$filename};
329 sub w_file_removed
($) {
330 my $filename = shift;
332 unlink reffile
($filename);
333 unlink lockfile
($filename);
334 unlink lockfile
(reffile
($filename));
335 unlink masterlockfile
($filename);
338 ################################################################################
340 # *n*x section (symlinks possible)
343 ### sub x_lock_file ($;$) ######################################################
345 # set read lock (shared lock)
346 # (symlinks possible)
348 # Params: $filename - file to lock
349 # $timeout - Lock Timeout (sec.)
351 # Return: Status Code (Bool)
353 sub x_lock_file
($;$) {
354 my $filename = shift;
355 my $timeout = shift || $Timeout;
357 unless ($LOCKED{$filename}) {
358 unless (-l masterlockfile
($filename)) {
361 # try to increment the reference counter
363 if (set_ref
($filename,1,$timeout)) {
364 $LOCKED{$filename} = 1;
372 # master lock is set or file has not been realeased yet
381 ### sub x_unlock_file ($;$) ####################################################
383 # remove read lock (shared lock)
384 # (symlinks possible)
386 # Params: $filename - locked file
387 # $timeout - timeout (sec.)
389 # Return: Status Code (Bool)
391 sub x_unlock_file
($;$) {
393 my ($timeout)=(shift (@_) or $Timeout);
395 if ($LOCKED{$filename}) {
396 if ($LOCKED{$filename} == 3) {
397 return unless write_unlock_file
($filename, $timeout);
398 $LOCKED{$filename} = 1;
400 if ($LOCKED{$filename} == 1) {
401 unless (-l masterlockfile
($filename)) {
402 # try to decrement the reference counter
404 set_ref
($filename,-1,$timeout) and do {
405 delete $LOCKED{$filename};
416 ### sub x_write_lock_file ($;$) ################################################
418 # set write lock (exclusive lock)
419 # (symlinks possible)
421 # Params: $filename - file to lock
422 # $timeout - timeout (sec.)
424 # Return: Status Code (Bool)
426 sub x_write_lock_file
($;$) {
427 my $filename = shift;
428 my $timeout = shift || $Timeout;
429 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ?
1 : 0;
431 unless (-l masterlockfile
($filename) and not $iAmMaster) {
432 # announce the write lock
433 # and wait $timeout seconds for
434 # references == 0 (no shared locks set)
436 simple_lock
($filename,$timeout) or return 0;
439 # lock reference counter
442 unless (simple_lock
(&reffile
($filename),$timeout)) {
443 simple_unlock
($filename,$timeout);
447 # ready if we have no shared locks
449 if (get_ref
($filename) == $rest) {
450 $LOCKED{$filename} = 2 | ($rest ?
1 : 0);
454 # release reference counter
455 # shared locks get the chance to be removed
457 unless (simple_unlock
(&reffile
($filename),$timeout)) {
458 simple_unlock
($filename,$timeout);
465 # remove the announcement
467 simple_unlock
($filename);
472 # or file has not been released yet
478 # maybe the system is occupied
483 ### sub x_write_unlock_file ($;$) ##############################################
485 # remove write lock (exclusive lock)
486 # (symlinks possible)
488 # Params: $filename - locked file
489 # $timeout - timeout (sec.)
491 # Return: Status Code (Bool)
493 sub x_write_unlock_file
($;$) {
494 my $filename = shift;
495 my $timeout = shift || $Timeout;
497 unless (-l
&masterlockfile
($filename) and not $iAmMaster) {
498 # remove reference counter lock
500 simple_unlock
(reffile
($filename),$timeout) or return;
502 # remove the write lock announce
504 simple_unlock
($filename,$timeout) or return;
508 delete $LOCKED{$filename};
512 ### sub x_violent_unlock_file ($) ##############################################
514 # remove any lock violent (excl. master lock)
515 # (symlinks possible)
517 # Params: $filename - locked file
519 # Return: -none- (the success is not defined)
521 sub x_violent_unlock_file
($) {
524 unless (-l
&masterlockfile
($filename)) {
526 # find out last modification time
527 # and do nothing unless 'violent-timout' is over
531 if (-f
($reffile = $filename)) {
532 $time = (stat $reffile)[9];}
534 elsif (-l
($reffile = lockfile
($filename))) {
535 $time = (lstat $reffile)[9];}
538 return if ((time - $time) < $violentTimeout);}
540 write_lock_file
($filename,1); # last try, to set an exclusive lock on $filename
541 unlink (reffile
($filename)); # reference counter = 0
542 simple_unlock
(reffile
($filename)); # release reference counter file
543 simple_unlock
($filename);} # release file
544 delete $LOCKED{$filename};
547 ### sub x_set_master_lock ($;$) ################################################
550 # (symlinks possible)
552 # Params: $filename - file to lock
553 # $timeout - timeout (sec.)
555 # Return: Status Code (Bool)
557 sub x_set_master_lock
($;$) {
558 my $filename = shift;
559 my $timeout = shift || $masterTimeout;
561 # set exclusive lock or fail
563 return unless (write_lock_file
($filename,$timeout));
567 symlink $filename, masterlockfile
($filename) and return 1;
569 # no chance (occupied?, master lock set yet?)
573 ### sub x_release_file ($) #####################################################
575 # remove any locks (incl. master lock)
576 # (symlinks possible)
578 # Params: $filename - file to lock
579 # $timeout - timeout (sec.)
581 # Return: Status Code (Bool)
583 sub x_release_file
($) {
586 unlink (reffile
($filename)); # reference counter = 0
587 return if (-f reffile
($filename)); # really?
588 return unless (simple_unlock
(reffile
($filename))); # release reference counter
589 return unless (simple_unlock
($filename)); # remove any write lock announce
590 return unless (simple_unlock
(masterfile
($filename))); # remove master lock
591 delete $LOCKED{$filename};
597 sub x_file_removed
($) {
598 release_file
(shift);
601 ### sub w_simple_lock ($;$) ####################################################
602 ### sub w_simple_unlock ($) ####################################################
604 # simple file lock/unlock
605 # (for no-symlink-systems: kill/create lockfile)
607 # Params: $filename - file to lock
608 # [ $timeout - Lock time out (sec.) ]
610 # Return: Status Code (Bool)
612 sub w_simple_lock
($;$) {
613 my $filename = shift;
614 my $timeout = shift || $Timeout;
615 my $lockfile = lockfile
$filename;
618 unlink $lockfile and return 1;
627 sub w_simple_unlock
($) {
628 my $filename = shift;
629 my $lockfile = lockfile
$filename;
632 if (sysopen(LF
, $lockfile, O_WRONLY
|O_CREAT
|O_TRUNC
)) {
633 return 1 if close (LF
);
636 # not able to create lockfile, hmmm...
641 ### sub x_simple_lock ($;$) ####################################################
642 ### sub x_simple_unlock ($) ####################################################
644 # simple file lock/unlock
645 # (symlinks possible: create/unlink symlink)
647 # Params: $filename - file to lock
648 # [ $timeout - Lock time out (sec.) ]
650 # Return: Status Code (Bool)
652 sub x_simple_lock
($;$) {
653 my $filename = shift;
654 my $timeout = shift || $Timeout;
655 my $lockfile = lockfile
$filename;
658 symlink $filename,$lockfile and return 1;
666 sub x_simple_unlock
($) {
669 unlink (lockfile
$filename) and return 1;
671 # not able to unlink symlink, hmmm...
676 ### sub w_set_ref ($$$) ########################################################
678 # add $_[1] to reference counter
679 # (may be negative...)
680 # (for no-symlink-systems)
682 # Params: $filename - file, reference counter belongs to
683 # $z - value, added to reference counter
684 # $timeout - lock time out
686 # Return: Status Code (Bool)
688 sub w_set_ref
($$$) {
689 my $filename = shift;
691 my $timeout = shift || $Timeout;
692 my $reffile = reffile
$filename;
695 # if write lock announced, only count down allowed
697 ($z < 0 or -f lockfile
($filename)) or return;
699 # lock reference counter file
701 simple_lock
($reffile,$timeout) or return;
703 # load reference counter
705 my $old = get_ref
($filename);
707 # compute and write new ref. counter
710 $old = 0 if ($old < 0);
712 # kill reference counter file
713 # if ref. counter == 0
716 unlink $reffile or return;
720 sysopen (REF
, $reffile, O_WRONLY
| O_TRUNC
| O_CREAT
) or return;
721 print REF
$old or do {
728 # release ref. counter file
730 simple_unlock
($reffile) or return;
736 ### sub x_set_ref ($$$) ########################################################
738 # add $_[1] to reference counter
739 # (may be negative...)
740 # (symlinks possible)
742 # Params: $filename - file, reference counter belongs to
743 # $z - value, added to reference counter
744 # $timeout - lock time out
746 # Return: Status Code (Bool)
748 sub x_set_ref
($$$) {
749 my $filename = shift;
751 my $timeout = shift || $Timeout;
752 my $reffile = reffile
$filename;
755 # if write lock announced, only count down allowed
758 return if(-l lockfile
($filename));
761 # lock reference counter file
763 return unless(simple_lock
($reffile,$timeout));
765 # load reference counter
767 my $old = get_ref
($filename);
769 # compute and write new ref. counter
772 $old = 0 if ($old < 0);
775 unlink $reffile or return;
779 sysopen (REF
, $reffile, O_WRONLY
| O_TRUNC
| O_CREAT
) or return;
780 print REF
$old or do {
787 # release ref. counter file
789 simple_unlock
($reffile) or return;
795 ### sub get_ref ($) ############################################################
797 # read out the reference counter
798 # (system independant)
801 # Params: $filename - file, the ref. counter belongs to
803 # Return: reference counter
806 my $filename = shift;
807 my $reffile = reffile
$filename;
812 sysopen (REF
, $reffile, O_RDONLY
) or return 0;
820 ################################################################################
822 # initializing the module
825 # global variables (time in seconds)
827 $Timeout = 10; # normal timeout
828 $violentTimeout = 600; # violent timeout (10 minutes)
829 $masterTimeout = 20; # master timeout
831 $iAmMaster = 0; # default: I am nobody
835 # assign the aliases to the needed functions
836 # (perldoc -f symlink)
838 if ( eval {local $SIG{__DIE__
}; symlink('',''); 1 } ) {
839 *lock_file
= \
&x_lock_file
;
840 *unlock_file
= \
&x_unlock_file
;
841 *write_lock_file
= \
&x_write_lock_file
;
842 *write_unlock_file
= \
&x_write_unlock_file
;
843 *violent_unlock_file
= \
&x_violent_unlock_file
;
844 *set_master_lock
= \
&x_set_master_lock
;
845 *release_file
= \
&x_release_file
;
846 *file_removed
= \
&x_file_removed
;
848 *simple_lock
= \
&x_simple_lock
;
849 *simple_unlock
= \
&x_simple_unlock
;
850 *set_ref
= \
&x_set_ref
;
854 *lock_file
= \
&w_lock_file
;
855 *unlock_file
= \
&w_unlock_file
;
856 *write_lock_file
= \
&w_write_lock_file
;
857 *write_unlock_file
= \
&w_write_unlock_file
;
858 *violent_unlock_file
= \
&w_violent_unlock_file
;
859 *set_master_lock
= \
&w_set_master_lock
;
860 *release_file
= \
&w_release_file
;
861 *file_removed
= \
&w_file_removed
;
863 *simple_lock
= \
&w_simple_lock
;
864 *simple_unlock
= \
&w_simple_unlock
;
865 *set_ref
= \
&w_set_ref
;
869 # keeping require happy
874 ### end of Lock ################################################################
patrick-canterino.de