File-Flock-Retry

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

        I prefer this approach to blocking/waiting indefinitely or failing
        immediately.

METHODS
  lock
    Usage:

     $lock = File::Flock::Retry->lock($path, \%opts)

    Attempt to acquire an exclusive lock on $path. By default, $path will be
    created if not already exists (see "mode"). If $path is already locked
    by another process, will retry every second for a number of seconds (by
    default 60). Will die if failed to acquire lock after all retries.

    Will automatically unlock if $lock goes out of scope. Upon unlock, will
    remove $path if it is still empty (zero-sized).

    Available options:

    *   mode

lib/File/Flock/Retry.pm  view on Meta::CPAN

    $h{path}    = $path;
    $h{retries} = $opts->{retries} // 60;
    $h{shared}  = $opts->{shared} // 0;
    $h{mode}    = $opts->{mode} // (O_CREAT | O_RDWR);

    my $self = bless \%h, $class;
    $self->_lock;
    $self;
}

# return 1 if we lock, 0 if already locked. die on failure.
sub _lock {
    my $self = shift;

    # already locked
    return 0 if $self->{_fh};

    my $path = $self->{path};
    my $existed = -f $path;
    my $exists;
    my $tries = 0;
  TRY:
    while (1) {
        $tries++;

lib/File/Flock/Retry.pm  view on Meta::CPAN

        } else {
            $tries <= $self->{retries}
                or die "Can't acquire lock on '$path' after $tries seconds";
            sleep 1;
        }
    }
    $self->{_acquired} = 1;
    1;
}

# return 1 if we unlock, 0 if already unlocked. die on failure.
sub _unlock {
    my ($self) = @_;

    my $path = $self->{path};

    # don't unlock if we are not holding the lock
    return 0 unless $self->{_fh};

    unlink $self->{path} if $self->{_acquired} && !(-s $self->{path});

lib/File/Flock/Retry.pm  view on Meta::CPAN

=head1 METHODS

=head2 lock

Usage:

 $lock = File::Flock::Retry->lock($path, \%opts)

Attempt to acquire an exclusive lock on C<$path>. By default, C<$path> will be
created if not already exists (see L</mode>). If C<$path> is already locked by
another process, will retry every second for a number of seconds (by default
60). Will die if failed to acquire lock after all retries.

Will automatically unlock if C<$lock> goes out of scope. Upon unlock, will
remove C<$path> if it is still empty (zero-sized).

Available options:

=over

t/01-basic.t  view on Meta::CPAN

use File::Flock::Retry;
use File::Slurper qw(write_text);
use File::Spec;
use File::Temp qw(tempdir);

plan skip_all => 'Not tested on Windows yet' if $^O =~ /win32/i;

my $dir = abs_path(tempdir(CLEANUP=>1));
$CWD = $dir;

subtest "create (unlocked)" => sub {
    ok(!(-f "f1"), "f1 doesn't exist before lock");
    my $lock = File::Flock::Retry->lock("f1");
    ok((-f "f1"), "f1 exists after lock");
    $lock->unlock;
    ok(!(-f "f1"), "f1 doesn't exist after unlock");
};

subtest "create (destroyed)" => sub {
    ok(!(-f "f1"), "f1 doesn't exist before lock");
    my $lock = File::Flock::Retry->lock("f1");