File Coverage

blib/lib/Cache/Ref/LRU.pm
Criterion Covered Total %
statement 3 5 60.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Cache::Ref::LRU;
2             BEGIN {
3 1     1   1621 $Cache::Ref::LRU::AUTHORITY = 'cpan:NUFFIN';
4             }
5             BEGIN {
6 1     1   23 $Cache::Ref::LRU::VERSION = '0.05'; # TRIAL
7             }
8             # ABSTRACT: Least recently used expiry policy
9              
10 1     1   506 use Moose;
  0            
  0            
11              
12             use Cache::Ref::Util::LRU::List;
13              
14             use namespace::autoclean;
15              
16             extends qw(Cache::Ref);
17              
18             with qw(
19             Cache::Ref::Role::API
20             Cache::Ref::Role::Index
21             );
22              
23             has size => (
24             isa => "Int",
25             is => "ro",
26             required => 1,
27             );
28              
29             has lru_class => (
30             isa => "ClassName",
31             is => "ro",
32             default => "Cache::Ref::Util::LRU::List",
33             );
34              
35             has _lru => (
36             does => "Cache::Ref::Util::LRU::API",
37             is => "ro",
38             lazy_build => 1,
39             );
40              
41             sub _build__lru { shift->lru_class->new }
42              
43             sub get {
44             my ( $self, @keys ) = @_;
45              
46             my @e = $self->_index_get(@keys);
47              
48             $self->_lru->hit(map { $_->[1] } grep { defined } @e);
49              
50             return ( @keys == 1 ? $e[0][0] : map { $_ && $_->[0] } @e );
51             }
52              
53             sub hit {
54             my ( $self, @keys ) = @_;
55              
56             $self->_lru->hit( map { $_->[1] } $self->_index_get(@keys) );
57              
58             return;
59             }
60              
61             sub expire {
62             my ( $self, $how_many ) = @_;
63              
64             my $l = $self->_lru;
65             $self->_index_delete( $l->remove_lru ) for 1 .. ($how_many || 1);
66              
67             return;
68             }
69              
70             sub set {
71             my ( $self, $key, $value ) = @_;
72              
73             my $l = $self->_lru;
74              
75             if ( my $e = $self->_index_get($key) ) {
76             $l->hit($e->[1]);
77             $e->[0] = $value;
78             } else {
79             if ( $self->_index_size == $self->size ) {
80             $self->expire(1);
81             }
82              
83             $self->_index_set( $key => [ $value, $l->insert($key) ] );
84             }
85              
86             return $value;
87             }
88              
89             sub clear {
90             my $self = shift;
91              
92             $self->_lru->clear;
93             $self->_index_clear;
94              
95             return;
96             }
97              
98             sub remove {
99             my ( $self, @keys ) = @_;
100              
101             $self->_lru->remove(map { $_->[1] } $self->_index_delete(@keys));
102              
103             return;
104             }
105              
106             __PACKAGE__->meta->make_immutable;
107              
108             __PACKAGE__;
109              
110              
111             # ex: set sw=4 et:
112              
113             __END__
114             =pod
115              
116             =encoding utf-8
117              
118             =head1 NAME
119              
120             Cache::Ref::LRU - Least recently used expiry policy
121              
122             =head1 SYNOPSIS
123              
124             my $c = Cache::Ref::LRU->new(
125             size => $n,
126             );
127              
128             =head1 DESCRIPTION
129              
130             This is an implementation of the least recently used expiry policy.
131              
132             It provides both an array and a doubly linked list based implementation. See
133             L<Cache::Ref> for a discussion.
134              
135             =head1 ATTRIBUTES
136              
137             =over 4
138              
139             =item size
140              
141             The size of the live entries.
142              
143             =item lru_class
144              
145             The class of the LRU list implementation.
146              
147             =back
148              
149             =head1 AUTHOR
150              
151             Yuval Kogman
152              
153             =head1 COPYRIGHT AND LICENSE
154              
155             This software is copyright (c) 2011 by Yuval Kogman.
156              
157             This is free software; you can redistribute it and/or modify it under
158             the same terms as the Perl 5 programming language system itself.
159              
160             =cut
161