File Coverage

blib/lib/Cache/Ref/CAR.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::CAR;
2             BEGIN {
3 1     1   2787 $Cache::Ref::CAR::AUTHORITY = 'cpan:NUFFIN';
4             }
5             BEGIN {
6 1     1   32 $Cache::Ref::CAR::VERSION = '0.05'; # TRIAL
7             }
8             # ABSTRACT: CLOCK with Adaptive Replacement
9              
10 1     1   431 use Moose;
  0            
  0            
11              
12             use List::Util qw(max min);
13             use Cache::Ref::CAR::Base ();
14              
15             use namespace::autoclean;
16              
17             extends qw(Cache::Ref);
18              
19             with qw(Cache::Ref::CAR::Base);
20              
21             sub _mru_history_too_big {
22             my $self = shift;
23              
24             $self->_mru_history_size
25             and
26             $self->_mru_history_size + $self->_mru_size == $self->size;
27             }
28              
29             sub _mfu_history_too_big {
30             my $self = shift;
31              
32             $self->_index_size == $self->size * 2;
33             }
34              
35             sub _decrease_mru_target_size {
36             my $self = shift;
37              
38             if ( $self->_mru_target_size > 0 ) {
39             my $adjustment = int( $self->_mru_history_size / $self->_mfu_history_size );
40             $self->_set_mru_target_size( max( 0, $self->_mru_target_size - max(1, $adjustment) ) );
41             }
42             }
43              
44             sub _increase_mru_target_size {
45             my $self = shift;
46              
47             my $adjustment = int( $self->_mfu_history_size / $self->_mru_history_size );
48             $self->_set_mru_target_size( min( $self->size, $self->_mru_target_size + max(1, $adjustment) ) );
49             }
50              
51             sub _restore_from_mfu_history {
52             my ( $self, $e ) = @_;
53              
54             $self->_mfu_push($e);
55             }
56              
57             sub _restore_from_mru_history {
58             my ( $self, $e ) = @_;
59              
60             $self->_mfu_push($e);
61             }
62              
63             sub expire {
64             my ( $self, $how_many ) = @_;
65              
66             $how_many ||= 1;
67              
68             if ( my $mru = $self->_mru ) {
69             my $cur = $self->_next($mru);
70              
71             # mru pool is too big
72             while ( $cur and $self->_mru_size >= max(1,$self->_mru_target_size) ) {
73             my $next = $self->_next($cur);
74              
75             $self->_circular_splice($cur);
76              
77             if ( $cur->[0] & Cache::Ref::CAR::Base::REF_BIT ) {
78             $cur->[0] &= ~Cache::Ref::CAR::Base::REF_BIT; # turn off reference bit
79              
80             # move to t2 (mfu)
81             $self->_mfu_push($cur);
82              
83             $cur = $next;
84             } else {
85             # reference bit is off, which means this entry is freeable
86              
87             delete $cur->[2]; # delete the value
88              
89             # move to history
90             # MFU_BIT not set
91              
92             if ( $self->_mru_history_head ) {
93             $self->_set_next($cur, $self->_mru_history_head);
94             $self->_set_prev($self->_mru_history_head, $cur);
95             } else {
96             $self->_set_next($cur, undef);
97             }
98              
99             $self->_mru_history_head($cur);
100             $self->_mru_history_tail($cur) unless $self->_mru_history_tail;
101             $self->_inc_mru_history_size;
102              
103              
104             return;
105             }
106             }
107             }
108              
109             for ( 1 .. $how_many ) {
110             my $tail = $self->_mfu || last;
111             my $cur = $self->_next($tail) || last;
112              
113             loop: {
114             if ( $cur->[0] & Cache::Ref::CAR::Base::REF_BIT ) {
115             $cur->[0] &= ~Cache::Ref::CAR::Base::REF_BIT;
116             $tail = $cur;
117             $cur = $self->_next($cur);
118             redo loop;
119             } else {
120             # reference bit is off, which means this entry is freeable
121              
122             $self->_mfu($tail);
123             $self->_circular_splice($cur);
124              
125             delete $cur->[2]; # delete the value
126              
127             # move to history
128             $cur->[0] |= Cache::Ref::CAR::Base::MFU_BIT;
129              
130             if ( $self->_mfu_history_head ) {
131             $self->_set_prev($self->_mfu_history_head, $cur);
132             $self->_set_next($cur, $self->_mfu_history_head);
133             } else {
134             $self->_set_next($cur, undef);
135             }
136              
137             $self->_mfu_history_head($cur);
138             $self->_mfu_history_tail($cur) unless $self->_mfu_history_tail;
139             $self->_inc_mfu_history_size;
140             }
141             }
142             }
143              
144             return;
145             }
146              
147             sub _clear_additional { }
148              
149             __PACKAGE__->meta->make_immutable;
150              
151             __PACKAGE__;
152              
153              
154             # ex: set sw=4 et:
155              
156              
157             __END__
158             =pod
159              
160             =encoding utf-8
161              
162             =head1 NAME
163              
164             Cache::Ref::CAR - CLOCK with Adaptive Replacement
165              
166             =head1 SYNOPSIS
167              
168             my $c = Cache::Ref::CAR->new(
169             size => $n,
170             );
171              
172             =head1 DESCRIPTION
173              
174             This algorithm is an implementation of
175             L<http://www.almaden.ibm.com/cs/people/dmodha/clockfast.pdf|CAR: Clock with Adaptive Replacement, Sorav Bansal and Dharmendra S. Modha>.
176              
177             See also L<Cache::Ref::CART> which is probably more appropriate for random access work loads.
178              
179             CAR balances between an MFU like policy and an MRU like policy, automatically
180             tuning itself as the workload varies.
181              
182             =head1 ATTRIBUTES
183              
184             =over 4
185              
186             =item size
187              
188             The size of the live entries.
189              
190             Note that the cache also remembers this many expired keys, and keeps some
191             metadata about those keys, so for memory usage the overhead is probably around
192             double what L<Cache::Ref::LRU> requires.
193              
194             =back
195              
196             =head1 AUTHOR
197              
198             Yuval Kogman
199              
200             =head1 COPYRIGHT AND LICENSE
201              
202             This software is copyright (c) 2011 by Yuval Kogman.
203              
204             This is free software; you can redistribute it and/or modify it under
205             the same terms as the Perl 5 programming language system itself.
206              
207             =cut
208