File Coverage

blib/lib/KeyedMutex/Memcached.pm
Criterion Covered Total %
statement 15 38 39.4
branch 0 14 0.0
condition 0 9 0.0
subroutine 5 9 55.5
pod 3 3 100.0
total 23 73 31.5


line stmt bran cond sub pod time code
1             package KeyedMutex::Memcached;
2              
3 2     2   193369 use strict;
  2         4  
  2         92  
4 2     2   12 use warnings;
  2         4  
  2         71  
5 2     2   11 use Carp;
  2         7  
  2         195  
6 2     2   1298 use Scope::Guard qw(scope_guard);
  2         1026  
  2         135  
7 2     2   754 use Time::HiRes ();
  2         1649  
  2         814  
8              
9             our $VERSION = '0.05';
10              
11             sub new {
12 0     0 1   my $class = shift;
13 0 0         my $args = ref $_[0] ? $_[0] : +{@_};
14 0           $args = +{
15             interval => 0.01,
16             trial => 0,
17             timeout => 30,
18             prefix => 'km',
19             cache => undef,
20             %$args,
21             locked => 0,
22             };
23              
24 0 0 0       croak('cache value should be object and appeared add and delete methods.')
      0        
25             unless ( $args->{cache}
26             && UNIVERSAL::can( $args->{cache}, 'add' )
27             && UNIVERSAL::can( $args->{cache}, 'delete' ) );
28              
29 0           bless $args => $class;
30             }
31              
32             sub lock {
33 0     0 1   my ( $self, $key, $use_raii ) = @_;
34              
35 0 0         $key = $self->{prefix} . ':' . $key if ( $self->{prefix} );
36 0           $self->{key} = $key;
37 0           $self->{locked} = 0;
38              
39 0           my $i = 0;
40 0           my $rv = 0;
41              
42 0   0       while ( $self->{trial} == 0 || ++$i <= $self->{trial} ) {
43 0 0         $rv = $self->{cache}->add( $key, 1, $self->{timeout} ) ? 1 : 0;
44 0 0         if ($rv) {
45 0           $self->{locked} = 1;
46 0           last;
47             }
48 0           Time::HiRes::sleep( $self->{interval} * rand(1) );
49             }
50              
51 0 0   0     return $rv ? ( $use_raii ? scope_guard sub { $self->release } : 1 ) : 0;
  0 0          
52             }
53              
54             sub release {
55 0     0 1   my $self = shift;
56 0           $self->{cache}->delete( $self->{key} );
57 0           $self->{locked} = 0;
58 0           1;
59             }
60              
61             1;
62             __END__