The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More;
use Test::Exception;
use IO::Socket::INET;
use Moose::Meta::Class;

{
    eval "use CHI";
    if ($@) {
        plan(skip_all => "CHI not available");
    } else {
        plan(tests => 10);
    }
}

Class::MOP::load_class('MooseX::WithCache');
{
    my $class = Moose::Meta::Class->create_anon_class(
        superclasses => [ 'Moose::Object' ]
    );
    
    {
    local $SIG{__WARN__} = sub {
        like( $_[0], qr/^use of with_cache for MooseX::WithCache is now deprecated\. Use parameterized roles directly/, "Correct deprecation warning");
    };

    MooseX::WithCache::with_cache($class->name, 'cache', backend => 'CHI');
    }

    my $object = $class->new_object(
        cache => CHI->new(
            driver => 'Memory',
        ),
    );


    {
        my $value = time();
        my $key   = 'foo';
        lives_ok { $object->cache_del($key) }
            "delete key '$key' first to make sure";
        lives_ok { $object->cache_set($key => $value) }
            "set value '$key' to '$value'";
        lives_and { 
            my $v = $object->cache_get($key);
            is($v, $value, "value gotten from cache '$v' should match '$value'");
        } "get value '$key' to '$value' should live";
        lives_ok { $object->cache_del($key) }
            "delete key '$key' to purge";
    }

    {
        require MooseX::WithCache::KeyGenerator::DumpChecksum;
        $object->cache_key_generator(
            MooseX::WithCache::KeyGenerator::DumpChecksum->new
        );
        my $value = time();
        my $key   = [ qw(1 2 3), { foo => 'bar' } ];
        lives_ok { $object->cache_del($key) }
            "delete key '$key' first to make sure";
        lives_ok { $object->cache_set($key => $value) }
            "set value '$key' to '$value'";
        lives_and { 
            my $v = $object->cache_get($key);
            is($v, $value, "value gotten from cache '$v' should match '$value'");
        } "get value '$key' to '$value' should live";
        lives_and { 
            my $v = $object->cache_get([ qw(1 2 3), { foo => 'bar' } ]);
            is($v, $value, "value gotten from cache '$v' should match '$value' (same structure, different object)");
        } "get value '$key' to '$value' should live (same structure, different key object)";
        lives_ok { $object->cache_del($key) }
            "delete key '$key' to purge";
    }
}