view release on metacpan or  search on metacpan

lib/Cache/Benchmark.pm  view on Meta::CPAN

=over 4

=item C<plain>:

not a real test. This will only call all keys one after another. No random, no peaks.

=item C<random>:

only for access-speed tests. The key is randomly generated. No peaks.

=item C<weighted>:

keys are randomly generated and weighted. Some keys have a
high chance of being used, others have less chances

=back

=item B<sleep_time>: FLOAT [default: 0] 

the waiting time between each access in seconds. For example use 0.001 to wait a millisecond
between each access.

=item B<weighted_key_config>: [default: this example-config]

an own config for the test_type "weighted". It's a simple hashref with the following structure:

=over 4

 $config = {
  1.5 => 15, 
  10  => 10, 
  35  => 7, 
  50  => 5,
  65  => 3,
  85  => 2,
  99  => 1,
 };

=back

I<Example:>

=over 4

=item 1.5 => 15

means: the first 1.5% of all keys have a 15 times higher chance to hit

=item 10  => 10

means: from 1.5% till 10% the keys will have a 10 times higher chance...

=item 35  => 7

means: from 10% till 35% ... 7 times higher ...
 ...etc

=back

the key (percent) can be a FLOAT, value (weight) has to be an INT

=item B<accesslist>: ARRAYREF [default: undef]

sets the list of keys the benchmark-test will use in run(). (an ARRAYREF of INT) Usable to repeat exactly the same test
which was stored via L</get_generated_keylist()> or to define your own list. If you give an access list, all other parameters,
except L</sleep_time>, are senseless.

Attention: the arrayref is not dereferenced!

=back

=back

=cut
sub init {
	my $self = shift(@_);
	my %config = @_;
	
	$self->{'_is_init'} = 0;
	
	my $keylist_length = exists($config{'keys'}) ? int(delete($config{'keys'})) : $STANDARD_VALUES->{'keys'};
	my $key_length = exists($config{'min_key_length'}) ? int(delete($config{'min_key_length'})) : $STANDARD_VALUES->{'min_key_length'};
	my $access_counter = exists($config{'access_counter'}) ? int(delete($config{'access_counter'})) : $STANDARD_VALUES->{'access_counter'};
	my $cache_value = exists($config{'value'}) ? delete($config{'value'}) : $STANDARD_VALUES->{'value'};
	my $test_type = exists($config{'test_type'}) ? delete($config{'test_type'}) : $STANDARD_VALUES->{'test_type'};
	my $weighted_key_config = exists($config{'weighted_key_config'}) ? delete($config{'weighted_key_config'}) : $STANDARD_VALUES->{'weighted_key_config'};
	my $sleep_time = exists($config{'sleep_time'}) ? delete($config{'sleep_time'}) : $STANDARD_VALUES->{'sleep_time'};
	my $accesslist = exists($config{'accesslist'}) ? delete($config{'accesslist'}) : undef;
	
	foreach(keys %config) {
		Carp::carp("init-parameter '$_' is unknown!");
		return 0;
	}
	if($keylist_length < 10) {
		Carp::carp("keylist length has to be bigger than 9");
		return 0;
	}
	if($access_counter < 1) {
		Carp::carp("access_counter has to be bigger than 0");
		return 0;
	}
	if($access_counter <= $keylist_length) {
		Carp::carp("for usable results the access_counter ($access_counter) has to be MUCH bigger than the keylist length ($keylist_length)");
	}
	if(!defined($cache_value)) {
		Carp::carp("undefined cache-value is not allowed");
		return 0;
	}
	my $type_ok = 0;
	foreach my $type (@{$self->{'_supported_types'}}) {
		$type_ok = 1 if($test_type eq $type);
	}
	if(!$type_ok) {
		Carp::carp("test-type '$test_type' is not supported");
		return 0;
	}
	if(ref($weighted_key_config) ne 'HASH') {
		Carp::carp("weighted_key_config ($weighted_key_config) must be an hahsref");
	}
	if(defined($accesslist) && ref($accesslist) ne 'ARRAY') {

lib/Cache/Benchmark.pm  view on Meta::CPAN

SINGLE VALUES:
--------------
Cache-keys read:    $self->{'_result'}->{'reads'}
Cache-keys rewrite: $self->{'_result'}->{'rewrites'}
Cache-keys write:   $self->{'_result'}->{'writes'}
Cache purged:       $self->{'_result'}->{'purged'}

Get-time:   $self->{'_result'}->{'get_time'}
Set-time:   $self->{'_result'}->{'set_time'}
Purge-time: $self->{'_result'}->{'purge_time'}
Runtime:    $self->{'_result'}->{'runtime'}

HERE
}

# Protected: generates a random number from 0 to the given value 
# int
sub _generate_random_number {
	my $self = $_[0];
	my $max_val = $_[1];
	
	return sprintf("%.0f", rand(1) * $max_val);
}

# Protected: fill a given key with 'x' till the min-length is reached
# string
sub _fill_key {
	my $self = $_[0];
	my $key = $_[1];
	my $min_length = $_[2];
	
	my $fill_length = $min_length - length($key);
	return $key if($fill_length <= 0);
	return ('0' x $fill_length) . $key; 
}

# Protected: generate all cache-keys for the bell-curve
# array( array( int, int ))
sub _create_accesslist {
	my $self = $_[0];
	my $test_type = $_[1];
	my $keylist_length = $_[2];
	my $key_length = $_[3];
	my $access_counter = $_[4];
	my $weighted_config = $_[5];
	
	my $list = [];
	if($test_type eq 'plain') {
		my $plain_list = [ 0..($keylist_length - 1) ];
		my $i = 0;
		foreach(1..$access_counter) {
			$i = 0 if($i > $#$plain_list);
			push(@$list, $self->_fill_key($plain_list->[$i++], $key_length));
		}
	} elsif($test_type eq 'random') {
		foreach(1..$access_counter) {
			push(@$list, $self->_fill_key($self->_generate_random_number($keylist_length - 1), $key_length) );
		}
	} elsif($test_type eq 'weighted') {
		my @sorted_percents = sort({ $a <=> $b } keys(%$weighted_config));
		my $actual_step = shift(@sorted_percents);
		my $plain_keylist = [];
		foreach my $key ( 0..($keylist_length - 1) ) {
			my $weight = 1;
			if(defined($actual_step)) {
				my $percent = (($key + 1) / $keylist_length) * 100;
				$actual_step = shift(@sorted_percents) if($actual_step < $percent);
				$weight = int($weighted_config->{$actual_step}) if(defined($actual_step));
			}
			foreach(1..$weight) {
				push(@$plain_keylist, $self->_fill_key($key, $key_length));
			}
		}
		my $length = $#$plain_keylist;
		foreach(1..$access_counter) {
			push(@$list, $plain_keylist->[$self->_generate_random_number($length)]);
		}
	}
	return $list;
}

# Protected: check the object-interface of the given cache-object
# boolean
sub _check_cache_class {
	my $self = $_[0];
	my $cache = $_[1];
	
	foreach my $method (qw/set get purge/) {
		if(!UNIVERSAL::can($cache, $method)) {
			Carp::carp("You need to implement method $method in Class '" . ref($cache) . "'");
			return 0;
		}
	}
	return 1;
}

# Protected: run the benchmark test
# hashref
sub _run_benchmark {
	my $self = $_[0];
	my $cache = $_[1];
	my $access_list = $_[2];
	my $sleep_time = $_[3];
	my $cache_value = $_[4];
	my $auto_purge = $_[5];
	my $keylist_length = $_[6];

	my $cached_keys = {};
	my ($cached, $not_cached, $cache_deleted, $cache_purged) = (0, 0, 0, 0);
	my ($set_time, $get_time, $purge_time) = (0, 0, 0);
	foreach my $key (@$access_list) {
		if($sleep_time > 0) {
			Time::HiRes::nanosleep($sleep_time);
		}
		if($cached_keys->{$key}) {
			my $start_time = Time::HiRes::time();
			my $val = $cache->get($key);
			$get_time += Time::HiRes::time() - $start_time;
			if(defined($val)) {
				++$cached;
			} else {
				++$cache_deleted;
				my $start_time = Time::HiRes::time();
				$cache->set($key, $$cache_value);
				$set_time += Time::HiRes::time() - $start_time;
			}
		} else {