File Coverage

blib/lib/IPC/ConcurrencyLimit.pm

Criterion	Covered	Total	%
statement	33	42	78.5
branch	13	18	72.2
condition	0	2	0.0
subroutine	9	10	90.0
pod	6	6	100.0
total	61	78	78.2

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

our $VERSION = '0.17';

use Carp qw(croak);

sub new {
  my $class = shift;
  my %params = @_;
  my $type = delete $params{type};
  $type = 'Flock' if not defined $type;

  my $lock_class = $class . "::Lock::$type";
  if (not eval "require $lock_class; 1;") {
    my $err = $@ || 'Zombie error';
    croak("Invalid lock type '$type'. Could not load lock class '$lock_class': $err");
  }

  my $self = bless {
    opt => {
      max_procs => 1,
      %params,
    },
    lock_class => $lock_class,
    lock_obj => undef,
  } => $class;

  return $self;
}

sub get_lock {
  my $self = shift;
  return $self->{lock_obj}->id() if $self->{lock_obj};

  my $class = $self->{lock_class};
  $self->{lock_obj} = $class->new($self->{opt});

  return $self->{lock_obj} ? $self->{lock_obj}->id() : undef;
}

sub is_locked {
  my $self = shift;
  return $self->{lock_obj} ? 1 : 0;
}

sub release_lock {
  my $self = shift;
  return undef if not $self->{lock_obj};
  $self->{lock_obj} = undef;
  return 1;
}

sub lock_id {
  my $self = shift;
  return undef if not $self->{lock_obj};
  return $self->{lock_obj}->id;
}

sub heartbeat {
  my $self = shift;
  my $lock = $self->{lock_obj};
  return if not $lock;
  if (not $lock->heartbeat) {
    $self->release_lock;
    return();
  }
  return 1;
}

1;

__END__