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

package KeyedMutex::Memcached;

use strict;
use warnings;
use Carp;
use Scope::Guard qw(scope_guard);
use Time::HiRes ();

our $VERSION = '0.05';

sub new {
    my $class = shift;
    my $args = ref $_[0] ? $_[0] : +{@_};
    $args = +{
        interval => 0.01,
        trial    => 0,
        timeout  => 30,
        prefix   => 'km',
        cache    => undef,
        %$args,
        locked => 0,
    };

    croak('cache value should be object and appeared add and delete methods.')
      unless ( $args->{cache}
        && UNIVERSAL::can( $args->{cache}, 'add' )
        && UNIVERSAL::can( $args->{cache}, 'delete' ) );

    bless $args => $class;
}

sub lock {
    my ( $self, $key, $use_raii ) = @_;

    $key = $self->{prefix} . ':' . $key if ( $self->{prefix} );
    $self->{key}    = $key;
    $self->{locked} = 0;

    my $i  = 0;
    my $rv = 0;

    while ( $self->{trial} == 0 || ++$i <= $self->{trial} ) {
        $rv = $self->{cache}->add( $key, 1, $self->{timeout} ) ? 1 : 0;
        if ($rv) {
            $self->{locked} = 1;
            last;
        }
        Time::HiRes::sleep( $self->{interval} * rand(1) );
    }

    return $rv ? ( $use_raii ? scope_guard sub { $self->release } : 1 ) : 0;
}

sub release {
    my $self = shift;
    $self->{cache}->delete( $self->{key} );
    $self->{locked} = 0;
    1;
}

1;
__END__