File Coverage

blib/lib/App/Highlander.pm

Criterion	Covered	Total	%
statement	47	49	95.9
branch	8	14	57.1
condition	7	14	50.0
subroutine	12	12	100.0
pod	2	2	100.0
total	76	91	83.5

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

use English qw(-no_match_vars);
use Fcntl qw(:flock);
use File::Temp qw/tempdir/;
use Path::Tiny;

our $LOCKDIR;
sub import {
   my ($self, %args) = @_;

   _create_if_not_exists(
      $LOCKDIR = $args{LOCKDIR} // tempdir( CLEANUP => 1 )
   );
   print "LOCKDIR='$LOCKDIR'\n";
   return;
}

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

sub _create_if_not_exists {
   my ($dir) = @_;
   return if -e $dir;

   mkdir $dir, 0755
      or die "Unable to make directory '$dir': $OS_ERROR";

   return;
}

1;

__END__