=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 know +n to man. It's voluntary, and it can backfire, but virtually every plaform supor +ts it. Every time you "obtain a lock", a semaphore is created (a lockfile). Every time you "release a lock", that semaphore is deleted (if possibl +e). If the lockfile can't be deleted, you'll be warned, but you'll lose th +e 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;
In reply to File::DumbLock by PodMaster
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |