File Coverage

blib/lib/Cache/LRU.pm

Criterion	Covered	Total	%
statement	44	52	84.6
branch	8	12	66.6
condition			n/a
subroutine	10	10	100.0
pod	5	5	100.0
total	67	79	84.8

package Cache::LRU;

use strict;
use warnings;

use 5.008_001;

use Scalar::Util qw();

our $VERSION = '0.04';

sub GC_FACTOR () { 10 }

sub new {
    my ($klass, %args) = @_;
    return bless {
        size    => 1024,
        %args,
        _entries => {}, # $key => $weak_valueref
        _fifo    => [], # fifo queue of [ $key, $valueref ]
    }, $klass;
}

sub set {
    my ($self, $key, $value) = @_;

    my $entries = $self->{_entries};

    if (my $old_value_ref = $entries->{$key}) {
        $$old_value_ref = undef;
    }

    # register
    my $value_ref = \$value;
    Scalar::Util::weaken($entries->{$key} = $value_ref);
    $self->_update_fifo($key, $value_ref);

    # expire the oldest entry if full
    while (scalar(keys %$entries) > $self->{size}) {
        my $exp_key = shift(@{$self->{_fifo}})->[0];
        delete $entries->{$exp_key}
            unless $entries->{$exp_key};
    }

    $value;
}

sub remove {
    my ($self, $key) = @_;
    my $value_ref = delete $self->{_entries}->{$key};
    return undef unless $value_ref;
    my $value = $$value_ref;
    $$value_ref = undef;
    $value;
}

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

    my $value_ref = $self->{_entries}->{$key};
    return undef unless $value_ref;

    $self->_update_fifo($key, $value_ref);
    $$value_ref;
}

sub clear {
    my $self = shift;

    $self->{_entries} = {};
    $self->{_fifo} = [];
}

sub _update_fifo {
    # precondition: $self->{_entries} should contain given key
    my ($self, $key, $value_ref) = @_;
    my $fifo = $self->{_fifo};

    push @$fifo, [ $key, $value_ref ];
    if (@$fifo >= $self->{size} * GC_FACTOR) {
        my $entries = $self->{_entries};
        my @new_fifo;
        my %need = map { $_ => 1 } keys %$entries;
        while (%need) {
            my $fifo_entry = pop @$fifo;
            unshift @new_fifo, $fifo_entry
                if delete $need{$fifo_entry->[0]};
        }
        $self->{_fifo} = \@new_fifo;
    }
}

1;
__END__