--- /dev/null
+package Lock::API;
+
+################################################################################
+# #
+# File: shared/Lock/API.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: system independent part of Locking and Filehandle class #
+# NOT FOR PUBLIC USE #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Carp;
+
+use base qw(
+ Lock::Handle
+ Lock::_simple
+);
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub lock ###################################################################
+#
+# set a lock on the file
+#
+# Params: $locktype - what kind of locking?
+# $timeout - (optional) Timeout
+#
+# Return: success (boolean)
+#
+sub lock {
+ my $self = shift;
+ my $locktype = shift;
+
+ return if $self -> masterlocked;
+
+ ###########################################
+ # shared lock
+ #
+ if ($locktype == $self -> LH_SHARED) {
+ return 1 if $self -> locked_shared;
+ return if $self -> locked_exclusive;
+
+ my $timeout = shift || $self -> timeout ('shared');
+
+ # try to increase the reference counter
+ #
+ if ($self -> add_ref($timeout)) {
+ $self -> set_static (locked_shared => 1);
+ return 1;
+ }
+ }
+
+
+ ###########################################
+ # exclusive lock
+ #
+ elsif ($locktype == $self -> LH_EXCL) {
+ return 1 if $self -> locked_exclusive;
+
+ my $timeout = shift || $self -> timeout ('exclusive');
+
+ #####################
+ # transform exclusive shared lock into exclusive lock
+ #
+ if ($self -> locked_exsh) {
+ my $reflock = new Lock::Handle ($self -> reflock);
+
+ for (0..$timeout) {
+ if ($self -> set_excl_announce and $self -> _simple_lock ($reflock)) {
+ if ($self -> get_ref == 1) {
+ $self -> set_ref(0);
+ $self -> remove_exsh_announce;
+ $self -> set_static (locked_exsh => 0);
+ $self -> set_static (locked_exclusive => 1);
+ return 1;
+ }
+
+ last unless ($self -> _simple_unlock ($reflock->filename));
+ }
+
+ sleep 1;
+ }
+ $self -> remove_excl_announce;
+ }
+
+ #####################
+ # set exclusive lock
+ #
+ else {
+ my $reflock = new Lock::Handle ($self -> reflock);
+
+ for (0..$timeout) {
+ if ($self -> set_excl_announce and $self -> _simple_lock ($reflock)) {
+ if ($self -> get_ref == 0) {
+ $self -> set_static (locked_exclusive => 1);
+ return 1;
+ }
+
+ last unless ($self -> _simple_unlock ($reflock->filename));
+ }
+
+ sleep 1;
+ }
+ $self -> remove_excl_announce;
+ }
+ }
+
+
+ ###########################################
+ # exclusive shared lock
+ #
+ elsif ($locktype == $self -> LH_EXSH) {
+ return 1 if $self -> locked_exsh;
+ return if ($self -> locked_shared or $self -> locked_exclusive);
+
+ my $timeout = shift || $self -> timeout ('shared');
+
+ # try to increase the reference counter
+ #
+ if ($self -> es_add_ref($timeout)) {
+ $self -> set_static (locked_exsh => 1);
+ return 1;
+ }
+ }
+
+
+ ###########################################
+ # master lock
+ #
+ elsif ($locktype == $self -> LH_MASTER) {
+ $self -> lock ($self->LH_EXCL, $self -> timeout('master')) and
+ $self -> _simple_lock (new Lock::Handle ($self->masterlock)) and
+ return 1;
+ }
+
+ ###########################################
+ # unknown locking type
+ #
+ else {
+ croak "unknown locking type '$locktype'";
+ }
+
+ # timeout
+ #
+ $self -> unlock_violent;
+ return;
+}
+
+### sub unlock #################################################################
+#
+# remove shared or exclusive lock
+#
+# Params: $timeout - (optional) Timeout
+#
+# Return: success (boolean)
+#
+sub unlock {
+ my $self = shift;
+ my $timeout = shift || $self -> timeout ('shared');
+
+ return if $self -> masterlocked;
+
+ ###########################################
+ # shared lock
+ #
+ if ($self -> locked_shared) {
+ # try to decrease the reference counter
+ #
+ if ($self -> sub_ref($timeout)) {
+ $self -> set_static (locked_shared => 0);
+ return 1;
+ }
+ }
+
+
+ ###########################################
+ # exclusive lock
+ #
+ elsif ($self -> locked_exclusive) {
+ my $reflock = new Lock::Handle ($self -> reflock);
+
+ for (0..$timeout) {
+ if ($self -> _simple_unlock ($reflock->filename)) {
+ $self -> remove_excl_announce;
+ $self -> set_static (locked_exclusive => 0);
+ return 1;
+ }
+
+ sleep 1;
+ }
+ }
+
+
+ ###########################################
+ # exclusive shared lock
+ #
+ elsif ($self -> locked_exsh) {
+ # try to decrease the reference counter
+ #
+ if ($self -> es_sub_ref($timeout)) {
+ $self -> remove_exsh_announce;
+ $self -> set_static (locked_exsh => 0);
+ return 1;
+ }
+ }
+
+
+ ###########################################
+ # not locked
+ #
+ else {
+ return 1;
+ }
+
+ # unlocking failed
+ #
+ $self -> unlock_violent;
+ return;
+}
+
+### sub unlock_violent #########################################################
+#
+# remove any lock violently (excludes master lock)
+#
+# Params: ~none~
+#
+# Return: -none- (the success is undefined)
+#
+sub unlock_violent {
+ my $self = shift;
+
+ unless ($self -> masterlocked) {
+
+ # find out last modification time
+ # and do nothing unless 'violent-timout' is over
+ #
+ my $time = $self -> _reftime;
+
+ if ($time) {
+ return if ((time - $time) < $self -> timeout('violent'));
+ }
+
+ $self -> set_ref (0); # reference counter = 0
+ $self -> _simple_unlock ($self -> reflock); # release reference counter file
+ $self -> _simple_unlock ($self -> exshlock); # remove excl shared lock
+ $self -> _simple_unlock ($self -> lockfile); # release file
+ }
+
+ return;
+}
+
+### sub release ################################################################
+#
+# release a file
+#
+# Params: ~none~
+#
+# Return: ~none~
+#
+sub release {
+ my $self = shift;
+
+ $self -> set_ref (0); # reference counter = 0
+ $self -> _simple_unlock ($self -> reflock); # release reference counter
+ $self -> _simple_unlock ($self -> lockfile); # remove any write lock announce
+ $self -> _simple_unlock ($self -> exshlock); # remove any excl shared lock
+ $self -> _simple_unlock ($self -> masterlock); # remove master lock
+
+ return;
+}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::API ###########################################################
\ No newline at end of file
--- /dev/null
+package Lock::Exclusive;
+
+################################################################################
+# #
+# File: shared/Lock/Exclusive.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: Locking and Filehandle class #
+# using O_EXCL and lock files #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Fcntl;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub _simple_lock ###########################################################
+#
+# simple file lock
+# (create lock file)
+#
+# Params: $filename - file to lock
+# $timeout - timeout
+#
+# Return: success (boolean)
+#
+sub _simple_lock {
+ my ($self, $fh) = @_;
+
+ sysopen ($fh, $fh->filename, O_CREAT | O_EXCL | O_WRONLY)
+ and close $fh
+ and return 1;
+
+ return;
+}
+
+### sub _simple_unlock #########################################################
+#
+# simple file unlock
+# (unlink lock file)
+#
+# Params: $filename - lockfile name
+# ^^^^^^^^
+#
+# Return: success (boolean)
+#
+sub _simple_unlock {
+ my ($self, $filename) = @_;
+
+ return 1 if (!-f $filename or unlink $filename);
+
+ # not able to unlink lock file, hmmm...
+ #
+ return;
+}
+
+### sub _reftime ###############################################################
+#
+# determine reference time for violent unlock
+#
+# Params: ~none~
+#
+# Return: time or zero, if no reference file found
+#
+sub _reftime {
+ my $self = shift;
+ my ($time, $reffile) = 0;
+
+ if (-f ($reffile = $self -> filename)) {
+ $time = (stat $reffile)[9];}
+
+ elsif (-f ($reffile = $self -> lockfile)) {
+ $time = (stat $reffile)[9];}
+
+ $time;
+}
+
+### sub masterlocked ###########################################################
+#
+# check on master lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub masterlocked {-f shift -> masterlock}
+
+### sub excl_announced #########################################################
+#
+# check on exclusive lock announced status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub excl_announced {-f shift -> lockfile}
+
+### sub exsh_announced #########################################################
+#
+# check on exclusive shared lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub exsh_announced {-f shift -> exshlock}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::Exclusive #####################################################
\ No newline at end of file
--- /dev/null
+package Lock::Handle;
+
+################################################################################
+# #
+# File: shared/Lock/Handle.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-30 #
+# #
+# Description: belongs to Locking and Filehandle class #
+# NOT FOR PUBLIC USE #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use base qw(Lock::_static);
+
+use Symbol qw(gensym);
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub new ####################################################################
+#
+# constructor
+#
+# Params: $file - filename
+#
+# Return: Lock object
+#
+sub new {
+ my ($instance, $file) = @_;
+ my $class = ref($instance) || $instance;
+ my $self = bless $class -> _create_handle => $class;
+
+ $self -> set_static (filename => $file);
+
+ $self;
+}
+
+### sub _create_handle #########################################################
+#
+# create a globref
+#
+# Params: ~none~
+#
+# Return: globref
+#
+sub _create_handle {gensym}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::Handle ########################################################
\ No newline at end of file
--- /dev/null
+package Lock::Symlink;
+
+################################################################################
+# #
+# File: shared/Lock/Symlink.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: Locking and Filehandle class #
+# using symlinks #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Fcntl;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub _simple_lock ###########################################################
+#
+# simple file lock
+# (create lock file)
+#
+# Params: $filename - file to lock
+# $timeout - timeout
+#
+# Return: success (boolean)
+#
+sub _simple_lock {
+ my ($self, $fh) = @_;
+
+ symlink $self->filename, $fh->filename and return 1;
+
+ return;
+}
+
+### sub _simple_unlock #########################################################
+#
+# simple file unlock
+# (unlink lock file)
+#
+# Params: $filename - lockfile name
+# ^^^^^^^^
+#
+# Return: success (boolean)
+#
+sub _simple_unlock {
+ my ($self, $filename) = @_;
+
+ return 1 if (!-l $filename or unlink $filename);
+
+ # not able to unlink symlink, hmmm...
+ #
+ return;
+}
+
+### sub _reftime ###############################################################
+#
+# determine reference time for violent unlock
+#
+# Params: ~none~
+#
+# Return: time or zero, if no reference file found
+#
+sub _reftime {
+ my $self = shift;
+ my ($time, $reffile) = 0;
+
+ if (-f ($reffile = $self -> filename)) {
+ $time = (stat $reffile)[9];}
+
+ elsif (-l ($reffile = $self -> lockfile)) {
+ $time = (lstat $reffile)[9];}
+
+ $time;
+}
+
+### sub masterlocked ###########################################################
+#
+# check on master lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub masterlocked {-l shift -> masterlock}
+
+### sub excl_announced #########################################################
+#
+# check on exclusive lock announced status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub excl_announced {-l shift -> lockfile}
+
+### sub exsh_announced #########################################################
+#
+# check on exclusive shared lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub exsh_announced {-l shift -> exshlock}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::Symlink #######################################################
--- /dev/null
+package Lock::Unlink;
+
+################################################################################
+# #
+# File: shared/Lock/Unlink.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: Locking and Filehandle class #
+# using the atomic behavior of unlinkig files #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Fcntl;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub _simple_lock ###########################################################
+#
+# simple file lock
+# (unlink lock file)
+#
+# Params: $filename - file to lock
+# $timeout - timeout
+#
+# Return: success (boolean)
+#
+sub _simple_lock {
+ my ($self, $fh) = @_;
+
+ unlink $fh -> filename and return 1;
+
+ return;
+}
+
+### sub _simple_unlock #########################################################
+#
+# simple file unlock
+# (create lock file)
+#
+# Params: $filename - lockfile name
+# ^^^^^^^^
+#
+# Return: success (boolean)
+#
+sub _simple_unlock {
+ my ($self, $filename) = @_;
+ local *LF;
+
+ sysopen (LF, $filename, O_WRONLY | O_CREAT | O_TRUNC)
+ and close LF
+ and return 1;
+
+ # not able to create lock file, hmmm...
+ #
+ return;
+}
+
+### sub _reftime ###############################################################
+#
+# determine reference time for violent unlock
+#
+# Params: ~none~
+#
+# Return: time or zero, if no reference file found
+#
+sub _reftime {
+ my $self = shift;
+ my ($time, $reffile) = 0;
+
+ if (-f ($reffile = $self -> filename)) {
+ $time = (stat $reffile)[9];}
+
+ elsif (-f ($reffile = $self -> lockfile)) {
+ $time = (stat $reffile)[9];}
+
+ $time;
+}
+
+### sub masterlocked ###########################################################
+#
+# check on master lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub masterlocked {not -f shift -> masterlock}
+
+### sub excl_announced #########################################################
+#
+# check on exclusive lock announced status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub excl_announced {not -f shift -> lockfile}
+
+### sub exsh_announced #########################################################
+#
+# check on exclusive shared lock status of the file
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub exsh_announced {not -f shift -> exshlock}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::Unlink ########################################################
--- /dev/null
+package Lock::_simple;
+
+################################################################################
+# #
+# File: shared/Lock/_simple.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: belongs to Locking and Filehandle class #
+# NOT FOR PUBLIC USE #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Fcntl;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+### sub _simple_esna ###########################################################
+#
+# simple file lock
+# excl shared lock announced, no locking possible
+#
+# Params: $filename - filename
+# $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub _simple_esna {
+ my ($self, $filename, $timeout) = @_;
+ my $fh = new Lock::Handle ($filename);
+
+ for (0..$timeout) {
+ unless ($self -> exsh_announced) {
+ $self -> _simple_lock ($fh) and return 1;
+ }
+ sleep 1;
+ }
+
+ # timeout
+ return;
+}
+
+### sub _simple_ana ############################################################
+#
+# simple file lock
+# while excl lock announced, no locking possible
+#
+# Params: $filename - filename
+# $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub _simple_ana {
+ my ($self, $filename, $timeout) = @_;
+ my $fh = new Lock::Handle ($filename);
+
+ for (0..$timeout) {
+ unless ($self -> excl_announced) {
+ $self -> _simple_lock ($fh) and return 1;
+ }
+ sleep 1;
+ }
+
+ # timeout
+ return;
+}
+
+### sub _simple_aa #############################################################
+#
+# simple file lock
+# while excl lock announced, locking is possible
+#
+# Params: $filename - filename
+# $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub _simple_aa {
+ my ($self, $filename, $timeout) = @_;
+ my $fh = new Lock::Handle ($filename);
+
+ for (0..$timeout) {
+ $self -> _simple_lock ($fh) and return 1;
+ sleep 1;
+ }
+
+ # timeout
+ return;
+}
+
+### sub es_add_ref #############################################################
+#
+# increase shared lock reference counter
+# (for excl shared lock)
+#
+# Params: $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub es_add_ref {
+ my ($self, $timeout) = @_;
+
+ # lock reference counter file
+ # increase reference counter
+ # set excl shared lock
+ # release ref. counter file
+ #
+ return unless($self -> _simple_esna ($self->reflock, $timeout));
+ $self -> set_ref ($self -> get_ref + 1) or return;
+ $self -> set_exsh_announce or return;
+ $self -> _simple_unlock ($self -> reflock) or return;
+
+ # successfully done
+ 1;
+}
+
+### sub es_sub_ref #############################################################
+#
+# decrease shared lock reference counter
+# (of an excl shared locked file)
+#
+# Params: $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub es_sub_ref {
+ my ($self, $timeout) = @_;
+
+ # lock reference counter file
+ # increase reference counter
+ # release ref. counter file
+ #
+ return unless($self -> _simple_aa ($self->reflock, $timeout));
+ $self -> set_ref ($self -> get_ref - 1) or return;
+ $self -> remove_exsh_announce;
+ $self -> _simple_unlock ($self -> reflock) or return;
+
+ # successfully done
+ 1;
+}
+
+### sub add_ref ################################################################
+#
+# increase shared lock reference counter
+#
+# Params: $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub add_ref {
+ my ($self, $timeout) = @_;
+
+ # lock reference counter file
+ # increase reference counter
+ # release ref. counter file
+ #
+ return unless($self -> _simple_ana ($self->reflock, $timeout));
+ $self -> set_ref ($self -> get_ref + 1) or return;
+ $self -> _simple_unlock ($self -> reflock) or return;
+
+ # successfully done
+ 1;
+}
+
+### sub sub_ref ################################################################
+#
+# decrease shared lock reference counter
+#
+# Params: $timeout - timeout
+#
+# Return: success code (boolean)
+#
+sub sub_ref {
+ my ($self, $timeout) = @_;
+
+ # lock reference counter file
+ # increase reference counter
+ # release ref. counter file
+ #
+ return unless($self -> _simple_aa ($self->reflock, $timeout));
+ $self -> set_ref ($self -> get_ref - 1) or return;
+ $self -> _simple_unlock ($self -> reflock) or return;
+
+ # successfully done
+ 1;
+}
+
+### sub get_ref ################################################################
+#
+# read out the reference counter
+# NO LOCKING HERE!
+#
+# Params: ~none~
+#
+# Return: counter value
+#
+sub get_ref {
+ my $self = shift;
+ my ($fh, $val) = new Lock::Handle ($self -> reffile);
+
+ {
+ local $/;
+ sysopen ($fh, $fh->filename, O_RDONLY) or return 0;
+ $val = <$fh>;
+ close $fh;
+ }
+
+ # return value
+ #
+ $val;
+}
+
+### sub set_ref ################################################################
+#
+# write reference counter into file
+# NO LOCKING HERE!
+#
+# Params: counter value
+#
+# Return: success code (boolean)
+#
+sub set_ref {
+ my ($self, $val) = @_;
+ my $fh = new Lock::Handle ($self -> reffile);
+
+ if ($val == 0) {
+ if (-f $fh->filename) {
+ unlink $fh->filename or return;
+ }
+ }
+ else {
+ local $\;
+ sysopen ($fh, $fh->filename, O_WRONLY | O_TRUNC | O_CREAT) or return;
+ print $fh $val or do {
+ close $fh;
+ unlink $fh->filename;
+ return;
+ };
+
+ close $fh or do {
+ unlink $fh->filename;
+ return;
+ };
+ }
+
+ # successfully done
+ #
+ 1;
+}
+
+### sub set_excl_announce ######################################################
+#
+# try to announce an exclusive lock
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub set_excl_announce {
+ my $self = shift;
+
+ if ($self -> excl_announced) {
+ return ($self -> announced) ? 1 : return;
+ }
+
+ if ($self -> _simple_lock (new Lock::Handle ($self -> lockfile))) {
+ $self -> set_static (announced => 1);
+ return 1;
+ }
+
+ return;
+}
+
+### sub remove_excl_announce ###################################################
+#
+# remove announce of an exclusive lock, if it's set by ourself
+#
+# Params: ~none~
+#
+# Return: ~none~
+#
+sub remove_excl_announce {
+ my $self = shift;
+
+ if ($self -> excl_announced and $self -> announced) {
+ $self -> _simple_unlock ($self -> lockfile);
+ }
+
+ $self -> set_static (announced => 0);
+
+ return;
+}
+
+### sub set_exsh_announce ######################################################
+#
+# try to announce an exclusive shared lock
+#
+# Params: ~none~
+#
+# Return: status (boolean)
+#
+sub set_exsh_announce {
+ my $self = shift;
+
+ if ($self -> exsh_announced) {
+ return ($self -> es_announced) ? 1 : return;
+ }
+
+ if ($self -> _simple_lock (new Lock::Handle ($self -> exshlock))) {
+ $self -> set_static (es_announced => 1);
+ return 1;
+ }
+
+ return;
+}
+
+### sub remove_exsh_announce ###################################################
+#
+# remove an exclusive shared lock, if it's set by ourself
+#
+# Params: ~none~
+#
+# Return: ~none~
+#
+sub remove_exsh_announce {
+ my $self = shift;
+
+ if ($self -> exsh_announced and $self -> es_announced) {
+ $self -> _simple_unlock ($self -> exshlock);
+ }
+
+ $self -> set_static (es_announced => 0);
+
+ return;
+}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::_simple #######################################################
\ No newline at end of file
--- /dev/null
+package Lock::_static;
+
+################################################################################
+# #
+# File: shared/Lock/_static.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-05-25 #
+# #
+# Description: belongs to Locking and Filehandle class #
+# NO PUBLIC USE #
+# save the lock object static information #
+# (because the lock object is a blessed file handle) #
+# #
+################################################################################
+
+use strict;
+use vars qw(
+ $VERSION
+);
+
+use Carp;
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+################################################################################
+#
+# Variables
+#
+my (%static, %access);
+
+# define standard timeouts
+# (seconds)
+#
+my %timeout = (
+ shared => 10, # for shared and exclusive shared locks
+ exclusive => 10, # for exclusive locks
+ violent => 600, # for violent unlocks (10 minutes should justify a process abort)
+ master => 20 # for master locks
+);
+
+### timeout ####################################################################
+#
+# set and read out the timeout
+#
+# Params: $type - timeout type (defined in %timeout, see above)
+# in this case, the specified timeout will be returned
+# OR
+# %hash - (type => time) pairs
+# the specified timouts will be set
+#
+# Return: specified timeout or nothing
+#
+sub timeout {
+ my ($self, @ary) = @_;
+
+ return if (@ary == 0);
+
+ if (@ary == 1) {
+ my $type = shift @ary;
+ my $hash = $self -> get_static('timeout') || {};
+
+ return defined $hash->{$type}
+ ? $hash -> {$type}
+ : $timeout {$type};
+ }
+
+ my %hash = @ary;
+ $self->set_static(timeout => {%{$self -> get_static('timeout') || {}},%hash});
+
+ return;
+}
+
+### set_static #################################################################
+#
+# set an object property
+#
+# Params: $key - property and method name
+# $value - property
+#
+# Return: $value or nothing
+#
+sub set_static {
+ my ($self, $key, $value) = @_;
+
+ $static{$self}={} unless exists($static{$self});
+ $static{$self}->{$key} = $value;
+
+ defined wantarray and return $value;
+ return;
+}
+
+### get_static #################################################################
+#
+# read out an object property
+#
+# Params: $key - property name
+#
+# Return: value or false
+#
+sub get_static {
+ my ($self, $key) = @_;
+
+ return unless exists($static{$self});
+ $static{$self}->{$key};
+}
+
+################################################################################
+#
+# define the lock file names
+#
+sub reffile {shift -> filename . '.lock.ref'}
+sub lockfile {shift -> filename . '.lock'}
+sub reflock {shift -> filename . '.lock.ref.lock'}
+sub exshlock {shift -> filename . '.exshlock'}
+sub masterlock {shift -> filename . '.masterlock'}
+
+################################################################################
+#
+# autoload the general access methods
+#
+BEGIN {
+ %access = map {$_=>1} qw(
+ filename
+ locked_shared
+ locked_exclusive
+ locked_exsh
+ es_announced
+ announced
+ );
+}
+AUTOLOAD {
+ my $self = shift;
+ (my $attr = $Lock::_static::AUTOLOAD) =~ s/.*:://;
+ return if ($attr eq 'DESTROY');
+
+ if ($access{$attr}) {
+ return $self -> get_static($attr);
+ }
+ else {
+ eval {
+ local $SIG{__DIE__};
+ my $sup = "SUPER::$attr";
+ return $self -> $sup(@_);
+ };
+ croak $@;
+ }
+}
+
+################################################################################
+#
+# destrcutor - try to unlock, if neccessary and possible
+#
+DESTROY {
+ my $self = shift;
+
+ $self -> unlock if ($self =~ /^Lock=/);
+ delete $static{$self};
+}
+
+################################################################################
+#
+# terminator, catch sigTERM and (try to) destroy all objects
+#
+sub destroy_all {
+ $SIG{TERM} = \&destroy_all;
+
+ $_ -> unlock for (grep ((ref $_ and /^Lock=/) => keys %static));
+
+ exit (0);
+}
+BEGIN {
+ $SIG{TERM} = \&destroy_all;
+}
+
+# keep 'require' happy
+1;
+
+#
+#
+### end of Lock::_static #######################################################
\ No newline at end of file
git.p6c8.net / selfforum.git / commitdiff