File Coverage

blib/lib/Cache/CacheSizer.pm
Criterion Covered Total %
statement 60 61 98.3
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.4 2002/04/07 17:04:46 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   9 use strict;
  2         2  
  2         67  
15              
16 2     2   10 use Cache::Cache;
  2         2  
  2         69  
17 2     2   620 use Cache::CacheMetaData;
  2         4  
  2         63  
18 2     2   675 use Cache::CacheUtils qw ( Assert_Defined );
  2         4  
  2         111  
19 2     2   827 use Cache::SizeAwareCache qw ( $NO_MAX_SIZE );
  2         4  
  2         1243  
20              
21              
22             sub new
23             {
24 6     6 1 11 my ( $proto, $p_cache, $p_max_size ) = @_;
25 6   33     26 my $class = ref( $proto ) || $proto;
26 6         12 my $self = {};
27 6         14 bless( $self, $class );
28 6         18 Assert_Defined( $p_cache );
29 6         15 Assert_Defined( $p_max_size );
30 6         19 $self->_set_cache( $p_cache );
31 6         19 $self->set_max_size( $p_max_size );
32 6         20 return $self;
33             }
34              
35              
36             sub update_access_time
37             {
38 63     63 1 89 my ( $self, $p_key ) = @_;
39              
40 63         176 Assert_Defined( $p_key );
41              
42 63         153 my $object = $self->_get_cache( )->get_object( $p_key );
43              
44 63 100       181 if ( defined $object )
45             {
46 47         159 $object->set_accessed_at( time( ) );
47 47         110 $self->_get_cache( )->set_object( $p_key, $object );
48             }
49             }
50              
51              
52             sub limit_size
53             {
54 70     70 1 102 my ( $self, $p_new_size ) = @_;
55              
56 70         172 Assert_Defined( $p_new_size );
57              
58 70 100       322 return if $p_new_size == $NO_MAX_SIZE;
59              
60 6         21 _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   12 my ( $p_cache, $p_cache_meta_data, $p_new_size ) = @_;
72              
73 6         18 Assert_Defined( $p_cache );
74 6         16 Assert_Defined( $p_cache_meta_data );
75 6         12 Assert_Defined( $p_new_size );
76              
77 6 50       20 $p_new_size >= 0 or
78             throw Error::Simple( "p_new_size >= 0 required" );
79              
80 6         17 my $size_estimate = $p_cache_meta_data->get_cache_size( );
81              
82 6 50       21 return if $size_estimate <= $p_new_size;
83              
84 6         20 foreach my $key ( $p_cache_meta_data->build_removal_list( ) )
85             {
86 20 100       58 return if $size_estimate <= $p_new_size;
87 14         37 $size_estimate -= $p_cache_meta_data->build_object_size( $key );
88 14         40 $p_cache->remove( $key );
89 14         65 $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   12 my ( $self ) = @_;
99              
100 6         47 my $cache_meta_data = new Cache::CacheMetaData( );
101              
102 6         19 foreach my $key ( $self->_get_cache( )->get_keys( ) )
103             {
104 20 50       51 my $object = $self->_get_cache( )->get_object( $key ) or
105             next;
106              
107 20         64 $cache_meta_data->insert( $object );
108             }
109              
110 6         27 return $cache_meta_data;
111             }
112              
113              
114              
115             sub _get_cache
116             {
117 142     142   168 my ( $self ) = @_;
118              
119 142         516 return $self->{_Cache};
120             }
121              
122              
123             sub _set_cache
124             {
125 6     6   9 my ( $self, $p_cache ) = @_;
126              
127 6         20 $self->{_Cache} = $p_cache;
128             }
129              
130              
131             sub get_max_size
132             {
133 66     66 1 80 my ( $self ) = @_;
134              
135 66         242 return $self->{_Max_Size};
136             }
137              
138              
139             sub set_max_size
140             {
141 8     8 0 13 my ( $self, $p_max_size ) = @_;
142              
143 8         17 $self->{_Max_Size} = $p_max_size;
144             }
145              
146              
147             1;
148              
149              
150             __END__