#!/opt/blocperl/bin/perl -w
#
# This is a stripped down version of cacheperl.pl from
# http://cpan.robm.fastmail.fm/cache_perf.html that just compares
# Cache::BDB, Cache::BerkeleyDB, Cache::FileCache, and
# Cache::Memcached. See the included patch to add Cache::BDB to the
# version of cacheperl.pl available from that site if you want to
# benchmark a more complete set of options. If you want to disable a
# few of these, see the @Packages array below and just comment out the
# ones you don't want run.
#
use Time::HiRes qw(gettimeofday tv_interval);
use Storable qw(freeze thaw);
use Data::Dumper;
use strict;
#----- Setup stuff
srand(1);
# Number of runs to perform
my $Runs = 1;
# Maximum number of values to generate to store in cache
my $MaxVals = 1000;
# Number of times to get/set in each run
my $NSetItems = 500;
my $NGetItems = 500;
my $NMixItems = 500;
# When getting, pick definitely stored keys this often
my $TestHitRate = 0.85;
# If mix mode, make reads this often
my $MixReadRatio = 0.85;
# Build data sets of various complexity
my (@DataComplex, @DataBin);
for my $Depth (0 .. 2) {
my @Structs = map { BuildStruct($Depth, $Depth+5) } 1 .. $MaxVals;
push @DataComplex, \@Structs;
my @Frozen = map { freeze($_) } @Structs;
push @DataBin, \@Frozen;
}
# Recursive helper call
sub BuildStruct {
my ($Depth, $NItems) = @_;
my $Struct = {};
# Alter slightly from base number of items passed
$NItems += int(rand(3))-1;
# Generate given number of items in hash struct
for (my $i = 0; $i < $NItems; $i++) {
my $Key = RandVal(1);
my $Type = int(rand(10));
if ($Type < 4) {
$Struct->{$Key} = RandVal();
} elsif ($Type < 7) {
$Struct->{$Key} = [ map { RandVal() } 1 .. int(rand($NItems)) ];
} else {
$Struct->{$Key} = $Depth ? BuildStruct($Depth-1, $NItems) : RandVal();
}
}
return $Struct;
}
# Generate random perl value (either int, float, string or undef)
sub RandVal {
my $NotUndef = shift;
my $Type = int(rand(10));
if ($Type < 3) {
return rand(100);
} elsif ($Type < 6) {
return int(rand(1000000));
} elsif ($Type < 9 || $NotUndef) {
return join '', map { chr(ord('A') + int(rand(26))) } 1 .. int(rand(20));
} else {
return undef;
}
}
sub CheckComplex {
keys %{$_[0]} == keys %{$_[1]}
|| die "Mismatch for package - " . $_[2];
}
sub CheckBin {
$_[0] eq $_[1]
|| die "Mismatch for package - " . $_[2];
}
# Packages to run through
my @Packages = (
CC5_CacheCacheBerkeleyDBStorable => [ 'complex',
{
namespace => 'testcache_cache_cache_berkeleydb',
cache_root => '/tmp'
}
],
CC5_CacheFileCacheStorable => [ 'complex',
{
cache_root => "/tmp",
namespace => "testcache_filecache",
}
],
CC6_CacheBDBStorable => [ 'complex',
cache_root => "/tmp",
namespace => "testcache_cache_bdb",
],
CC3_Memcached_Local => [ 'complex', {
'servers' => [ "localhost:11211",],
'debug' => 0,
'compress_threshold' => 100000,
}
],
);
#----- Now do runs
# Repeat each package type
while (my ($Package, $PackageOpts) = splice @Packages, 0, 2) {
# eval { require $Package };#
# print $@;
# next if $@;
# Get package options
my ($DataType, @Params) = @$PackageOpts;
my ($Check, $Data);
# Set data and check routine based on data type
if ($DataType eq 'bin') {
$Check = \&CheckBin;
$Data = \@DataBin;
} else {
$Check = \&CheckComplex;
$Data = \@DataComplex;
}
my $Name = $Package->name();
print "\nPackage: $Name\nData type: $DataType\nParams: @Params\n";
printf(" %5s | %6s | %6s | %6s | %5s | %5s\n", qw(Cmplx Set/S Get/S Mix/S GHitR MHitR));
printf("-------|--------|--------|--------|-------|------\n");
# Run for each data set size
for my $DataSet (@$Data) {
# Basic data complexity metric
my $Complexity;
for (@$DataSet) {
if (ref $_) {
my @Hashes = $_;
while (my $Hash = shift @Hashes) {
$Complexity += keys %$Hash;
push @Hashes, grep { ref($_) eq 'HASH' } values %$Hash;
}
} else {
$Complexity += length($_);
}
}
$Complexity /= scalar(@$DataSet);
# Store times
my ($SetTime, $GetTime, $MixTime, $Name);
# And hit rate
my (%StoreData, $GetRead, $GetHit, $MixRead, $MixHit);
# Do runs
for (my $Run = 0; $Run < $Runs; $Run++) {
my $c = $Package->new(@Params);
# Store keys
my $t0 = [gettimeofday];
for (my $i = 0; $i < $NSetItems; $i++) {
my $k = "abc" . ($i * 103) . "defg";
my $x = $i % $MaxVals;
$c->set($k, $DataSet->[$x]);
$StoreData{$k} = $x;
}
my $t1 = [gettimeofday];
my @SetKeys = keys %StoreData;
# Get keys
for (my $i = $NGetItems-1; $i >= 0; $i--) {
my $k;
if (rand() < $TestHitRate) {
$k = $SetKeys[rand(@SetKeys)];
$GetRead++;
} else {
$k = "abcd" . ($i * 103) . "efg";
}
my $y = $c->get($k);
if (defined $y) {
$GetHit++;
} else {
my $o = $StoreData{$k};
defined $o || next;
$y = $DataSet->[$o];
}
# Reality check, not much of a check...
$Check->($y, $DataSet->[$StoreData{$k}]);
}
my $t2 = [gettimeofday];
# Now do mix
for (my $i = 0; $i < $NMixItems; $i++) {
my $k;
if (rand() < $MixReadRatio) {
if (rand() < $TestHitRate) {
$k = $SetKeys[rand(@SetKeys)];
$MixRead++;
} else {
$k = "abcd" . ($i * 103) . "efg";
}
my $y = $c->get($k);
if (defined $y) {
$MixHit++;
} else {
my $o = $StoreData{$k};
defined $o || next;
$y = $DataSet->[$o];
}
# Reality check, not much of a check...
$Check->($y, $DataSet->[$StoreData{$k}]);
} else {
$k = $SetKeys[rand(@SetKeys)];
$c->set($k, $DataSet->[$StoreData{$k}]);
}
}
my $t3 = [gettimeofday];
# Add to run times
$SetTime += tv_interval($t0, $t1);
$GetTime += tv_interval($t1, $t2);
$MixTime += tv_interval($t2, $t3);
}
my $SetRate = int ($NSetItems*$Runs / $SetTime);
my $GetRate = int ($NGetItems*$Runs / $GetTime);
my $MixRate = int ($NMixItems*$Runs / $MixTime);
my $GHitRate = $GetHit/$GetRead;
my $MHitRate = $MixHit/$MixRead;
printf(" %5d | %6d | %6d | %6d | %5.3f | %5.3f\n",
$Complexity, $SetRate, $GetRate, $MixRate, $GHitRate, $MHitRate);
}
print "\n";
}
exit(0);
package CB0_InProcHash;
sub name { return "In process hash"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
my $Self = {};
bless ($Self, $Class);
return $Self;
}
sub set {
$_[0]->{$_[1]} = $_[2];
}
sub get {
return $_[0]->{$_[1]};
}
1;
package CC0_InProcHashStorable;
use Storable qw(freeze thaw);
sub name { return "Storable freeze/thaw"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
my $Self = {};
bless ($Self, $Class);
return $Self;
}
sub set {
$_[0]->{$_[1]} = freeze($_[2]);
}
sub get {
return thaw($_[0]->{$_[1]});
}
1;
package CC3_Memcached_Local;
use Cache::Memcached;
use base 'Cache::Memcached';
sub name { return "Memcached Local Storable"; }
1;
package CC3_BerkeleyDB_Hash_Storable;
use Storable qw(freeze thaw);
use BerkeleyDB;
use Fcntl qw(:DEFAULT);
sub name { return "BerkeleyDB Hash Storable"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
unlink glob('/tmp/bdbfile*');
my %Cache;
my $env = new BerkeleyDB::Env(
-Home => '/tmp',
-Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL,
#-Cachesize => 23152000,
)
or die "can't create BerkelyDB::Env: $!";
my $Obj = tie %Cache, 'BerkeleyDB::Hash',
-Filename => '/tmp/bdbfile',
-Flags => DB_CREATE,
-Mode => 0640,
-Env => $env
or die ("Can't tie to /tmp/bdbdfile: $!");
my $Self = {
Cache => \%Cache,
Obj => $Obj
};
bless ($Self, $Class);
return $Self;
}
sub set {
# $_[0]->{Cache}->{$_[1]} = freeze($_[2]);
$_[0]->{Obj}->db_put( $_[1], freeze($_[2]) );
}
sub get {
# return thaw($_[0]->{Cache}->{$_[1]});
my $value;
$_[0]->{Obj}->db_get( $_[1], $value );
return thaw( $value );
}
1;
package CC3_BerkeleyDB_Btree_Storable;
use Storable qw(freeze thaw);
use BerkeleyDB;
use Fcntl qw(:DEFAULT);
sub name { return "BerkeleyDB Btree Storable"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
unlink glob('/tmp/bdbfile*');
my %Cache;
my $env = new BerkeleyDB::Env(
-Home => '/tmp',
-Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL,
#-Cachesize => 23152000,
)
or die "can't create BerkelyDB::Env: $!";
my $Obj = tie %Cache, 'BerkeleyDB::Btree',
-Filename => '/tmp/bdbfile',
-Flags => DB_CREATE,
-Mode => 0640,
-Env => $env
or die ("Can't tie to /tmp/bdbdfile: $!");
my $Self = {
Cache => \%Cache,
Obj => $Obj
};
bless ($Self, $Class);
return $Self;
}
sub set {
$_[0]->{Obj}->db_put( $_[1], freeze($_[2]) );
}
sub get {
my $value;
$_[0]->{Obj}->db_get( $_[1], $value );
return thaw( $value );
}
1;
package CC3_BerkeleyDB_Hash;
use BerkeleyDB;
use Fcntl qw(:DEFAULT);
sub name { return "BerkeleyDB Hash"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
unlink glob('/tmp/bdbfile*');
my %Cache;
my $env = new BerkeleyDB::Env(
-Home => '/tmp',
-Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL,
#-Cachesize => 23152000,
)
or die "can't create BerkelyDB::Env: $!";
my $Obj = tie %Cache, 'BerkeleyDB::Hash',
-Filename => '/tmp/bdbfile',
-Flags => DB_CREATE,
-Mode => 0640,
-Env => $env
or die ("Can't tie to /tmp/bdbdfile: $!");
my $Self = {
Cache => \%Cache,
Obj => $Obj
};
bless ($Self, $Class);
return $Self;
}
sub set {
# $_[0]->{Obj}->db_put( $_[1], $_[2] );
$_[0]->{Cache}->{ $_[1]} = $_[2];
}
sub get {
return $_[0]->{Cache}->{$_[1]};
my $value;
$_[0]->{Obj}->db_get( $_[1], $value );
return $value;
}
package CC3_BerkeleyDB_Btree;
use BerkeleyDB;
use Fcntl qw(:DEFAULT);
sub name { return "BerkeleyDB Btree"; }
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
unlink glob('/tmp/bdbfile*');
my %Cache;
my $env = new BerkeleyDB::Env(
-Home => '/tmp',
-Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL,
#-Cachesize => 23152000,
)
or die "can't create BerkelyDB::Env: $!";
my $Obj = tie %Cache, 'BerkeleyDB::Btree',
-Filename => '/tmp/bdbfile',
-Flags => DB_CREATE,
-Mode => 0640,
-Env => $env
or die ("Can't tie to /tmp/bdbdfile: $!");
my $Self = {
Cache => \%Cache,
Obj => $Obj
};
bless ($Self, $Class);
return $Self;
}
sub set {
$_[0]->{Obj}->db_put( $_[1], $_[2] );
}
sub get {
my $value;
$_[0]->{Obj}->db_get( $_[1], $value );
return $value;
}
1;
package CC5_CacheCacheBerkeleyDBStorable;
use Cache::BerkeleyDB;
use base 'Cache::BerkeleyDB';
sub name { return "Cache::BerkeleyDB Storable"; }
1;
package CC5_CacheFileCacheStorable;
use Cache::FileCache;
use base 'Cache::FileCache';
sub name { return "Cache::FileCache Storable"; }
1;
package CC6_CacheBDBStorable;
use Cache::BDB;
use base 'Cache::BDB';
sub name { return "Cache::BDB Storable"; }
1;