File Coverage

blib/lib/SHARYANTO/File/Flock.pm

Criterion	Covered	Total	%
statement	54	58	93.1
branch	11	20	55.0
condition	6	10	60.0
subroutine	10	11	90.9
pod	3	3	100.0
total	84	102	82.3

package SHARYANTO::File::Flock;

use 5.010;
use strict;
use warnings;

use Fcntl ':flock';

our $VERSION = '0.57'; # VERSION

sub lock {
    my ($class, $path, $opts) = @_;
    $opts //= {};
    my %h;

    defined($path) or die "Please specify path";
    $h{path}    = $path;
    $h{retries} = $opts->{retries} // 60;

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

        # 1
        open $self->{_fh}, ">>", $path
            or die "Can't open lock file '$path': $!";

        # 2
        my @st1 = stat($self->{_fh}); # stat before lock

        # 3
        if (flock($self->{_fh}, LOCK_EX | LOCK_NB)) {
            # if file is unlinked by another process between 1 & 2, @st1 will be
            # empty and we check here.
            redo TRY unless @st1;

            # 4
            my @st2 = stat($path); # stat after lock

            # if file is unlinked between 3 & 4, @st2 will be empty and we check
            # here.
            redo TRY unless @st2;

            # if file is recreated between 2 & 4, @st1 and @st2 will differ in
            # dev/inode, we check here.
            redo TRY if $st1[0] != $st2[0] || $st1[1] != $st2[1];

            # everything seems okay
            last;
        } else {
            $tries <= $self->{retries}
                or die "Can't acquire lock on '$path' after $tries seconds";
            sleep 1;
        }
    }
    $self->{_created} = !$existed;
    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->{_created} && !(-s $self->{path});

    {
        # to shut up warning about flock on closed filehandle (XXX but why
        # closed if we are holding the lock?)
        no warnings;

        flock $self->{_fh}, LOCK_UN;
    }
    close delete($self->{_fh});
    1;
}

sub release {
    my $self = shift;
    $self->_unlock;
}

sub unlock {
    my $self = shift;
    $self->_unlock;
}

sub DESTROY {
    my $self = shift;
    $self->_unlock;
}

1;
#ABSTRACT: Yet another flock module

__END__