sourcecode
PodMaster
<CODE>
=head1 NAME
File::DumbLock - dumb locking mechanism (lock if file not exist)
=head1 SYNOPSIS
#!/usr/bin/perl
use strict;
eval q{use warnings}; #use warnings if u got 'em
use File::DumbLock;
my $file = 'filename'; # doesn't exist, but it doesn't matter
my %Dumb = (
name => $file, # required
retry => 2, # default is 5
sleep => .1, # also the default
wait => 2 * 60, # also the default
);
my $dumB = new File::DumbLock(\%Dumb);
my $dumC = new File::DumbLock(%Dumb);
# creates $file.dumblock
# select undef,undef,undef, $sleep; until it can, or it times out
if( $dumB->Open() ){
warn " dumB got lock";
warn " dumC don't got lock " unless $dumC->Open();
open(FOY,'>'.$file) or die "can't open $file $!";
print FOY 'foy';
close(FOY);
warn "closing dumB ".$dumB->Close();
}
warn " dumC got lock" if $dumC->Open();
$dumC->Close();
=head1 DESCRIPTION
File::DumbLock implements the dumbest kind of "locking" mechanism known to man.
It's voluntary, and it can backfire, but virtually every plaform suports it.
Every time you "obtain a lock", a semaphore is created (a lockfile).
Every time you "release a lock", that semaphore is deleted (if possible).
If the lockfile can't be deleted, you'll be warned, but you'll lose the lock.
Example:
my $dumB = new File::DumbLock(name => 'file' );
my $dumC = new File::DumbLock(name => 'file', wait => 2 );
print "dumB got lock\n" if $dumB->Open();
sleep 2;
print "dumC stole lock\n" if $dumC->Open();
print "dumB couldn't get lock\n" unless $dumB->Open();
=head1 METHODS
=head2 new
The constructor, a class method.
Takes either a hashref, or a list of key value pairs (and they must be pairs).
=over 4
=item name
The filename, a required argument.
=item retry
The number of times to attempt to obtain a lock (default is 5).
=item sleep
The number of seconds to sleep for (default is .1).
=item wait
If the lockfile is older than the wait(in seconds),
while you're trying to obtain a lock (Open),
you'll get it.
=back
=head2 Open
An object method.
When invoked, attempts to obtain a lock.
Returns a true value upon success, or if it already has a lock,
and a false value upon failure.
If the lockfile doesn't exist, creates it (obtains a lock).
If the lockfile exists, checks if its is expired.
It does this 'retry' number of times,
sleeping 'sleep' amount of seconds in between.
=head2 Close
An object method.
When invoked, releases a lock. Always returns a true value.
Attempts to unlink the lockfile, and warns you if it can't.
=head1 AUTHOR
D. H. aka podmaster (see CPAN)
=cut
package File::DumbLock;
use 5.00000;
use strict;
use vars qw($VERSION);
use Carp qw( carp croak );
$VERSION = '0.01';
my %DEF = (
retry => [ 5, '^\d+\z' ],
sleep => [ .1, '^\d+?(?:\.\d+)?\z'],
wait => [ 60 * 10, '^\d+\z' ],
);
sub new {
my( $class, $o ) = @_;
$o = {$o, @_ } if @_ > 2;
croak "The name argument is required" unless exists $o->{name};
for my $key(keys %DEF) {
if( exists $o->{$key} ) {
unless( $o->{$key} =~ m{$DEF{$key}->[1]} ) {
carp "Argument $key needs to match qr{"
.$DEF{$key}->[1].'\}. '
."Assuming default($DEF{$key}->[0])";
}
} else {
$o->{$key} = $DEF{$key}->[0];
}
}
$o->{filo} = $o->{name}.'.dumblock';
return bless $o, $class;
}
sub _exists_and_young {
my $self = shift;
my @stat = stat $self->{filo};
return() unless @stat;
return $self->{wait} > time - $stat[9]; # young if wait > age
}
sub _have_lock {
my $self = shift;
my @stat = stat $self->{filo};
return() unless @stat;
return $stat[9] == $self->{ctime};
}
sub Open {
my $self = shift;
return 1 if $self->_have_lock;
my $filo = $self->{filo};
for(1 .. $self->{retry}){
if( $self->_exists_and_young ) {
select undef, undef, undef, $self->{sleep};
} else {
umask 0000; # just in case
open(FILO, '>'.$filo ) or croak "couldn't create $filo $!";
$self->{ctime} = time;
chmod( 0777, $filo ) or croak "couldn't chmod $filo 0777 ($!)";
close(FILO);
return 1; # E00000 0 ;)
}
}
return(); # we failed
}
sub Close {
my $self = shift;
my $filo = $self->{filo};
delete $self->{ctime};
unlink($filo) or carp "couldn't unlink $filo ($!)";
return(1); # success
}
sub DESTROY {
my $self = shift;
$self->Close() if -e $self->{filo};
undef $self;
}
1;
</CODE>
<b>update:</b> use [cpan://File::FlockDir] instead (i am).
<HR>
File::DumbLock - dumb locking mechanism (lock if file not exist)
<p>
File::DumbLock implements the dumbest kind of "locking" mechanism known to man.
It's voluntary, and it can backfire, but virtually every plaform suports it.
<P>
Every time you "obtain a lock", a semaphore is created (a lockfile).
Every time you "release a lock", that semaphore is deleted (if possible).
If the lockfile can't be deleted, you'll be warned, but you'll lose the lock.
<CODE>
Example:
my $dumB = new File::DumbLock(name => 'file' );
my $dumC = new File::DumbLock(name => 'file', wait => 2 );
print "dumB got lock\n" if $dumB->Open();
sleep 2;
print "dumC stole lock\n" if $dumC->Open();
print "dumB couldn't get lock\n" unless $dumB->Open();
</CODE>
<p>
You can download it at [http://crazyinsomniac.perlmonk.org/perl/misc/File-DumbLock-0.01.tar.gz|File-DumbLock-0.01.tar.gz]
sometime soon.
<p>
<B>update:</b> If you know of a module that already exists that does this, please /tell me.
<p>
I am also entertaining name suggestions: Lock::Dumb, Lock::Semaphore, Lock::Simple, File::SimpleLock ...
<p>
<b>update:</b>
It appears i won't be changing the name.
[id://198170] did make me chuckle heartily.
Miscellaneous
/msg podmaster