File Coverage

blib/lib/IPC/ConcurrencyLimit/Lock/NFS.pm

Criterion	Covered	Total	%
statement	49	51	96.0
branch	8	10	80.0
condition			n/a
subroutine	11	13	84.6
pod	3	3	100.0
total	71	77	92.2

package IPC::ConcurrencyLimit::Lock::NFS;
use 5.008001;
use strict;
use warnings;

our $VERSION = '0.01';

use Carp qw(croak);
use File::Path qw();
use File::Spec;
use Fcntl qw(:DEFAULT :flock);
use File::SharedNFSLock;

use IPC::ConcurrencyLimit::Lock;
our @ISA = qw(IPC::ConcurrencyLimit::Lock);

sub new {
  my $class = shift;
  my $opt = shift;

  my $max_procs = $opt->{max_procs}
    or croak("Need a 'max_procs' parameter");
  my $path = $opt->{path}
    or croak("Need a 'path' parameter");

  my $h = {};
  my $self = bless {
    max_procs => $max_procs,
    path      => $path,
    the_lock  => undef,
    lock_file => undef,
    id        => undef,
    unique    => "$h",
    unique_s  => $h,
  } => $class;
  $self->{unique} =~ s/[^A-Za-z0-9.-_]+//g;
  $self->{unique} =~ s/HASH//;

  $self->_get_lock() or return undef;

  return $self;
}

sub _get_lock {
  my $self = shift;

  File::Path::mkpath($self->{path});

  for my $worker (1 .. $self->{max_procs}) {
    my $lock_file = File::Spec->catfile($self->{path}, $worker);

    my $lock = File::SharedNFSLock->new(
      file => $lock_file,
      timeout_acquire => 0,
      timeout_stale => 0,
      unique_token => $self->{unique},
    );

    if ($lock->lock()) {
      $self->{the_lock} = $lock;
      $self->{id} = $worker;
      $self->{lock_file} = $lock_file;
      last;
    }
  }

  return undef if not $self->{id};
  return 1;
}

sub lock_file { $_[0]->{lock_file} }
sub path { $_[0]->{path} }

# Normally needs implementing to release the lock,
# but in this case, we just hold on to the file handle that's flocked.
# Thus, it will be released as soon as this object is freed.
#sub DESTROY {}

1;

__END__