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


line stmt bran cond sub pod time code
1             package IPC::ConcurrencyLimit;
2 41     41   74839 use 5.008001;
  41         83  
3 41     41   121 use strict;
  41         40  
  41         569  
4 41     41   120 use warnings;
  41         43  
  41         1212  
5              
6             our $VERSION = '0.16';
7              
8 41     41   124 use Carp qw(croak);
  41         41  
  41         13482  
9              
10             sub new {
11 329     329 1 4709 my $class = shift;
12 329         1180 my %params = @_;
13 329         476 my $type = delete $params{type};
14 329 100       582 $type = 'Flock' if not defined $type;
15              
16 329         986 my $lock_class = $class . "::Lock::$type";
17 329 50       24533 if (not eval "require $lock_class; 1;") {
18 0   0     0 my $err = $@ || 'Zombie error';
19 0         0 croak("Invalid lock type '$type'. Could not load lock class '$lock_class': $err");
20             }
21              
22 329         2304 my $self = bless {
23             opt => {
24             max_procs => 1,
25             %params,
26             },
27             lock_class => $lock_class,
28             lock_obj => undef,
29             } => $class;
30              
31 329         1263 return $self;
32             }
33              
34             sub get_lock {
35 1037     1037 1 7518 my $self = shift;
36 1037 100       3127 return $self->{lock_obj}->id() if $self->{lock_obj};
37            
38 1032         1699 my $class = $self->{lock_class};
39 1032         9582 $self->{lock_obj} = $class->new($self->{opt});
40              
41 1032 100       4604 return $self->{lock_obj} ? $self->{lock_obj}->id() : undef;
42             }
43              
44             sub is_locked {
45 2     2 1 241 my $self = shift;
46 2 100       8 return $self->{lock_obj} ? 1 : 0;
47             }
48              
49             sub release_lock {
50 376     376 1 1023 my $self = shift;
51 376 100       1028 return undef if not $self->{lock_obj};
52 375         555 $self->{lock_obj} = undef;
53 375         1418 return 1;
54             }
55              
56             sub lock_id {
57 2     2 1 4 my $self = shift;
58 2 100       6 return undef if not $self->{lock_obj};
59 1         3 return $self->{lock_obj}->id;
60             }
61              
62             sub heartbeat {
63 0     0 1   my $self = shift;
64 0           my $lock = $self->{lock_obj};
65 0 0         return if not $lock;
66 0 0         if (not $lock->heartbeat) {
67 0           $self->release_lock;
68 0           return();
69             }
70 0           return 1;
71             }
72              
73             1;
74              
75             __END__