File Coverage

blib/lib/Narada/Lock.pm
Criterion Covered Total %
statement 74 85 87.0
branch 12 40 30.0
condition 2 5 40.0
subroutine 22 23 95.6
pod 5 5 100.0
total 115 158 72.7


line stmt bran cond sub pod time code
1             package Narada::Lock;
2              
3 16     16   1910192 use warnings;
  16         29  
  16         662  
4 16     16   78 use strict;
  16         28  
  16         377  
5 16     16   64 use Carp;
  16         38  
  16         1356  
6              
7             our $VERSION = 'v2.3.6';
8              
9 16     16   8734 use Export::Attrs;
  16         133381  
  16         141  
10 16     16   3043 use Narada;
  16         31  
  16         597  
11 16     16   106 use Fcntl qw( :DEFAULT :flock F_SETFD FD_CLOEXEC );
  16         59  
  16         8224  
12 16     16   1227 use Errno;
  16         2113  
  16         945  
13 16     16   1227 use Time::HiRes qw( sleep );
  16         2474  
  16         206  
14              
15              
16 16   100 16   2680 use constant IS_NARADA1 => eval { local $SIG{__DIE__}; Narada::detect('narada-1') } || undef;
  16         28  
  16         34  
17 16     16   95 use constant DIR => IS_NARADA1 ? 'var/' : q{};
  16         25  
  16         1092  
18 16     16   81 use constant LOCKNEW => DIR.'.lock.new';
  16         22  
  16         976  
19 16     16   74 use constant LOCKFILE => DIR.'.lock';
  16         22  
  16         858  
20 16     16   86 use constant TICK => 0.1;
  16         36  
  16         3866  
21              
22             my $F_lock;
23              
24              
25             sub shared_lock :Export {
26 22     22 1 60 my $timeout = shift;
27 22 50       121 return 1 if $ENV{NARADA_SKIP_LOCK};
28 22 50       1430 sysopen $F_lock, LOCKFILE, O_RDONLY|O_CREAT or croak "open: $!";
29 22         80 while (1) {
30 22 50       403 next if -e LOCKNEW;
31 22 50       260 last if flock $F_lock, LOCK_SH|LOCK_NB;
32 0 0       0 $!{EWOULDBLOCK} or croak "flock: $!";
33             } continue {
34 0 0 0     0 return if defined $timeout and (($timeout-=TICK) < TICK);
35 0         0 sleep TICK;
36             }
37 22         83 return 1;
38 16     16   118 }
  16         23  
  16         114  
39              
40             sub exclusive_lock :Export {
41 28 50   28 1 181 return if $ENV{NARADA_SKIP_LOCK};
42 28 50       1327 sysopen $F_lock, LOCKFILE, O_WRONLY|O_CREAT or croak "open: $!";
43 28         69 while (1) {
44 28 50       472 last if flock $F_lock, LOCK_EX|LOCK_NB;
45 0 0       0 $!{EWOULDBLOCK} or croak "flock: $!";
46 0 0       0 system('touch', LOCKNEW) == 0 or croak "touch: $!/$?";
47 0         0 sleep TICK;
48             }
49 28 50       121996 system('touch', LOCKNEW) == 0 or croak "touch: $!/$?";
50 28         657 return;
51 16     16   7809 }
  16         33  
  16         78  
52              
53             sub unlock_new :Export {
54 22 50   22 1 155 return if $ENV{NARADA_SKIP_LOCK};
55 22         1157 unlink LOCKNEW;
56 22         94 return;
57 16     16   4470 }
  16         25  
  16         73  
58              
59             sub unlock :Export {
60 22 50   22 1 143 return if $ENV{NARADA_SKIP_LOCK};
61 22 50       132 if ($F_lock) {
62 22 50       254 flock $F_lock, LOCK_UN or croak "flock: $!";
63             }
64 22         60 return;
65 16     16   4812 }
  16         26  
  16         71  
66              
67             sub child_inherit_lock :Export {
68 0     0 1   my ($is_inherit) = @_;
69 0 0         return if $ENV{NARADA_SKIP_LOCK};
70 0 0         if ($F_lock) {
71 0 0         fcntl $F_lock, F_SETFD, $is_inherit ? 0 : FD_CLOEXEC or croak "fcntl: $!";
    0          
72             }
73 0           return;
74 16     16   5412 }
  16         27  
  16         59  
75              
76              
77             1; # Magic true value required at end of module
78             __END__