File Coverage

blib/lib/App/Highlander.pm

Criterion	Covered	Total	%
statement	25	38	65.7
branch	1	10	10.0
condition	4	11	36.3
subroutine	7	9	77.7
pod	2	2	100.0
total	39	70	55.7

# ABSTRACT: Module that provides simple named locks
package App::Highlander;
$App::Highlander::VERSION = '0.001';
use strict;
use warnings;

use English qw(-no_match_vars);
use Fcntl qw(:flock);
use Path::Tiny;

our $LOCKDIR = '/var/highlander/';
our $LOCKFILE;

sub get_lock {
   my ($lock_string) = @_;
   $lock_string = _build_lock_string($lock_string);

   open $LOCKFILE, '>>', $lock_string
      or die "Unable to create LOCKFILE '$lock_string': $!";

   my $got_lock;
   if ( $got_lock = flock($LOCKFILE, LOCK_EX|LOCK_NB) ) {
      print {$LOCKFILE} $PID;
   }

   return $got_lock ? $lock_string : 0;
}

sub release_lock {
   my ($lock_string) = @_;
   return unless _have_lock($lock_string);

   $lock_string = _build_lock_string($lock_string);
   return close($LOCKFILE) && unlink($lock_string)
      ? $lock_string
      : 0;
}

sub _have_lock {
   my ($lock_string) = @_;
   $lock_string = _build_lock_string($lock_string);

   my $PID_PATTERN = qr/^$PID/;
   return -e $lock_string && `cat $lock_string` =~ m/$PID_PATTERN/;
}

sub _build_lock_string {
   my ($lock_string) = @_;
   $lock_string //= '';

   my ($normalized_programname) = $PROGRAM_NAME;
   $normalized_programname =~ s|^.*/||;
   $normalized_programname =~ s|\..*$||;

   my $lock_name = join ':',
      ($lock_string || ()),"${normalized_programname}.lock";
   return path($LOCKDIR, $lock_name)->canonpath;
}

1;

__END__