File Coverage

blib/lib/Cache/CacheMetaData.pm
Criterion Covered Total %
statement 53 53 100.0
branch 6 10 60.0
condition 1 3 33.3
subroutine 15 15 100.0
pod 6 6 100.0
total 81 87 93.1


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: CacheMetaData.pm,v 1.13 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             package Cache::CacheMetaData;
12              
13 2     2   31 use strict;
  2         27  
  2         28  
14 2     2   30 use Cache::Cache qw( $EXPIRES_NOW $EXPIRES_NEVER );
  2         18  
  2         32  
15              
16             #
17             # the cache meta data structure looks something like the following:
18             #
19             # %meta_data_hash =
20             # (
21             # $key_1 => [ $expires_at, $accessed_at, $object_size ],
22             # $key_2 => [ $expires_at, $accessed_at, $object_size ],
23             # ...
24             # )
25             #
26              
27             my $_EXPIRES_AT_OFFSET = 0;
28             my $_ACCESS_AT_OFFSET = 1;
29             my $_SIZE_OFFSET = 2;
30              
31              
32             sub new
33             {
34 6     6 1 56   my ( $proto ) = @_;
35 6   33     88   my $class = ref( $proto ) || $proto;
36 6         56   my $self = {};
37 6         87   bless( $self, $class );
38 6         72   $self->_set_meta_data_hash_ref( { } );
39 6         66   $self->_set_cache_size( 0 );
40 6         61   return $self;
41             }
42              
43              
44             sub insert
45             {
46 20     20 1 176   my ( $self, $p_object ) = @_;
47              
48 20         240   $self->_insert_object_expires_at( $p_object );
49 20         240   $self->_insert_object_accessed_at( $p_object );
50 20         219   $self->_insert_object_size( $p_object );
51 20         232   $self->_set_cache_size( $self->get_cache_size( ) + $p_object->get_size( ) );
52             }
53              
54              
55             sub remove
56             {
57 14     14 1 207   my ( $self, $p_key ) = @_;
58              
59 14         382   $self->_set_cache_size( $self->get_cache_size( ) -
60                                       $self->build_object_size( $p_key ) );
61              
62 14         138   delete $self->_get_meta_data_hash_ref( )->{ $p_key };
63             }
64              
65              
66             sub build_removal_list
67             {
68 6     6 1 55   my ( $self ) = @_;
69              
70 6         59   my $meta_data_hash_ref = $self->_get_meta_data_hash_ref( );
71              
72               return
73                 sort
74 26         297     {
75 6         74       my $a_expires_at = $meta_data_hash_ref->{ $a }->[ $_EXPIRES_AT_OFFSET ];
76 26         274       my $b_expires_at = $meta_data_hash_ref->{ $b }->[ $_EXPIRES_AT_OFFSET ];
77 26         221       my $a_accessed_at = $meta_data_hash_ref->{ $a }->[ $_ACCESS_AT_OFFSET ];
78 26         226       my $b_accessed_at = $meta_data_hash_ref->{ $b }->[ $_ACCESS_AT_OFFSET ];
79              
80 26 100       254       if ( $a_expires_at eq $b_expires_at )
81                   {
82 2         20         return ( $a_accessed_at <=> $b_accessed_at );
83                   }
84              
85 24 50       221       return -1 if $a_expires_at eq $EXPIRES_NOW;
86 24 50       210       return 1 if $b_expires_at eq $EXPIRES_NOW;
87 24 50       895       return 1 if $a_expires_at eq $EXPIRES_NEVER;
88 24 50       221       return -1 if $b_expires_at eq $EXPIRES_NEVER;
89              
90 24         186       return ( $a_expires_at <=> $b_expires_at );
91              
92                 } keys %$meta_data_hash_ref;
93             }
94              
95              
96              
97             sub build_object_size
98             {
99 28     28 1 316   my ( $self, $p_key ) = @_;
100              
101 28         341   return $self->_get_meta_data_hash_ref( )->{ $p_key }->[ $_SIZE_OFFSET ];
102             }
103              
104              
105             sub _insert_object_meta_data
106             {
107 60     60   544   my ( $self, $p_object, $p_offset, $p_value ) = @_;
108              
109 60         566   $self->_get_meta_data_hash_ref( )->{ $p_object->get_key( ) }->[ $p_offset ] =
110                 $p_value;
111             }
112              
113              
114             sub _insert_object_expires_at
115             {
116 20     20   275   my ( $self, $p_object ) = @_;
117              
118 20         233   $self->_insert_object_meta_data( $p_object,
119                                                $_EXPIRES_AT_OFFSET,
120                                                $p_object->get_expires_at( ) );
121             }
122              
123              
124             sub _insert_object_accessed_at
125             {
126 20     20   313   my ( $self, $p_object ) = @_;
127              
128 20         238   $self->_insert_object_meta_data( $p_object,
129                                                $_ACCESS_AT_OFFSET,
130                                                $p_object->get_accessed_at( ) );
131             }
132              
133              
134             sub _insert_object_size
135             {
136 20     20   208   my ( $self, $p_object ) = @_;
137              
138 20         244   $self->_insert_object_meta_data( $p_object,
139                                                $_SIZE_OFFSET,
140                                                $p_object->get_size( ) );
141             }
142              
143              
144             sub get_cache_size
145             {
146 40     40 1 359   my ( $self ) = @_;
147              
148 40         512   return $self->{_Cache_Size};
149             }
150              
151              
152             sub _set_cache_size
153             {
154 40     40   556   my ( $self, $cache_size ) = @_;
155              
156 40         517   $self->{_Cache_Size} = $cache_size;
157             }
158              
159              
160             sub _get_meta_data_hash_ref
161             {
162 108     108   9564   my ( $self ) = @_;
163              
164 108         1433   return $self->{_Meta_Data_Hash_Ref};
165             }
166              
167              
168             sub _set_meta_data_hash_ref
169             {
170 6     6   55   my ( $self, $meta_data_hash_ref ) = @_;
171              
172 6         66   $self->{_Meta_Data_Hash_Ref} = $meta_data_hash_ref;
173             }
174              
175              
176             1;
177              
178              
179             __END__
180            
181             =pod
182            
183             =head1 NAME
184            
185             Cache::CacheMetaData -- data about objects in the cache
186            
187             =head1 DESCRIPTION
188            
189             The CacheMetaData object is used by size aware caches to keep track of
190             the state of the cache and effeciently return information such as an
191             objects size or an ordered list of indentifiers to be removed when a
192             cache size is being limited. End users will not normally use
193             CacheMetaData directly.
194            
195             =head1 SYNOPSIS
196            
197             use Cache::CacheMetaData;
198            
199             my $cache_meta_data = new Cache::CacheMetaData( );
200            
201             foreach my $key ( $cache->get_keys( ) )
202             {
203             my $object = $cache->get_object( $key ) or
204             next;
205            
206             $cache_meta_data->insert( $object );
207             }
208            
209             my $current_size = $cache_meta_data->get_cache_size( );
210            
211             my @removal_list = $cache_meta_data->build_removal_list( );
212            
213             =head1 METHODS
214            
215             =over
216            
217             =item B<new( )>
218            
219             Construct a new Cache::CacheMetaData object
220            
221             =item B<insert( $object )>
222            
223             Inform the CacheMetaData about the object I<$object> in the cache.
224            
225             =item B<remove( $key )>
226            
227             Inform the CacheMetaData that the object specified by I<$key> is no
228             longer in the cache.
229            
230             =item B<build_removal_list( )>
231            
232             Create a list of the keys in the cache, ordered as follows:
233            
234             1) objects that expire now
235            
236             2) objects expiring at a particular time, with ties broken by the time
237             at which they were least recently accessed
238            
239             3) objects that never expire, sub ordered by the time at which they
240             were least recently accessed
241            
242             NOTE: This could be improved further by taking the size into account
243             on accessed_at ties. However, this type of tie is unlikely in normal
244             usage.
245            
246             =item B<build_object_size( $key )>
247            
248             Return the size of an object specified by I<$key>.
249            
250             =back
251            
252             =head1 PROPERTIES
253            
254             =over
255            
256             =item B<get_cache_size>
257            
258             The total size of the objects in the cache
259            
260             =back
261            
262             =head1 SEE ALSO
263            
264             Cache::Cache, Cache::CacheSizer, Cache::SizeAwareCache
265            
266             =head1 AUTHOR
267            
268             Original author: DeWitt Clinton <dewitt@unto.net>
269            
270             Last author: $Author: dclinton $
271            
272             Copyright (C) 2001-2003 DeWitt Clinton
273            
274             =cut
275