Attribute-Cached
view release on metacpan or search on metacpan
t/01_cacheset.t view on Meta::CPAN
#!/usr/bin/perl
use strict; use warnings;
use Data::Dumper;
use Test::More tests => 10;
use Attribute::Cached;
use constant CACHETIME => 20;
use constant VALUE => 'I CAN HAZ CACHE?';
package Cache::MockCache;
sub new {
my ($class, $config) = @_;
return bless $config, $class;
}
sub namespace { return $_[0]->{namespace} }
sub get {
my ($self, $key) = @_;
if (my $value = $self->{data}{$key}) {
$self->{gets}{hits}{$key}++;
return $value;
} else {
$self->{gets}{misses}{$key}++;
}
}
sub set {
my ($self, $key, $value, $time) = @_;
$self->{sets}{count}{$key}++;
$self->{data}{$key} = $value;
$self->{time}{$key} = $time;
}
package main;
my %caches;
sub getCache {
my $method = $_[1];
if (!$method) {
my $method_name = (caller(2))[3];
$method_name=~/\((.*?)\)/;
$method = $1;
}
return $caches{$method} ||= do {
diag "Getting cache $method";
Cache::MockCache->new({namespace=>$method});
};
}
sub getCacheKey {
return join ',' => @_;
}
sub customCacheKey {
return join ':' => @_;
}
sub getCacheTime {
return int rand(20);
}
sub expensive_operation {
# select (undef, undef, undef, 0.00001);
return VALUE;
}
sub cached :Cached(key=>\&customCacheKey,time=>CACHETIME) {
return expensive_operation();
}
sub basic {
return expensive_operation();
}
{
no warnings 'once';
*cached2 = Attribute::Cached::encache(
__PACKAGE__, 'basic', \&basic,
key=>\&customCacheKey,
time=>CACHETIME);
}
my $cached_cache = getCache(undef, 'cached');
my $x;
$x = cached();
is ($x, VALUE);
is_deeply( $cached_cache, {
'sets' => {
'count' => { 'main:cached' => 1 }
},
'namespace' => 'cached',
'data' => { 'main:cached' => VALUE, },
'time' => { 'main:cached' => 20, },
'gets' => {
'misses' => { 'main:cached' => 1 }
}
}, 'cache ok');
$x = cached();
is ($x, VALUE);
$x = cached();
is ($x, VALUE);
is_deeply( $cached_cache, {
( run in 2.202 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )