File Coverage

blib/lib/MooX/Role/RunAlone.pm

Criterion	Covered	Total	%
statement	28	44	63.6
branch	2	14	14.2
condition	0	2	0.0
subroutine	9	9	100.0
pod	1	1	100.0
total	40	70	57.1

package MooX::Role::RunAlone;

use 5.006;
use strict;
use warnings;

use Fcntl ':flock';

#use Moo::Role;
use Role::Tiny;

our $VERSION = 'v0.0.0_01';

my $verbose = !!$ENV{VERBOSE_RUNALONE};
my $retry   = $ENV{RETRY_RUNALONE};

my $data_pkg = 'main::DATA';

my @call_info = caller(6);
my $pkg       = $call_info[0];

sub runalone_lock {
    no strict 'refs';
    no warnings;    # to shut up "tell() on unopened filehandle"
    if ( tell( *{$data_pkg} ) == -1 ) {

        # if we reach this then the __END__ tag does not exist. swap in the
        # calling script namespace to see if the __DATA__ tag exists.
        $data_pkg = $pkg . '::DATA';

        if ( ( tell( *{$data_pkg} ) == -1 ) ) {
            warn "FATAL: No __DATA__ or __END__ tag found\n";
            exit 2;
        }
    }

    # are we alone?
    use warnings;    # safe to turn these on again
    if ( !flock( *{$data_pkg}, LOCK_EX | LOCK_NB ) ) {

        # retry if requested
        if ($retry) {
            warn "Retrying lock attempt ...\n" if $verbose;
            my ( $times, $sleep ) = split ',', $retry;
            $sleep ||= 1;
            while ( $times-- ) {
                sleep $sleep;

                # we're alone!
                goto ALLOK if flock *{$data_pkg}, LOCK_EX | LOCK_NB;
            }
            warn "Retrying lock failed ...\n" if $verbose;
        }

        # we're done
        warn "FATAL: A copy of '$0' is already running\n";
        exit 1;
    }

  ALLOK:
    return;
}

# deferring
if ( $ENV{DEFER_RUNALONE} ) {
    warn "Deferring " . __PACKAGE__ . " check for '$0'\n"
      unless $ENV{VERBOSE_RUNALONE};
}
else {
    __PACKAGE__->runalone_lock();
}

1;
__END__