File Coverage

lib/Ubic/SingletonLock.pm
Criterion Covered Total %
statement 26 26 100.0
branch 2 2 100.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 36 36 100.0


line stmt bran cond sub pod time code
1             package Ubic::SingletonLock;
2             $Ubic::SingletonLock::VERSION = '1.60';
3 23     23   70 use strict;
  23         24  
  23         475  
4 23     23   60 use warnings;
  23         24  
  23         393  
5              
6             # ABSTRACT: lock which can be safely created several times from the same process without deadlocking
7              
8              
9 23     23   69 use Params::Validate;
  23         20  
  23         893  
10 23     23   79 use Scalar::Util qw(weaken);
  23         26  
  23         719  
11              
12 23     23   97 use Ubic::Lockf;
  23         26  
  23         3256  
13              
14             our %LOCKS;
15              
16             sub new {
17 52     52 1 344 my ($class, $file, $options) = validate_pos(@_, 1, 1, 0);
18              
19 52 100       169 if ($LOCKS{$file}) {
20 23         106 return $LOCKS{$file};
21             }
22 29         117 my $lock = lockf($file, $options);
23 29         143 my $self = bless { file => $file, lock => $lock } => $class;
24              
25 29         107 $LOCKS{$file} = $self;
26 29         75 weaken $LOCKS{$file};
27 29         150 return $self;
28             }
29              
30             sub DESTROY {
31 27     27   2054741 my $self = shift;
32 27         43 local $@;
33 27         219 delete $LOCKS{ $self->{file} };
34             }
35              
36              
37             1;
38              
39             __END__