File Coverage

blib/lib/Cache/SizeAwareMemoryCache.pm
Criterion Covered Total %
statement 48 48 100.0
branch n/a
condition 2 3 66.6
subroutine 19 19 100.0
pod 7 9 77.7
total 76 79 96.2


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: SizeAwareMemoryCache.pm,v 1.18 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::SizeAwareMemoryCache;
13              
14              
15 1     1   333 use strict;
  1         1  
  1         31  
16 1     1   3 use vars qw( @ISA );
  1         2  
  1         29  
17 1     1   4 use Cache::Cache;
  1         1  
  1         25  
18 1     1   289 use Cache::CacheSizer;
  1         3  
  1         38  
19 1     1   466 use Cache::MemoryCache;
  1         5  
  1         64  
20 1     1   7 use Cache::SizeAwareCache qw( $NO_MAX_SIZE );
  1         3  
  1         703  
21              
22              
23             @ISA = qw ( Cache::MemoryCache Cache::SizeAwareCache );
24              
25              
26             my $DEFAULT_MAX_SIZE = $NO_MAX_SIZE;
27              
28              
29             sub Clear
30             {
31 8     8 1 30 return Cache::MemoryCache::Clear( );
32             }
33              
34              
35             sub Purge
36             {
37 2     2 1 13 return Cache::MemoryCache::Purge( );
38             }
39              
40              
41             sub Size
42             {
43 7     7 1 22 return Cache::MemoryCache::Size( );
44             }
45              
46              
47             sub new
48             {
49 3     3 1 356 my ( $self ) = _new( @_ );
50 3         13 $self->_complete_initialization( );
51 3         12 return $self;
52             }
53              
54              
55             sub get
56             {
57 31     31 1 58 my ( $self, $p_key ) = @_;
58              
59 31         64 $self->_get_cache_sizer( )->update_access_time( $p_key );
60 31         140 return $self->SUPER::get( $p_key );
61             }
62              
63              
64             sub limit_size
65             {
66 2     2 1 5 my ( $self, $p_new_size ) = @_;
67              
68 2         5 $self->_get_cache_sizer( )->limit_size( $p_new_size );
69             }
70              
71              
72             sub set
73             {
74 33     33 1 92 my ( $self, $p_key, $p_data, $p_expires_in ) = @_;
75              
76 33         225 $self->SUPER::set( $p_key, $p_data, $p_expires_in );
77 33         125 $self->_get_cache_sizer( )->limit_size( $self->get_max_size( ) );
78             }
79              
80              
81             sub _new
82             {
83 3     3   7 my ( $proto, $p_options_hash_ref ) = @_;
84 3   66     17 my $class = ref( $proto ) || $proto;
85 3         24 my $self = $class->SUPER::_new( $p_options_hash_ref );
86 3         11 $self->_initialize_cache_sizer( );
87 3         5 return $self;
88             }
89              
90              
91             sub _initialize_cache_sizer
92             {
93 3     3   5 my ( $self ) = @_;
94              
95 3         7 my $max_size = $self->_read_option( 'max_size', $DEFAULT_MAX_SIZE );
96 3         15 $self->_set_cache_sizer( new Cache::CacheSizer( $self, $max_size ) );
97             }
98              
99              
100             sub get_max_size
101             {
102 33     33 0 37 my ( $self ) = @_;
103              
104 33         53 return $self->_get_cache_sizer( )->get_max_size( );
105             }
106              
107              
108             sub set_max_size
109             {
110 1     1 0 3 my ( $self, $p_max_size ) = @_;
111              
112 1         3 $self->_get_cache_sizer( )->set_max_size( $p_max_size );
113             }
114              
115              
116             sub _get_cache_sizer
117             {
118 100     100   101 my ( $self ) = @_;
119              
120 100         326 return $self->{_Cache_Sizer};
121             }
122              
123              
124             sub _set_cache_sizer
125             {
126 3     3   6 my ( $self, $p_cache_sizer ) = @_;
127              
128 3         8 $self->{_Cache_Sizer} = $p_cache_sizer;
129             }
130              
131              
132             1;
133              
134              
135              
136             __END__