=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;