ExclusiveLock-Guard

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

            # inner of lock
        }
        blocking_transaction();
        # outer of lock

    for non-blocking

        sub nonblocking_transaction {
            my $lock = ExclusiveLock::Guard->new('/tmp/foo.lock', nonblocking => 1 )
                or die 'lock error: ' . ExclusiveLock::Guard->errstr;
            unless ($lock->is_locked) {
                warn 'is locked';
                return;
            }

            # inner of lock
        }
        nonblocking_transaction();
        # outer of lock

DESCRIPTION
    ExclusiveLock::Guard is very simple lock maneger. To automatically

lib/ExclusiveLock/Guard.pm  view on Meta::CPAN

my $ERRSTR;

sub errstr { $ERRSTR }

sub new {
    my($class, $filename, %args) = @_;
    my $retry_count = $args{retry_count} || 5;

    my $fh;
    my $count = 0;
    my $is_locked = 1;
    while (1) {
        $ERRSTR = undef;
        $is_locked = 1;
        unless (open $fh, '>', $filename) {
            $ERRSTR = "failed to open file:$filename:$!";
            return;
        }
        if ($args{nonblocking}) {
            unless (flock $fh, LOCK_EX | LOCK_NB) {
                if ($! != EWOULDBLOCK) {
                    $ERRSTR = "failed to flock file:$filename:$!";
                    return;
                }
                $is_locked = 0;
            }
        } else {
            unless (flock $fh, LOCK_EX) {
                $ERRSTR = "failed to flock file:$filename:$!";
                return;
            }
        }
        unless (-f $filename && stat($fh)->ino == do { my $s = stat($filename); $s ? $s->ino : -1 }) {
            unless (flock $fh, LOCK_UN) {
                $ERRSTR = "failed to unlock flock file:$filename:$!";

lib/ExclusiveLock/Guard.pm  view on Meta::CPAN

                return;
            }
            next;
        }
        last;
    }

    bless {
        filename  => $filename,
        fh        => $fh,
        is_locked => $is_locked,
    }, $class;
}

sub is_locked { $_[0]->{is_locked} }

sub DESTROY {
    my $self = shift;
    return unless $self->{is_locked};

    my $fh       = delete $self->{fh};
    my $filename = delete $self->{filename};
    unless (close $fh) {
        warn "failed to close file:$filename:$!";
        return;
    }

    # try unlink lock file
    if (open my $unlink_fh, '<', $filename) { # else is unlinked lock file by another process?
        # A
        if (flock $unlink_fh, LOCK_EX | LOCK_NB) { # else is locked the file by another process
            if (-f $filename && stat($unlink_fh)->ino == do { my $s = stat($filename); $s ? $s->ino : -1 }) { # else is unlink and create file by another process in the A timing
                unless (unlink $filename) {
                    warn "failed to unlink file:$filename:$!";
                }
                unless (flock $unlink_fh, LOCK_UN) {
                    warn "failed to unlock flock file:$filename:$!";
                }
                unless (close $unlink_fh) {
                    warn "failed to close file:$filename:$!";
                }

lib/ExclusiveLock/Guard.pm  view on Meta::CPAN

        # inner of lock
    }
    blocking_transaction();
    # outer of lock

for non-blocking

    sub nonblocking_transaction {
        my $lock = ExclusiveLock::Guard->new('/tmp/foo.lock', nonblocking => 1 )
            or die 'lock error: ' . ExclusiveLock::Guard->errstr;
        unless ($lock->is_locked) {
            warn 'is locked';
            return;
        }

        # inner of lock
    }
    nonblocking_transaction();
    # outer of lock

=head1 DESCRIPTION

t/01_lock.t  view on Meta::CPAN

use File::Spec;
use File::Temp 'tempdir';

use ExclusiveLock::Guard;

my $tmpdir  = tempdir( CLEANUP => 1 );
my $tmpfile = File::Spec->catfile( $tmpdir, 'test.lock' );
do {
    my $lock = ExclusiveLock::Guard->new($tmpfile);
    ok($lock->is_locked);
    ok( -f $tmpfile );
};

ok( not -f $tmpfile );

done_testing;

t/02_unblocking.t  view on Meta::CPAN

my $pid = fork;
die "fork failed: $!" unless defined $pid;
if ($pid) {
    # parent
    sleep 1;

    ok( -f $tmpfile );
    do {
        my $lock1 = ExclusiveLock::Guard->new($tmpfile, nonblocking => 1);
        ok( not $lock1->is_locked);
    };
    ok( -f $tmpfile );

    sleep 2;

    ok( not -f $tmpfile );
    my $lock2 = ExclusiveLock::Guard->new($tmpfile, nonblocking => 1);
    ok($lock2->is_locked);
    ok( -f $tmpfile );

    waitpid $pid, 0;
} else {
    # chiled
    do {
        my $lock = ExclusiveLock::Guard->new($tmpfile);
        sleep 2;
    };
    exit;