File Coverage

blib/lib/Carmel/Lock.pm
Criterion Covered Total %
statement 12 42 28.5
branch 0 10 0.0
condition n/a
subroutine 4 11 36.3
pod 0 5 0.0
total 16 68 23.5


line stmt bran cond sub pod time code
1             package Carmel::Lock;
2 1     1   5 use strict;
  1         2  
  1         25  
3 1     1   5 use warnings;
  1         2  
  1         28  
4 1     1   4 use Fcntl qw(:flock);
  1         1  
  1         108  
5 1     1   5 use Class::Tiny qw(path _handle);
  1         1  
  1         9  
6              
7             sub acquire {
8 0     0 0   my $self = shift;
9              
10 0           $self->path->mkpath;
11              
12 0           my $timeout = 3600; # 1h: reasonable?
13              
14 0 0         my $fh = $self->lockfile->openw or die "Can't open ", $self->lockfile, ": $!";
15 0           $self->_handle($fh);
16              
17 0           while (1) {
18 0 0         flock $fh, LOCK_EX|LOCK_NB and last;
19              
20 0           my $pid = $self->pid;
21 0           warn "Waiting for another carmel process (pid: $pid) to finish.\n";
22              
23             local $SIG{ALRM} = sub {
24 0     0     die "Couldn't get lock held by $pid for ${timeout}s, giving up.\n";
25 0           };
26 0           alarm $timeout;
27              
28 0 0         flock $fh, LOCK_EX
29             or die "Couldn't get lock held by $pid\n";
30             }
31              
32 0           $self->pidfile->spew("$$\n");
33              
34 0           return 1;
35             }
36              
37             sub pid {
38 0     0 0   my $self = shift;
39              
40 0 0         if ($self->pidfile->exists) {
41 0           chomp(my $pid = $self->pidfile->slurp);
42 0           return $pid;
43             }
44              
45 0           return '';
46             }
47              
48             sub lockfile {
49 0     0 0   my $self = shift;
50 0           $self->path->child('lock');
51             }
52              
53             sub pidfile {
54 0     0 0   my $self = shift;
55 0           $self->path->child('pid');
56             }
57              
58             sub release {
59 0     0 0   my $self = shift;
60              
61 0 0         return unless $self->_handle;
62              
63 0           $self->_handle->close;
64 0           $self->pidfile->remove;
65             }
66              
67             sub DESTROY {
68 0     0     my $self = shift;
69 0           $self->release;
70             }
71              
72             1;