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.12 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             package Cache::CacheMetaData;
12              
13 2     2   8 use strict;
  2         2  
  2         60  
14 2     2   7 use Cache::Cache qw( $EXPIRES_NOW $EXPIRES_NEVER );
  2         2  
  2         1301  
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 13 my ( $proto ) = @_;
35 6   33     48 my $class = ref( $proto ) || $proto;
36 6         14 my $self = {};
37 6         17 bless( $self, $class );
38 6         25 $self->_set_meta_data_hash_ref( { } );
39 6         22 $self->_set_cache_size( 0 );
40 6         18 return $self;
41             }
42              
43              
44             sub insert
45             {
46 20     20 1 23 my ( $self, $p_object ) = @_;
47              
48 20         49 $self->_insert_object_expires_at( $p_object );
49 20         44 $self->_insert_object_accessed_at( $p_object );
50 20         37 $self->_insert_object_size( $p_object );
51 20         45 $self->_set_cache_size( $self->get_cache_size( ) + $p_object->get_size( ) );
52             }
53              
54              
55             sub remove
56             {
57 14     14 1 22 my ( $self, $p_key ) = @_;
58              
59 14         28 $self->_set_cache_size( $self->get_cache_size( ) -
60             $self->build_object_size( $p_key ) );
61              
62 14         30 delete $self->_get_meta_data_hash_ref( )->{ $p_key };
63             }
64              
65              
66             sub build_removal_list
67             {
68 6     6 1 10 my ( $self ) = @_;
69              
70 6         14 my $meta_data_hash_ref = $self->_get_meta_data_hash_ref( );
71              
72             return
73             sort
74 22         33 {
75 6         45 my $a_expires_at = $meta_data_hash_ref->{ $a }->[ $_EXPIRES_AT_OFFSET ];
76 22         29 my $b_expires_at = $meta_data_hash_ref->{ $b }->[ $_EXPIRES_AT_OFFSET ];
77 22         27 my $a_accessed_at = $meta_data_hash_ref->{ $a }->[ $_ACCESS_AT_OFFSET ];
78 22         23 my $b_accessed_at = $meta_data_hash_ref->{ $b }->[ $_ACCESS_AT_OFFSET ];
79              
80 22 100       51 if ( $a_expires_at eq $b_expires_at )
81             {
82 2         12 return ( $a_accessed_at <=> $b_accessed_at );
83             }
84              
85 20 50       32 return -1 if $a_expires_at eq $EXPIRES_NOW;
86 20 50       36 return 1 if $b_expires_at eq $EXPIRES_NOW;
87 20 50       32 return 1 if $a_expires_at eq $EXPIRES_NEVER;
88 20 50       38 return -1 if $b_expires_at eq $EXPIRES_NEVER;
89              
90 20         40 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 31 my ( $self, $p_key ) = @_;
100              
101 28         91 return $self->_get_meta_data_hash_ref( )->{ $p_key }->[ $_SIZE_OFFSET ];
102             }
103              
104              
105             sub _insert_object_meta_data
106             {
107 60     60   67 my ( $self, $p_object, $p_offset, $p_value ) = @_;
108              
109 60         117 $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   26 my ( $self, $p_object ) = @_;
117              
118 20         52 $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   27 my ( $self, $p_object ) = @_;
127              
128 20         45 $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   26 my ( $self, $p_object ) = @_;
137              
138 20         51 $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 39 my ( $self ) = @_;
147              
148 40         93 return $self->{_Cache_Size};
149             }
150              
151              
152             sub _set_cache_size
153             {
154 40     40   52 my ( $self, $cache_size ) = @_;
155              
156 40         132 $self->{_Cache_Size} = $cache_size;
157             }
158              
159              
160             sub _get_meta_data_hash_ref
161             {
162 108     108   99 my ( $self ) = @_;
163              
164 108         313 return $self->{_Meta_Data_Hash_Ref};
165             }
166              
167              
168             sub _set_meta_data_hash_ref
169             {
170 6     6   12 my ( $self, $meta_data_hash_ref ) = @_;
171              
172 6         30 $self->{_Meta_Data_Hash_Ref} = $meta_data_hash_ref;
173             }
174              
175              
176             1;
177              
178              
179             __END__