The prior node provided diffs to keep the post short. Some folks may prefer the full examples, provided here.
test-cache-lru.pl
#!/usr/bin/env -S perl
# Author: Celogeek
# test-cache-lru.pl
# https://github.com/celogeek/perl-test-caching/tree/master
use strict;
use warnings;
use Digest::MD5 qw/md5_base64/;
use Time::HiRes qw/time/;
use feature 'say', 'state';
use Proc::ProcessTable;
use Cache::LRU;
sub get_current_process_memory {
state $pt = Proc::ProcessTable->new;
my %info = map { $_->pid => $_ } @{$pt->table};
return $info{$$}->rss;
}
$|=1;
my $c = Cache::LRU->new(size => 500000);
say "Mapping";
my @todo = map { md5_base64($_) } (1..600_000);
say "Starting";
my $mem = get_current_process_memory();
my ($read, $write, $found);
{
my $s = time;
my $i = 0;
for(@todo) {
$i++;
$c->set($_, {md5 => $_});
print "Write: $i\r" if $i % 1000 == 0;
}
$write = time - $s;
}
say "Write: ", scalar(@todo) / $write;
{
my $s = time;
my $i = 0;
my $f = 0;
for(@todo) {
$i++;
$found++ if ref $c->get($_) eq 'HASH';
print "Read : $i\r" if $i % 1000 == 0;
}
$read = time - $s;
}
say "Read : ", scalar(@todo) / $read;
say "Found: ", $found;
say "Mem : ", get_current_process_memory() - $mem;
test-cache-lru-with-expires.pl
#!/usr/bin/env -S perl
# Author: Celogeek
# test-cache-lru-with-expires.pl
# https://github.com/celogeek/perl-test-caching/tree/master
use strict;
use warnings;
use Digest::MD5 qw/md5_base64/;
use Time::HiRes qw/time/;
use feature 'say', 'state';
use Proc::ProcessTable;
use Cache::LRU::WithExpires;
sub get_current_process_memory {
state $pt = Proc::ProcessTable->new;
my %info = map { $_->pid => $_ } @{$pt->table};
return $info{$$}->rss;
}
$|=1;
my $c = Cache::LRU::WithExpires->new(size => 500000);
say "Mapping";
my @todo = map { md5_base64($_) } (1..600_000);
say "Starting";
my $mem = get_current_process_memory();
my ($read, $write, $found);
{
my $s = time;
my $i = 0;
for(@todo) {
$i++;
$c->set($_, {md5 => $_}, 60);
print "Write: $i\r" if $i % 1000 == 0;
}
$write = time - $s;
}
say "Write: ", scalar(@todo) / $write;
{
my $s = time;
my $i = 0;
my $f = 0;
for(@todo) {
$i++;
$found++ if ref $c->get($_) eq 'HASH';
print "Read : $i\r" if $i % 1000 == 0;
}
$read = time - $s;
}
say "Read : ", scalar(@todo) / $read;
say "Found: ", $found;
say "Mem : ", get_current_process_memory() - $mem;
test-cache-mce.pl
#!/usr/bin/env -S perl
# MCE::Shared::Cache test
# based on test-cache-lru.pl
# https://github.com/celogeek/perl-test-caching/tree/master
use strict;
use warnings;
use Digest::MD5 qw/md5_base64/;
use Time::HiRes qw/time/;
use feature 'say', 'state';
use Proc::ProcessTable;
use MCE::Shared::Cache;
sub get_current_process_memory {
state $pt = Proc::ProcessTable->new;
my %info = map { $_->pid => $_ } @{$pt->table};
return $info{$$}->rss;
}
$|=1;
my $c = MCE::Shared::Cache->new(max_keys => 500000);
say "Mapping";
my @todo = map { md5_base64($_) } (1..600_000);
say "Starting";
my $mem = get_current_process_memory();
my ($read, $write, $found);
{
my $s = time;
my $i = 0;
for(@todo) {
$i++;
$c->set($_, {md5 => $_});
print "Write: $i\r" if $i % 1000 == 0;
}
$write = time - $s;
}
say "Write: ", scalar(@todo) / $write;
{
my $s = time;
my $i = 0;
my $f = 0;
for(@todo) {
$i++;
$found++ if ref $c->get($_) eq 'HASH';
print "Read : $i\r" if $i % 1000 == 0;
}
$read = time - $s;
}
say "Read : ", scalar(@todo) / $read;
say "Found: ", $found;
say "Mem : ", get_current_process_memory() - $mem;
test-cache-mce-with-expires.pl
#!/usr/bin/env -S perl
# MCE::Shared::Cache test with expires
# based on test-cache-lru-with-expires.pl
# https://github.com/celogeek/perl-test-caching/tree/master
use strict;
use warnings;
use Digest::MD5 qw/md5_base64/;
use Time::HiRes qw/time/;
use feature 'say', 'state';
use Proc::ProcessTable;
use MCE::Shared::Cache;
sub get_current_process_memory {
state $pt = Proc::ProcessTable->new;
my %info = map { $_->pid => $_ } @{$pt->table};
return $info{$$}->rss;
}
$|=1;
my $c = MCE::Shared::Cache->new(max_keys => 500000);
say "Mapping";
my @todo = map { md5_base64($_) } (1..600_000);
say "Starting";
my $mem = get_current_process_memory();
my ($read, $write, $found);
{
my $s = time;
my $i = 0;
for(@todo) {
$i++;
$c->set($_, {md5 => $_}, 60);
print "Write: $i\r" if $i % 1000 == 0;
}
$write = time - $s;
}
say "Write: ", scalar(@todo) / $write;
{
my $s = time;
my $i = 0;
my $f = 0;
for(@todo) {
$i++;
$found++ if ref $c->get($_) eq 'HASH';
print "Read : $i\r" if $i % 1000 == 0;
}
$read = time - $s;
}
say "Read : ", scalar(@todo) / $read;
say "Found: ", $found;
say "Mem : ", get_current_process_memory() - $mem;
test-cache-parallel-mce.pl
#!/usr/bin/env -S perl
# parallel demonstration
# based on example in documentation
# https://metacpan.org/pod/MCE::Shared::Cache#PERFORMANCE-TESTING
use strict;
use warnings;
use feature qw( say );
use Digest::MD5 qw( md5_base64 );
use Time::HiRes qw( time );
use MCE 1.814;
use MCE::Shared;
$| = 1; srand(0);
# construct shared variables
# serialization is handled automatically
my $c = MCE::Shared->cache();
my $found = MCE::Shared->scalar( 0 );
# construct and spawn MCE workers
# workers increment a local variable $f
my $mce = MCE->new(
chunk_size => 4000,
max_workers => 4,
user_func => sub {
my ($mce, $chunk_ref, $chunk_id) = @_;
if ( $mce->user_args()->[0] eq 'setter' ) {
for ( @{ $chunk_ref } ) { $c->set($_, {md5 => $_}, 600) }
}
else {
my $f = 0;
for ( @{ $chunk_ref } ) { $f++ if ref $c->get($_) eq 'HASH
+' }
$found->incrby($f);
}
}
)->spawn();
say "Mapping";
my @todo = map { md5_base64($_) } ( 1 .. 600_000 );
say "Starting";
my ( $read, $write );
{
my $s = time;
$mce->process({
progress => sub { print "Write: $_[0]\r" },
user_args => [ 'setter' ],
}, \@todo);
$write = time - $s;
}
say "Write: ", sprintf("%0.3f", scalar(@todo) / $write);
{
my $s = time;
$found->set(0);
$mce->process({
progress => sub { print "Read $_[0]\r" },
user_args => [ 'getter' ],
}, \@todo);
$read = time - $s;
}
$mce->shutdown();
say "Read : ", sprintf("%0.3f", scalar(@todo) / $read);
say "Found: ", $found->get();
test-cache-parallel-redis.pl
#!/usr/bin/env -S perl
# parallel demonstration
# based on example in documentation
# https://metacpan.org/pod/MCE::Shared::Cache#PERFORMANCE-TESTING
use strict;
use warnings;
use feature qw( say );
use Digest::MD5 qw( md5_base64 );
use Time::HiRes qw( time );
use MCE 1.814;
use MCE::Shared;
use Redis;
use Sereal qw/encode_sereal decode_sereal/;
$| = 1; srand(0);
# construct shared variables
# serialization is handled automatically
my $c = Redis->new;
my $found = MCE::Shared->scalar( 0 );
# construct and spawn MCE workers
# workers increment a local variable $f
my $mce = MCE->new(
chunk_size => 4000,
max_workers => 4,
user_func => sub {
my ($mce, $chunk_ref, $chunk_id) = @_;
if ( $mce->user_args()->[0] eq 'setter' ) {
for ( @{ $chunk_ref } ) { $c->setex($_, 600, encode_sereal
+({md5 => $_})) }
}
else {
my $f = 0;
for ( @{ $chunk_ref } ) {
my $srl = $c->get($_);
$srl = decode_sereal($srl) if defined $srl;
$f++ if ref $srl eq 'HASH';
}
$found->incrby($f);
}
}
)->spawn();
say "Mapping";
my @todo = map { md5_base64($_) } ( 1 .. 600_000 );
say "Starting";
my ( $read, $write );
{
my $s = time;
$mce->process({
progress => sub { print "Write: $_[0]\r" },
user_args => [ 'setter' ],
}, \@todo);
$write = time - $s;
}
say "Write: ", sprintf("%0.3f", scalar(@todo) / $write);
{
my $s = time;
$found->set(0);
$mce->process({
progress => sub { print "Read $_[0]\r" },
user_args => [ 'getter' ],
}, \@todo);
$read = time - $s;
}
$mce->shutdown();
say "Read : ", sprintf("%0.3f", scalar(@todo) / $read);
say "Found: ", $found->get();
test-redis-tcp.pl
#!/usr/bin/env -S perl
# Author: Celogeek
# test-redis-tcp.pl
# https://github.com/celogeek/perl-test-caching/tree/master
use strict;
use warnings;
use Digest::MD5 qw/md5_base64/;
use Time::HiRes qw/time/;
use feature 'say', 'state';
use Proc::ProcessTable;
use Redis;
use Sereal qw/encode_sereal decode_sereal/;
sub get_current_process_memory {
state $pt = Proc::ProcessTable->new;
my %info = map { $_->pid => $_ } @{$pt->table};
return $info{$$}->rss;
}
$|=1;
my $c = Redis->new;
say "Mapping";
my @todo = map { md5_base64($_) } (1..600_000);
say "Starting";
my $mem = get_current_process_memory();
my ($read, $write, $found);
{
my $s = time;
my $i = 0;
for(@todo) {
$i++;
$c->setex($_, 600, encode_sereal({md5 => $_}));
print "Write: $i\r" if $i % 1000 == 0;
}
$write = time - $s;
}
say "Write: ", scalar(@todo) / $write;
{
my $s = time;
my $i = 0;
my $f = 0;
for(@todo) {
$i++;
my $srl = $c->get($_);
$srl = decode_sereal($srl) if defined $srl;
$found++ if ref $srl eq 'HASH';
print "Read : $i\r" if $i % 1000 == 0;
}
$read = time - $s;
}
say "Read : ", scalar(@todo) / $read;
say "Found: ", $found;
say "Mem : ", get_current_process_memory() - $mem;