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.59';
3 23     23   83 use strict;
  23         31  
  23         509  
4 23     23   69 use warnings;
  23         22  
  23         468  
5              
6             # ABSTRACT: lock which can be safely created several times from the same process without deadlocking
7              
8              
9 23     23   71 use Params::Validate;
  23         29  
  23         987  
10 23     23   79 use Scalar::Util qw(weaken);
  23         29  
  23         803  
11              
12 23     23   72 use Ubic::Lockf;
  23         29  
  23         3428  
13              
14             our %LOCKS;
15              
16             sub new {
17 52     52 1 386 my ($class, $file, $options) = validate_pos(@_, 1, 1, 0);
18              
19 52 100       192 if ($LOCKS{$file}) {
20 23         111 return $LOCKS{$file};
21             }
22 29         143 my $lock = lockf($file, $options);
23 29         179 my $self = bless { file => $file, lock => $lock } => $class;
24              
25 29         92 $LOCKS{$file} = $self;
26 29         95 weaken $LOCKS{$file};
27 29         171 return $self;
28             }
29              
30             sub DESTROY {
31 27     27   2721095 my $self = shift;
32 27         40 local $@;
33 27         241 delete $LOCKS{ $self->{file} };
34             }
35              
36              
37             1;
38              
39             __END__