File Coverage

blib/lib/Cache/CacheSizer.pm
Criterion Covered Total %
statement 60 61 98.4
branch 9 12 75.0
condition 1 3 33.3
subroutine 14 14 100.0
pod 4 5 80.0
total 88 95 92.6


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: CacheSizer.pm,v 1.5 2003/04/15 14:46:16 dclinton Exp $
3             # Copyright (C) 2001-2003 DeWitt Clinton All Rights Reserved
4             #
5             # Software distributed under the License is distributed on an "AS
6             # IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or
7             # implied. See the License for the specific language governing
8             # rights and limitations under the License.
9             ######################################################################
10              
11              
12             package Cache::CacheSizer;
13              
14 2     2   32 use strict;
  2         29  
  2         31  
15              
16 2     2   31 use Cache::Cache;
  2         18  
  2         34  
17 2     2   94 use Cache::CacheMetaData;
  2         21  
  2         55  
18 2     2   73 use Cache::CacheUtils qw ( Assert_Defined );
  2         23  
  2         49  
19 2     2   78 use Cache::SizeAwareCache qw ( $NO_MAX_SIZE );
  2         21  
  2         65  
20              
21              
22             sub new
23             {
24 6     6 1 85   my ( $proto, $p_cache, $p_max_size ) = @_;
25 6   33     87   my $class = ref( $proto ) || $proto;
26 6         55   my $self = {};
27 6         78   bless( $self, $class );
28 6         74   Assert_Defined( $p_cache );
29 6         64   Assert_Defined( $p_max_size );
30 6         1732   $self->_set_cache( $p_cache );
31 6         67   $self->set_max_size( $p_max_size );
32 6         111   return $self;
33             }
34              
35              
36             sub update_access_time
37             {
38 60     60 1 568   my ( $self, $p_key ) = @_;
39              
40 60         667   Assert_Defined( $p_key );
41              
42 60         656   my $object = $self->_get_cache( )->get_object( $p_key );
43              
44 60 100       946   if ( defined $object )
45               {
46 46         939     $object->set_accessed_at( time( ) );
47 46         533     $self->_get_cache( )->set_object( $p_key, $object );
48               }
49             }
50              
51              
52             sub limit_size
53             {
54 68     68 1 802   my ( $self, $p_new_size ) = @_;
55              
56 68         749   Assert_Defined( $p_new_size );
57              
58 68 100       1126   return if $p_new_size == $NO_MAX_SIZE;
59              
60 6         68   _Limit_Size( $self->_get_cache( ),
61                            $self->_build_cache_meta_data( ),
62                            $p_new_size );
63             }
64              
65              
66             # take a Cache reference and a CacheMetaData reference and
67             # limit the cache's size to new_size
68              
69             sub _Limit_Size
70             {
71 6     6   56   my ( $p_cache, $p_cache_meta_data, $p_new_size ) = @_;
72              
73 6         67   Assert_Defined( $p_cache );
74 6         64   Assert_Defined( $p_cache_meta_data );
75 6         90   Assert_Defined( $p_new_size );
76              
77 6 50       154   $p_new_size >= 0 or
78                 throw Error::Simple( "p_new_size >= 0 required" );
79              
80 6         76   my $size_estimate = $p_cache_meta_data->get_cache_size( );
81              
82 6 50       61   return if $size_estimate <= $p_new_size;
83              
84 6         73   foreach my $key ( $p_cache_meta_data->build_removal_list( ) )
85               {
86 20 100       278     return if $size_estimate <= $p_new_size;
87 14         162     $size_estimate -= $p_cache_meta_data->build_object_size( $key );
88 14         278     $p_cache->remove( $key );
89 14         354     $p_cache_meta_data->remove( $key );
90               }
91              
92 0         0   warn( "Couldn't limit size to $p_new_size" );
93             }
94              
95              
96             sub _build_cache_meta_data
97             {
98 6     6   55   my ( $self ) = @_;
99              
100 6         98   my $cache_meta_data = new Cache::CacheMetaData( );
101              
102 6         59   foreach my $key ( $self->_get_cache( )->get_keys( ) )
103               {
104 20 50       219     my $object = $self->_get_cache( )->get_object( $key ) or
105                   next;
106              
107 20         253     $cache_meta_data->insert( $object );
108               }
109              
110 6         90   return $cache_meta_data;
111             }
112              
113              
114              
115             sub _get_cache
116             {
117 138     138   1324   my ( $self ) = @_;
118              
119 138         3118   return $self->{_Cache};
120             }
121              
122              
123             sub _set_cache
124             {
125 6     6   83   my ( $self, $p_cache ) = @_;
126              
127 6         68   $self->{_Cache} = $p_cache;
128             }
129              
130              
131             sub get_max_size
132             {
133 64     64 1 585   my ( $self ) = @_;
134              
135 64         2233   return $self->{_Max_Size};
136             }
137              
138              
139             sub set_max_size
140             {
141 8     8 0 102   my ( $self, $p_max_size ) = @_;
142              
143 8         86   $self->{_Max_Size} = $p_max_size;
144             }
145              
146              
147             1;
148              
149              
150             __END__
151            
152             =pod
153            
154             =head1 NAME
155            
156             Cache::CacheSizer -- component object for mamanging the size of caches
157            
158             =head1 DESCRIPTION
159            
160             The CacheSizer class is used internally in SizeAware caches such as
161             SizeAwareFileCache to encapsulate the logic of limiting cache size.
162            
163             =head1 SYNOPSIS
164            
165             use Cache::CacheSizer;
166            
167             my $sizer = new Cache::CacheSizer( $cache, $max_size );
168            
169             $sizer->limit_size( $new_size );
170            
171            
172             =head1 METHODS
173            
174             =over
175            
176             =item B<new( $cache, $max_size )>
177            
178             Construct a new Cache::CacheSizer object for the cache I<$cache> with
179             a maximum size of I<$max_size>.
180            
181             =item B<update_access_time( $key )>
182            
183             Inform the cache that the object specified by I<$key> has been accessed.
184            
185             =item B<limit_size( $new_size )>
186            
187             Use the sizing algorithms to get the cache down under I<$new_size> if
188             possible.
189            
190             =back
191            
192             =head1 PROPERTIES
193            
194             =over
195            
196             =item B<get_max_size>
197            
198             The desired size limit for the cache under control.
199            
200             =back
201            
202             =head1 SEE ALSO
203            
204             Cache::Cache, Cache::CacheMetaData, Cache::SizeAwareCache
205            
206             =head1 AUTHOR
207            
208             Original author: DeWitt Clinton <dewitt@unto.net>
209            
210             Last author: $Author: dclinton $
211            
212             Copyright (C) 2001-2003 DeWitt Clinton
213            
214             =cut
215