]>
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 ################################################################################
28 ################################################################################
32 $VERSION = do { my @r =(q
$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
34 ################################################################################
38 use base
qw(Exporter);
65 ### ~file () ###################################################################
67 # create lock file names
70 return $_[0].'.lock.ref';
76 return $_[0].'.master';
78 sub masterlockfile
($) {
79 return lockfile
(masterfile
$_[0]);
82 ################################################################################
84 # Windows section (no symlinks)
87 ### w_lock_file () #############################################################
89 # set read lock (shared lock)
90 # (for no-symlink-systems)
92 # Params: $filename - file to lock
93 # $timeout - Lock Timeout (sec.)
95 # Return: Status Code (Bool)
97 sub w_lock_file
($;$) {
99 my $timeout = +shift || $Timeout;
101 unless ($LOCKED{$filename}) {
102 if (-f masterlockfile
($filename)) {
105 # try to increment the reference counter
107 if (set_ref
($filename,1,$timeout)) {
108 $LOCKED{$filename}=1;
115 # master lock is set or file has not been released yet
121 # maybe the system is occupied
125 ### w_unlock_file () ###########################################################
127 # remove read lock (shared lock)
128 # (for no-symlink-systems)
130 # Params: $filename - locked file
131 # $timeout - timeout (sec.)
133 # Return: Status Code (Bool)
135 sub w_unlock_file
($;$) {
136 my $filename = shift;
137 my $timeout = shift || $Timeout;
139 if ($LOCKED{$filename}) {
140 if ($LOCKED{$filename} == 3) {
141 return unless write_unlock_file
($filename, $timeout);
142 $LOCKED{$filename} = 1;
144 if ($LOCKED{$filename} == 1) {
145 if (-f masterlockfile
($filename)) {
147 # try do decrement the reference counter
149 if (set_ref
($filename, -1, $timeout)) {
150 delete $LOCKED{$filename};
161 ### w_write_lock_file () #######################################################
163 # set write lock (exclusive lock)
164 # (for no-symlink-systems)
166 # Params: $filename - file to lock
167 # $timeout - timeout (sec.)
169 # Return: Status Code (Bool)
171 sub w_write_lock_file
($;$) {
173 my $timeout= shift || $Timeout;
174 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ?
1 : 0;
176 if (-f masterlockfile
($filename) or $iAmMaster) {
178 # announce the write lock
179 # and wait $timeout seconds for
180 # references == 0 (no shared locks set)
182 simple_lock
($filename,$timeout) or return 0;
184 # lock reference counter
187 unless (simple_lock
(reffile
($filename),$timeout)) {
188 simple_unlock
($filename,$timeout);
192 # ready if we have no shared locks
194 if (get_ref
($filename) == $rest) {
195 $LOCKED{$filename} = 2 | ($rest ?
1 : 0);
199 # release reference counter
200 # shared locks get the chance to be removed
202 unless (simple_unlock
(reffile
($filename),$timeout)) {
203 simple_unlock
($filename,$timeout);
210 # remove the announcement
212 simple_unlock
($filename);
216 # master lock is set or file has not been released yet
224 ### w_write_unlock_file () #####################################################
226 # remove write lock (exclusive lock)
227 # (for no-symlink-systems)
229 # Params: $filename - locked file
230 # $timeout - timeout (sec.)
232 # Return: Status Code (Bool)
234 sub w_write_unlock_file
($;$) {
235 my $filename = shift;
236 my $timeout = shift || $Timeout;
238 if (-f masterlockfile
($filename) or $iAmMaster) {
240 # remove reference counter lock
242 simple_unlock
(reffile
($filename),$timeout) or return;
244 # remove the write lock announce
246 simple_unlock
($filename,$timeout) or return;
250 delete $LOCKED{$filename};
254 ### w_violent_unlock_file () ###################################################
256 # remove any lock violent (excl. master lock)
257 # (for no-symlink-systems)
259 # Params: $filename - locked file
261 # Return: -none- (the success is not defined)
263 sub w_violent_unlock_file
($) {
264 my $filename = shift;
266 if (-f masterlockfile
($filename)) {
268 # find out last modification time
269 # and do nothing unless 'violent-timout' is over
272 if (-f
($reffile = $filename) or -f
($reffile = lockfile
($filename))) {
273 my $time = (stat $reffile)[9];
274 (time - $time) >= $violentTimeout or return;
277 write_lock_file
($filename,1); # last try, to set an exclusive lock on $filename
278 unlink (reffile
($filename)); # reference counter = 0
279 simple_unlock
(reffile
($filename)); # release reference counter file
280 simple_unlock
($filename);} # release file
281 delete $LOCKED{$filename};
286 ### w_set_master_lock () #######################################################
289 # (for no-symlink-systems)
291 # Params: $filename - file to lock
292 # $timeout - timeout (sec.)
294 # Return: Status Code (Bool)
296 sub w_set_master_lock
($;$) {
297 my $filename = shift;
298 my $timeout = shift || $masterTimeout;
300 # set exclusive lock or fail
302 return unless (write_lock_file
($filename,$timeout));
306 unlink masterlockfile
($filename) and return 1;
308 # no chance (occupied?, master lock set yet?)
312 ### w_release_file () ##########################################################
314 # remove any locks (incl. master lock)
315 # (for no-symlink-systems)
317 # Params: $filename - file to lock
318 # $timeout - timeout (sec.)
320 # Return: Status Code (Bool)
322 sub w_release_file
($) {
325 unlink (reffile
($filename)); # reference counter = 0
326 return if (-f reffile
($filename)); # really?
327 return unless (simple_unlock
(reffile
($filename))); # release reference counter
328 return unless (simple_unlock
($filename)); # remove any write lock announce
329 return unless (simple_unlock
(masterfile
($filename))); # remove master lock
330 delete $LOCKED{$filename};
336 sub w_file_removed
($) {
337 my $filename = shift;
339 unlink reffile
($filename);
340 unlink lockfile
($filename);
341 unlink lockfile
(reffile
($filename));
342 unlink masterlockfile
($filename);
345 ################################################################################
347 # *n*x section (symlinks possible)
350 ### x_lock_file () #############################################################
352 # set read lock (shared lock)
353 # (symlinks possible)
355 # Params: $filename - file to lock
356 # $timeout - Lock Timeout (sec.)
358 # Return: Status Code (Bool)
360 sub x_lock_file
($;$) {
361 my $filename = shift;
362 my $timeout = shift || $Timeout;
364 unless ($LOCKED{$filename}) {
365 unless (-l masterlockfile
($filename)) {
368 # try to increment the reference counter
370 if (set_ref
($filename,1,$timeout)) {
371 $LOCKED{$filename} = 1;
379 # master lock is set or file has not been realeased yet
388 ### x_unlock_file () ###########################################################
390 # remove read lock (shared lock)
391 # (symlinks possible)
393 # Params: $filename - locked file
394 # $timeout - timeout (sec.)
396 # Return: Status Code (Bool)
398 sub x_unlock_file
($;$) {
400 my ($timeout)=(shift (@_) or $Timeout);
402 if ($LOCKED{$filename}) {
403 if ($LOCKED{$filename} == 3) {
404 return unless write_unlock_file
($filename, $timeout);
405 $LOCKED{$filename} = 1;
407 if ($LOCKED{$filename} == 1) {
408 unless (-l masterlockfile
($filename)) {
409 # try to decrement the reference counter
411 set_ref
($filename,-1,$timeout) and do {
412 delete $LOCKED{$filename};
423 ### x_write_lock_file () #######################################################
425 # set write lock (exclusive lock)
426 # (symlinks possible)
428 # Params: $filename - file to lock
429 # $timeout - timeout (sec.)
431 # Return: Status Code (Bool)
433 sub x_write_lock_file
($;$) {
434 my $filename = shift;
435 my $timeout = shift || $Timeout;
436 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ?
1 : 0;
438 unless (-l masterlockfile
($filename) and not $iAmMaster) {
439 # announce the write lock
440 # and wait $timeout seconds for
441 # references == 0 (no shared locks set)
443 simple_lock
($filename,$timeout) or return 0;
446 # lock reference counter
449 unless (simple_lock
(&reffile
($filename),$timeout)) {
450 simple_unlock
($filename,$timeout);
454 # ready if we have no shared locks
456 if (get_ref
($filename) == $rest) {
457 $LOCKED{$filename} = 2 | ($rest ?
1 : 0);
461 # release reference counter
462 # shared locks get the chance to be removed
464 unless (simple_unlock
(&reffile
($filename),$timeout)) {
465 simple_unlock
($filename,$timeout);
472 # remove the announcement
474 simple_unlock
($filename);
479 # or file has not been released yet
485 # maybe the system is occupied
490 ### x_write_unlock_file () #####################################################
492 # remove write lock (exclusive lock)
493 # (symlinks possible)
495 # Params: $filename - locked file
496 # $timeout - timeout (sec.)
498 # Return: Status Code (Bool)
500 sub x_write_unlock_file
($;$) {
501 my $filename = shift;
502 my $timeout = shift || $Timeout;
504 unless (-l
&masterlockfile
($filename) and not $iAmMaster) {
505 # remove reference counter lock
507 simple_unlock
(reffile
($filename),$timeout) or return;
509 # remove the write lock announce
511 simple_unlock
($filename,$timeout) or return;
515 delete $LOCKED{$filename};
519 ### x_violent_unlock_file () ###################################################
521 # remove any lock violent (excl. master lock)
522 # (symlinks possible)
524 # Params: $filename - locked file
526 # Return: -none- (the success is not defined)
528 sub x_violent_unlock_file
($) {
531 unless (-l
&masterlockfile
($filename)) {
533 # find out last modification time
534 # and do nothing unless 'violent-timout' is over
538 if (-f
($reffile = $filename)) {
539 $time = (stat $reffile)[9];}
541 elsif (-l
($reffile = lockfile
($filename))) {
542 $time = (lstat $reffile)[9];}
545 return if ((time - $time) < $violentTimeout);}
547 write_lock_file
($filename,1); # last try, to set an exclusive lock on $filename
548 unlink (reffile
($filename)); # reference counter = 0
549 simple_unlock
(reffile
($filename)); # release reference counter file
550 simple_unlock
($filename);} # release file
551 delete $LOCKED{$filename};
554 ### x_set_master_lock () #######################################################
557 # (symlinks possible)
559 # Params: $filename - file to lock
560 # $timeout - timeout (sec.)
562 # Return: Status Code (Bool)
564 sub x_set_master_lock
($;$) {
565 my $filename = shift;
566 my $timeout = shift || $masterTimeout;
568 # set exclusive lock or fail
570 return unless (write_lock_file
($filename,$timeout));
574 symlink $filename, masterlockfile
($filename) and return 1;
576 # no chance (occupied?, master lock set yet?)
580 ### x_release_file () ##########################################################
582 # remove any locks (incl. master lock)
583 # (symlinks possible)
585 # Params: $filename - file to lock
586 # $timeout - timeout (sec.)
588 # Return: Status Code (Bool)
590 sub x_release_file
($) {
593 unlink (reffile
($filename)); # reference counter = 0
594 return if (-f reffile
($filename)); # really?
595 return unless (simple_unlock
(reffile
($filename))); # release reference counter
596 return unless (simple_unlock
($filename)); # remove any write lock announce
597 return unless (simple_unlock
(masterfile
($filename))); # remove master lock
598 delete $LOCKED{$filename};
604 sub x_file_removed
($) {
605 release_file
(shift);
608 ### w_simple_lock () ###########################################################
609 ### w_simple_unlock () #########################################################
611 # simple file lock/unlock
612 # (for no-symlink-systems: kill/create lockfile)
614 # Params: $filename - file to lock
615 # [ $timeout - Lock time out (sec.) ]
617 # Return: Status Code (Bool)
619 sub w_simple_lock
($;$) {
620 my $filename = shift;
621 my $timeout = shift || $Timeout;
622 my $lockfile = lockfile
$filename;
625 unlink $lockfile and return 1;
634 sub w_simple_unlock
($) {
635 my $filename = shift;
636 my $lockfile = lockfile
$filename;
639 if (sysopen(LF
, $lockfile, O_WRONLY
|O_CREAT
|O_TRUNC
)) {
640 return 1 if close (LF
);
643 # not able to create lockfile, hmmm...
648 ### x_simple_lock () ###########################################################
649 ### x_simple_unlock () #########################################################
651 # simple file lock/unlock
652 # (symlinks possible: create/unlink symlink)
654 # Params: $filename - file to lock
655 # [ $timeout - Lock time out (sec.) ]
657 # Return: Status Code (Bool)
659 sub x_simple_lock
($;$) {
660 my $filename = shift;
661 my $timeout = shift || $Timeout;
662 my $lockfile = lockfile
$filename;
665 symlink $filename,$lockfile and return 1;
673 sub x_simple_unlock
($) {
676 unlink (lockfile
$filename) and return 1;
678 # not able to unlink symlink, hmmm...
683 ### w_set_ref () ###############################################################
685 # add $_[1] to reference counter
686 # (may be negative...)
687 # (for no-symlink-systems)
689 # Params: $filename - file, reference counter belongs to
690 # $z - value, added to reference counter
691 # $timeout - lock time out
693 # Return: Status Code (Bool)
695 sub w_set_ref
($$$) {
696 my $filename = shift;
698 my $timeout = shift || $Timeout;
699 my $reffile = reffile
$filename;
702 # if write lock announced, only count down allowed
704 ($z < 0 or -f lockfile
($filename)) or return;
706 # lock reference counter file
708 simple_lock
($reffile,$timeout) or return;
710 # load reference counter
712 my $old = get_ref
($filename);
714 # compute and write new ref. counter
717 $old = 0 if ($old < 0);
719 # kill reference counter file
720 # if ref. counter == 0
723 unlink $reffile or return;
727 sysopen (REF
, $reffile, O_WRONLY
| O_TRUNC
| O_CREAT
) or return;
728 print REF
$old or do {
735 # release ref. counter file
737 simple_unlock
($reffile) or return;
743 ### x_set_ref () ###############################################################
745 # add $_[1] to reference counter
746 # (may be negative...)
747 # (symlinks possible)
749 # Params: $filename - file, reference counter belongs to
750 # $z - value, added to reference counter
751 # $timeout - lock time out
753 # Return: Status Code (Bool)
755 sub x_set_ref
($$$) {
756 my $filename = shift;
758 my $timeout = shift || $Timeout;
759 my $reffile = reffile
$filename;
762 # if write lock announced, only count down allowed
765 return if(-l lockfile
($filename));
768 # lock reference counter file
770 return unless(simple_lock
($reffile,$timeout));
772 # load reference counter
774 my $old = get_ref
($filename);
776 # compute and write new ref. counter
779 $old = 0 if ($old < 0);
782 unlink $reffile or return;
786 sysopen (REF
, $reffile, O_WRONLY
| O_TRUNC
| O_CREAT
) or return;
787 print REF
$old or do {
794 # release ref. counter file
796 simple_unlock
($reffile) or return;
802 ### get_ref () #################################################################
804 # read out the reference counter
805 # (system independant)
808 # Params: $filename - file, the ref. counter belongs to
810 # Return: reference counter
813 my $filename = shift;
814 my $reffile = reffile
$filename;
819 sysopen (REF
, $reffile, O_RDONLY
) or return 0;
827 ################################################################################
829 # initializing the module
832 # global variables (time in seconds)
834 $Timeout = 10; # normal timeout
835 $violentTimeout = 600; # violent timeout (10 minutes)
836 $masterTimeout = 20; # master timeout
838 $iAmMaster = 0; # default: I am nobody
842 # assign the aliases to the needed functions
843 # (perldoc -f symlink)
845 if ( eval {local $SIG{__DIE__
}; symlink('',''); 1 } ) {
846 *lock_file
= \
&x_lock_file
;
847 *unlock_file
= \
&x_unlock_file
;
848 *write_lock_file
= \
&x_write_lock_file
;
849 *write_unlock_file
= \
&x_write_unlock_file
;
850 *violent_unlock_file
= \
&x_violent_unlock_file
;
851 *set_master_lock
= \
&x_set_master_lock
;
852 *release_file
= \
&x_release_file
;
853 *file_removed
= \
&x_file_removed
;
855 *simple_lock
= \
&x_simple_lock
;
856 *simple_unlock
= \
&x_simple_unlock
;
857 *set_ref
= \
&x_set_ref
;
861 *lock_file
= \
&w_lock_file
;
862 *unlock_file
= \
&w_unlock_file
;
863 *write_lock_file
= \
&w_write_lock_file
;
864 *write_unlock_file
= \
&w_write_unlock_file
;
865 *violent_unlock_file
= \
&w_violent_unlock_file
;
866 *set_master_lock
= \
&w_set_master_lock
;
867 *release_file
= \
&w_release_file
;
868 *file_removed
= \
&w_file_removed
;
870 *simple_lock
= \
&w_simple_lock
;
871 *simple_unlock
= \
&w_simple_unlock
;
872 *set_ref
= \
&w_set_ref
;
876 # keep 'require' happy
881 ### end of Lock ################################################################
patrick-canterino.de