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 )