File Manager

Editing File: /usr/local/cpanel/3rdparty/perl/536/cpanel-lib/Cache/SizeAwareCacheTester.pm

######################################################################
# $Id: SizeAwareCacheTester.pm,v 1.11 2002/04/07 17:04:46 dclinton Exp $
# Copyright (C) 2001-2003 DeWitt Clinton  All Rights Reserved
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or
# implied. See the License for the specific language governing
# rights and limitations under the License.
######################################################################

package Cache::SizeAwareCacheTester;

use strict;
use Cache::BaseCacheTester;
use Cache::Cache;

use vars qw( @ISA );

@ISA = qw ( Cache::BaseCacheTester );

sub test
{
  my ( $self, $cache ) = @_;

$self->_test_one( $cache );
  $self->_test_two( $cache );
  $self->_test_three( $cache );
}

# Test the limit_size( ) method, which should automatically purge the
# first object added (with the closer expiration time)

sub _test_one
{
  my ( $self, $cache ) = @_;

$cache or
    croak( "cache required" );

$cache->clear( );

my $empty_size = $cache->size( );

( $empty_size == 0 ) ?
    $self->ok( ) : $self->not_ok( '$empty_size == 0' );

my $first_key = 'Key 1';

my $first_expires_in = '10';

my $value = $self;

$cache->set( $first_key, $value, $first_expires_in );

my $first_size = $cache->size( );

( $first_size > $empty_size ) ?
    $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );

my $size_limit = $first_size;

my $second_key = 'Key 2';

my $second_expires_in = $first_expires_in * 2;

$cache->set( $second_key, $value, $second_expires_in );

my $second_size = $cache->size( );

( $second_size > $first_size ) ?
    $self->ok( ) : $self->not_ok( '$second_size > $first_size' );

$cache->limit_size( $size_limit );

my $first_value = $cache->get( $first_key );

( not defined $first_value ) ?
    $self->ok( ) : $self->not_ok( 'not defined $first_value' );

my $third_size = $cache->size( );

( $third_size <= $size_limit ) ?
    $self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );
}

# Test the limit_size method when a number of objects can expire
# simultaneously

sub _test_two
{
  my ( $self, $cache ) = @_;

$cache or
    croak( "cache required" );

$cache->clear( );

my $empty_size = $cache->size( );

( $empty_size == 0 ) ?
    $self->ok( ) : $self->not_ok( '$empty_size == 0' );

my $value = "A very short string";

my $first_key = 'Key 0';

my $first_expires_in = 20;

my $start = time;
  $cache->set( $first_key, $value, $first_expires_in );

my $first_size = $cache->size( );

( $first_size > $empty_size ) ?
    $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );

my $second_expires_in = $first_expires_in / 2;

my $num_keys = 5;

for ( my $i = 1; $i <= $num_keys; $i++ )
  {
    my $key = 'Key ' . $i;

sleep ( 1 );

$cache->set( $key, $value, $second_expires_in );
  }
  my $second_inserted = time;

my $second_size = $cache->size( );

if (time - $start < $first_expires_in ) {
    ( $second_size > $first_size ) ?
      $self->ok( ) : $self->not_ok( '$second_size > $first_size' );
  } else {
      $self->skip( '$second_size > $first_size (not finished in ' .
      $first_expires_in . ' s)');
  }

my $size_limit = $first_size;

$cache->limit_size( $size_limit );

my $third_size = $cache->size( );

( $third_size <= $size_limit ) ?
    $self->ok( ) : $self->not_ok( '$third_size <= $size_limit' );

my $first_value = $cache->get( $first_key );

if (time - $start >= $first_expires_in) {
    $self->skip( '$first_value eq $value (not finished in ' .
      $first_expires_in . ' s)');
  } elsif ($second_inserted + $second_expires_in >=
      $start + $first_expires_in) {
    $self->skip( '$first_value eq $value (second key insterted to late, ' .
     'so first key had expiration time before the second one, ' .
     'thus the first key was removed when limit cache size');
  } else {
    ( $first_value eq $value ) ?
      $self->ok( ) : $self->not_ok( '$first_value eq $value' );
  }

}

# Test the max_size( ) method, which should keep the cache under
# the given size

sub _test_three
{
  my ( $self, $cache ) = @_;

$cache or
    croak( "cache required" );

$cache->clear( );

my $empty_size = $cache->size( );

( $empty_size == 0 ) ?
    $self->ok( ) : $self->not_ok( '$empty_size == 0' );

my $first_key = 'Key 1';

my $value = $self;

$cache->set( $first_key, $value );

my $first_size = $cache->size( );

( $first_size > $empty_size ) ?
    $self->ok( ) : $self->not_ok( '$first_size > $empty_size' );

my $max_size = $first_size;

$cache->set_max_size( $max_size );

my $second_key = 'Key 2';

$cache->set( $second_key, $value );

my $second_size = $cache->size( );

( $second_size <= $max_size ) ?
    $self->ok( ) : $self->not_ok( '$second_size <= $max_size' );
}

__END__

=pod

=head1 NAME

Cache::SizeAwareCacheTester -- a class for regression testing size aware caches

=head1 DESCRIPTION

The SizeCacheTester is used to verify that a cache implementation honors
its contract with respect to resizing capabilities

=head1 SYNOPSIS

use Cache::SizeAwareMemoryCache;
  use Cache::SizeAwareCacheTester;

my $cache = new Cache::SizeAwareMemoryCache( );

my $cache_tester = new Cache::SizeAwareCacheTester( 1 );

$cache_tester->test( $cache );

=head1 METHODS

=over

=item B<new( $initial_count )>

Construct a new SizeAwareCacheTester object, with the counter starting
at I<$initial_count>.

=item B<test( )>

Run the tests.

=back

=head1 SEE ALSO

Cache::Cache, Cache::BaseCacheTester, Cache::CacheTester

=head1 AUTHOR

Original author: DeWitt Clinton <dewitt@unto.net>

Last author:     $Author: dclinton $

=cut

Back to Directory File Manager