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;

[download]

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;

[download]

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;

[download]

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;

[download]

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();

[download]

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();

[download]

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;

[download]

In reply to Re^7: Schizophrenic var - cache examples by marioroy
in thread Schizophrenic var by bliako

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.