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 1     1   763 use strict;
  1         2  
  1         33  
14 1     1   6 use Cache::BaseCacheTester;
  1         1  
  1         18  
15 1     1   5 use Cache::Cache;
  1         2  
  1         46  
16              
17 1     1   5 use vars qw( @ISA );
  1         1  
  1         950  
18              
19             @ISA = qw ( Cache::BaseCacheTester );
20              
21              
22             sub test
23             {
24 1     1 1 7 my ( $self, $cache ) = @_;
25              
26 1         5 $self->_test_one( $cache );
27 1         5 $self->_test_two( $cache );
28 1         6 $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 1     1   2 my ( $self, $cache ) = @_;
38              
39 1 50       5 $cache or
40             croak( "cache required" );
41              
42 1         5 $cache->clear( );
43              
44 1         4 my $empty_size = $cache->size( );
45              
46 1 50       11 ( $empty_size == 0 ) ?
47             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
48              
49 1         3 my $first_key = 'Key 1';
50              
51 1         2 my $first_expires_in = '10';
52              
53 1         2 my $value = $self;
54              
55 1         6 $cache->set( $first_key, $value, $first_expires_in );
56              
57 1         3 my $first_size = $cache->size( );
58              
59 1 50       6 ( $first_size > $empty_size ) ?
60             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
61              
62 1         2 my $size_limit = $first_size;
63              
64 1         3 my $second_key = 'Key 2';
65              
66 1         4 my $second_expires_in = $first_expires_in * 2;
67              
68 1         6 $cache->set( $second_key, $value, $second_expires_in );
69              
70 1         4 my $second_size = $cache->size( );
71              
72 1 50       6 ( $second_size > $first_size ) ?
73             $self->ok( ) : $self->not_ok( '$second_size > $first_size' );
74              
75 1         5 $cache->limit_size( $size_limit );
76              
77 1         10 my $first_value = $cache->get( $first_key );
78              
79 1 50       6 ( not defined $first_value ) ?
80             $self->ok( ) : $self->not_ok( 'not defined $first_value' );
81              
82 1         5 my $third_size = $cache->size( );
83              
84 1 50       7 ( $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 1     1   4 my ( $self, $cache ) = @_;
96              
97 1 50       4 $cache or
98             croak( "cache required" );
99              
100 1         4 $cache->clear( );
101              
102 1         4 my $empty_size = $cache->size( );
103              
104 1 50       6 ( $empty_size == 0 ) ?
105             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
106              
107 1         2 my $value = "A very short string";
108              
109 1         5 my $first_key = 'Key 0';
110              
111 1         2 my $first_expires_in = 20;
112              
113 1         4 $cache->set( $first_key, $value, $first_expires_in );
114              
115 1         4 my $first_size = $cache->size( );
116              
117 1 50       7 ( $first_size > $empty_size ) ?
118             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
119              
120 1         4 my $second_expires_in = $first_expires_in / 2;
121              
122 1         3 my $num_keys = 5;
123              
124 1         5 for ( my $i = 1; $i <= $num_keys; $i++ )
125             {
126 5         17 my $key = 'Key ' . $i;
127              
128 5         5000824 sleep ( 1 );
129              
130 5         109 $cache->set( $key, $value, $second_expires_in );
131             }
132              
133 1         6 my $second_size = $cache->size( );
134              
135 1 50       12 ( $second_size > $first_size ) ?
136             $self->ok( ) : $self->not_ok( '$second_size > $first_size' );
137              
138 1         3 my $size_limit = $first_size;
139              
140 1         6 $cache->limit_size( $size_limit );
141              
142 1         9 my $third_size = $cache->size( );
143              
144 1 50       8 ( $third_size <= $size_limit ) ?
145             $self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
146              
147 1         6 my $first_value = $cache->get( $first_key );
148              
149 1 50       8 ( $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 1     1   2 my ( $self, $cache ) = @_;
161              
162 1 50       5 $cache or
163             croak( "cache required" );
164              
165 1         6 $cache->clear( );
166              
167 1         4 my $empty_size = $cache->size( );
168              
169 1 50       9 ( $empty_size == 0 ) ?
170             $self->ok( ) : $self->not_ok( '$empty_size == 0' );
171              
172 1         4 my $first_key = 'Key 1';
173              
174 1         3 my $value = $self;
175              
176 1         6 $cache->set( $first_key, $value );
177              
178 1         5 my $first_size = $cache->size( );
179              
180 1 50       9 ( $first_size > $empty_size ) ?
181             $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );
182              
183 1         2 my $max_size = $first_size;
184              
185 1         7 $cache->set_max_size( $max_size );
186              
187 1         2 my $second_key = 'Key 2';
188              
189 1         6 $cache->set( $second_key, $value );
190              
191 1         7 my $second_size = $cache->size( );
192              
193 1 50       7 ( $second_size <= $max_size ) ?
194             $self->ok( ) : $self->not_ok( '$second_size <= $max_size' );
195             }
196              
197              
198             1;
199              
200              
201             __END__