view release on metacpan or  search on metacpan

lib/App/Highlander.pm  view on Meta::CPAN

# 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__

=pod

=encoding UTF-8

=head1 NAME

App::Highlander - Module that provides simple named locks

=head1 VERSION

version 0.003

=head1 SYNOPSIS

 use App::Highlander; 

 App::Highlander::get_lock();

 # ...

 App::Highlander::release_lock(); 

or 

 use App::Highlander; 

 my $has_lock = App::Highlander::get_lock('lockstring');
 while ( ! $has_lock ) {
    sleep 10;
    $has_lock = App::Highlander::get_lock('lockstring');
 }
 # ... code ...

 App::Highlander::release_lock('lockstring');

or

 use App::Highlander LOCKDIR => "$ENV{HOME}/.locks";
 
 ...

=head1 DESCRIPTION

Simple module that provides a named locking mechanism based on flock. Application code requests a lock, then executes, then releases the lock. Lockfiles are stored in a temporary directory created by File::Temp::tempdir( CLEANUP => 1 ) by default. Yo...

App::Highlander does *not* currently (and may never) handle errors, this means that if your application dies under Highlander then it will not have released the lock. Application code will need to capture the error with eval or a sugary module like T...