File Coverage

blib/lib/Cache/SizeAwareCacheTester.pm
Criterion Covered Total %
statement 79 79 100.0
branch 16 32 50.0
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 104 120 86.6


line stmt bran cond sub pod time code
1             ######################################################################
2             # $Id: SizeAwareCacheTester.pm,v 1.11 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::SizeAwareCacheTester;
12              
13 2     2   1317 use strict;
  2         4  
  2         73  
14 2     2   12 use Cache::BaseCacheTester;
  2         6  
  2         44  
15 2     2   11 use Cache::Cache;
  2         4  
  2         92  
16              
17 2     2   11 use vars qw( @ISA );
  2         4  
  2         1712  
18              
19             @ISA = qw ( Cache::BaseCacheTester );
20              
21              
22             sub test
23             {
24 2     2 1 14 my ( $self, $cache ) = @_;
25              
26 2         10 $self->_test_one( $cache );
27 2         11 $self->_test_two( $cache );
28 2         10 $self->_test_three( $cache );
29             }
30              
31              
32             # Test the limit_size( ) method, which should automatically purge the
33             # first object added (with the closer expiration time)
34              
35             sub _test_one
36             {
37 2     2   5 my ( $self, $cache ) = @_;
38              
39 2 50       9 $cache or
40             croak( "cache required" );
41              
42 2         13 $cache->clear( );
43              
44 2         12 my $empty_size = $cache->size( );
45              
46 2 50       36 ( $empty_size == 0 ) ?
47             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
48              
49 2         5 my $first_key = 'Key 1';
50              
51 2         6 my $first_expires_in = '10';
52              
53 2         133 my $value = $self;
54              
55 2         16 $cache->set( $first_key, $value, $first_expires_in );
56              
57 2         11 my $first_size = $cache->size( );
58              
59 2 50       17 ( $first_size > $empty_size ) ?
60             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
61              
62 2         5 my $size_limit = $first_size;
63              
64 2         7 my $second_key = 'Key 2';
65              
66 2         6 my $second_expires_in = $first_expires_in * 2;
67              
68 2         10 $cache->set( $second_key, $value, $second_expires_in );
69              
70 2         12 my $second_size = $cache->size( );
71              
72 2 50       17 ( $second_size > $first_size ) ?
73             $self->ok( ) : $self->not_ok( '$second_size > $first_size' );
74              
75 2         12 $cache->limit_size( $size_limit );
76              
77 2         28 my $first_value = $cache->get( $first_key );
78              
79 2 50       17 ( not defined $first_value ) ?
80             $self->ok( ) : $self->not_ok( 'not defined $first_value' );
81              
82 2         11 my $third_size = $cache->size( );
83              
84 2 50       14 ( $third_size <= $size_limit ) ?
85             $self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
86             }
87              
88              
89              
90             # Test the limit_size method when a number of objects can expire
91             # simultaneously
92              
93             sub _test_two
94             {
95 2     2   6 my ( $self, $cache ) = @_;
96              
97 2 50       9 $cache or
98             croak( "cache required" );
99              
100 2         12 $cache->clear( );
101              
102 2         12 my $empty_size = $cache->size( );
103              
104 2 50       13 ( $empty_size == 0 ) ?
105             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
106              
107 2         6 my $value = "A very short string";
108              
109 2         7 my $first_key = 'Key 0';
110              
111 2         3 my $first_expires_in = 20;
112              
113 2         11 $cache->set( $first_key, $value, $first_expires_in );
114              
115 2         10 my $first_size = $cache->size( );
116              
117 2 50       18 ( $first_size > $empty_size ) ?
118             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
119              
120 2         6 my $second_expires_in = $first_expires_in / 2;
121              
122 2         7 my $num_keys = 5;
123              
124 2         10 for ( my $i = 1; $i <= $num_keys; $i++ )
125             {
126 10         32 my $key = 'Key ' . $i;
127              
128 10         10004431 sleep ( 1 );
129              
130 10         150 $cache->set( $key, $value, $second_expires_in );
131             }
132              
133 2         13 my $second_size = $cache->size( );
134              
135 2 50       23 ( $second_size > $first_size ) ?
136             $self->ok( ) : $self->not_ok( '$second_size > $first_size' );
137              
138 2         5 my $size_limit = $first_size;
139              
140 2         14 $cache->limit_size( $size_limit );
141              
142 2         23 my $third_size = $cache->size( );
143              
144 2 50       29 ( $third_size <= $size_limit ) ?
145             $self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
146              
147 2         14 my $first_value = $cache->get( $first_key );
148              
149 2 50       19 ( $first_value eq $value ) ?
150             $self->ok( ) : $self->not_ok( '$first_value eq $value' );
151              
152             }
153              
154              
155             # Test the max_size( ) method, which should keep the cache under
156             # the given size
157              
158             sub _test_three
159             {
160 2     2   6 my ( $self, $cache ) = @_;
161              
162 2 50       9 $cache or
163             croak( "cache required" );
164              
165 2         12 $cache->clear( );
166              
167 2         13 my $empty_size = $cache->size( );
168              
169 2 50       13 ( $empty_size == 0 ) ?
170             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
171              
172 2         4 my $first_key = 'Key 1';
173              
174 2         7 my $value = $self;
175              
176 2         16 $cache->set( $first_key, $value );
177              
178 2         9 my $first_size = $cache->size( );
179              
180 2 50       14 ( $first_size > $empty_size ) ?
181             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
182              
183 2         3 my $max_size = $first_size;
184              
185 2         14 $cache->set_max_size( $max_size );
186              
187 2         4 my $second_key = 'Key 2';
188              
189 2         8 $cache->set( $second_key, $value );
190              
191 2         15 my $second_size = $cache->size( );
192              
193 2 50       19 ( $second_size <= $max_size ) ?
194             $self->ok( ) : $self->not_ok( '$second_size <= $max_size' );
195             }
196              
197              
198             1;
199              
200              
201             __END__