File Coverage

blib/lib/Narada/Lock.pm

Criterion	Covered	Total	%
statement	74	85	87.0
branch	12	40	30.0
condition	2	5	40.0
subroutine	22	23	95.6
pod	5	5	100.0
total	115	158	72.7

package Narada::Lock;

use warnings;
use strict;
use Carp;

our $VERSION = 'v2.3.8';

use Export::Attrs;
use Narada;
use Fcntl qw( :DEFAULT :flock F_SETFD FD_CLOEXEC );
use Errno;
use Time::HiRes qw( sleep );


use constant IS_NARADA1 => eval { local $SIG{__DIE__}; Narada::detect('narada-1') } || undef;
use constant DIR        => IS_NARADA1 ? 'var/' : q{};
use constant LOCKNEW    => DIR.'.lock.new';
use constant LOCKFILE   => DIR.'.lock';
use constant TICK       => 0.1;

my $F_lock;


sub shared_lock :Export {
    my $timeout = shift;
    return 1 if $ENV{NARADA_SKIP_LOCK};
    sysopen $F_lock, LOCKFILE, O_RDONLY|O_CREAT         or croak "open: $!";
    while (1) {
        next            if -e LOCKNEW;
        last            if flock $F_lock, LOCK_SH|LOCK_NB;
        $!{EWOULDBLOCK}                                 or croak "flock: $!";
    } continue {
        return          if defined $timeout and (($timeout-=TICK) < TICK);
        sleep TICK;
    }
    return 1;
}

sub exclusive_lock :Export {
    return if $ENV{NARADA_SKIP_LOCK};
    sysopen $F_lock, LOCKFILE, O_WRONLY|O_CREAT         or croak "open: $!";
    while (1) {
        last if flock $F_lock, LOCK_EX|LOCK_NB;
        $!{EWOULDBLOCK}                                 or croak "flock: $!";
        system('touch', LOCKNEW) == 0                   or croak "touch: $!/$?";
        sleep TICK;
    }
    system('touch', LOCKNEW) == 0                       or croak "touch: $!/$?";
    return;
}

sub unlock_new :Export {
    return if $ENV{NARADA_SKIP_LOCK};
    unlink LOCKNEW;
    return;
}

sub unlock :Export {
    return if $ENV{NARADA_SKIP_LOCK};
    if ($F_lock) {
        flock $F_lock, LOCK_UN                          or croak "flock: $!";
    }
    return;
}

sub child_inherit_lock :Export {
    my ($is_inherit) = @_;
    return if $ENV{NARADA_SKIP_LOCK};
    if ($F_lock) {
        fcntl $F_lock, F_SETFD, $is_inherit ? 0 : FD_CLOEXEC or croak "fcntl: $!";
    }
    return;
}


1; # Magic true value required at end of module
__END__