File Coverage

blib/lib/Cache/Isolator.pm

Criterion	Covered	Total	%
statement	21	63	33.3
branch	0	18	0.0
condition	0	18	0.0
subroutine	7	15	46.6
pod	5	5	100.0
total	33	119	27.7

package Cache::Isolator;

use strict;
use warnings;
use Carp;
use Try::Tiny;
use Time::HiRes;
use List::Util qw/shuffle/;
use Class::Accessor::Lite (
    ro  => [ qw(cache interval timeout concurrency trial early_expires_ratio expires_before) ],
);

our $VERSION = '0.02';

sub new {
    my $class = shift;
    my %args = (
        interval => 0.01,
        timeout => 10,
        trial => 0,
        concurrency => 1,
        early_expires_ratio => 0,
        expires_before => 10,
        @_
    );

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

    bless \%args, $class;
}

sub get_or_set {
    my ($self, $key, $cb, $expires ) = @_;

    my $value;
    my $try = 0;

    TRYLOOP: while  ( 1 ) {
        $value = $self->get($key);
        last TRYLOOP if $value;

        $try++;
        my @lockkeys = map { $key .":lock:". $_ } shuffle 1..$self->concurrency;
        foreach my $lockkey ( @lockkeys ) {
            my $locked = $self->cache->add($lockkey, 1, $self->timeout ); #lock
            if ( $locked ) {
                try {
                    $value = $self->get($key);
                    return 1 if $value;
                    $value = $cb->();
                    $self->set( $key, $value, $expires );
                }
                catch {
                    die $_;
                }
                finally {
                    $self->cache->delete( $lockkey ); #lock
                };
                last TRYLOOP;
            }
        }
        die "reached max trial count" if $self->trial > 0 && $try >= $self->trial;
        Time::HiRes::sleep( $self->interval );
    }
    return $value;
}

sub set {
    my ($self, $key, $value, $expires) = @_;
    $self->cache->set($key, $value, $expires);
    if ( $self->early_expires_ratio > 0 ) {
        $expires = $expires - $self->expires_before;
        $expires = 1 if $expires <= 0;
        $self->cache->set($key . ":earlyexp", $value, $expires);
    }
}

sub get {
    my ($self, $key) = @_;
    if ( $self->early_expires_ratio > 0  &&
             int(rand($self->early_expires_ratio)) == 0 ) {
        return $self->cache->get($key.":earlyexp");
    }
    my $result = $self->cache->get($key);
    $result = $self->cache->get($key.":earlyexp") if ! defined $result;
    $result;
}

sub delete {
    my ($self, $key) = @_;
    $self->cache->delete($key.":earlyexp");
    $self->cache->delete($key);
}

1;
__END__