File Coverage

blib/lib/CHI/t/Config.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package CHI::t::Config;
$CHI::t::Config::VERSION = '0.59';
use CHI::Util qw(dump_one_line);
use CHI::Test;
use File::Temp qw(tempdir);
use strict;
use warnings;
use base qw(CHI::Test::Class);

my $root_dir = tempdir( 'CHI-t-Config-XXXX', TMPDIR => 1, CLEANUP => 1 );

my %config = (
    storage => {
        memory => { driver => 'Memory', global   => 1 },
        file   => { driver => 'File',   root_dir => $root_dir },
    },
    namespace => {
        'Foo' => { storage => 'file' },
        'Bar' => { storage => 'file', depth => 3 },
    },
    defaults => { storage => 'memory' },
);

{
    package My::CHI;
$My::CHI::VERSION = '0.59';
use base qw(CHI);
    My::CHI->config( {%config} );
}

{
    package My::CHI::Subclass;
$My::CHI::Subclass::VERSION = '0.59';
use base qw(My::CHI);
}

{
    package My::CHI::Memo;
$My::CHI::Memo::VERSION = '0.59';

    use base qw(CHI);
    My::CHI::Memo->config( { %config, memoize_cache_objects => 1 } );
}

sub _create {
    my ( $params, $checks ) = @_;

    my $desc = dump_one_line($params);
    foreach my $class (qw(My::CHI My::CHI::Subclass)) {
        my $cache = $class->new(%$params);
        while ( my ( $key, $value ) = each(%$checks) ) {
            is( $cache->$key, $value, "$key == $value ($desc)" );
        }
    }
}

sub test_config : Tests {
    my $self = shift;

    _create(
        { namespace => 'Foo' },
        {
            namespace         => 'Foo',
            storage           => 'file',
            short_driver_name => 'File',
            root_dir          => $root_dir,
            depth             => 2
        },
    );
    _create(
        { namespace => 'Bar' },
        {
            namespace         => 'Bar',
            storage           => 'file',
            short_driver_name => 'File',
            root_dir          => $root_dir,
            depth             => 3
        }
    );
    _create(
        { namespace => 'Foo', depth => 4 },
        {
            namespace         => 'Foo',
            storage           => 'file',
            short_driver_name => 'File',
            root_dir          => $root_dir,
            depth             => 4
        }
    );
    _create(
        { namespace => 'Bar', depth => 4 },
        {
            namespace         => 'Bar',
            storage           => 'file',
            short_driver_name => 'File',
            root_dir          => $root_dir,
            depth             => 4
        }
    );

    my %new_config = %config;
    $new_config{namespace}->{'Bar'}->{depth} = 5;
    My::CHI->config( {%new_config} );
    _create(
        { namespace => 'Bar' },
        {
            namespace         => 'Bar',
            storage           => 'file',
            short_driver_name => 'File',
            root_dir          => $root_dir,
            depth             => 5
        }
    );
}

sub test_memoize : Tests {
    my $cache1 = My::CHI::Memo->new( namespace => 'Foo' );
    my $cache2 = My::CHI::Memo->new( namespace => 'Foo' );
    is( $cache1, $cache2, "same - namespace Foo" );

    my $cache3 = My::CHI::Memo->new( namespace => 'Bar', depth => 4 );
    my $cache4 = My::CHI::Memo->new( namespace => 'Bar', depth => 4 );
    isnt( $cache3, $cache4, "different - namespace Bar" );

    My::CHI::Memo->clear_memoized_cache_objects();
    my $cache5 = My::CHI::Memo->new( namespace => 'Foo' );
    my $cache6 = My::CHI::Memo->new( namespace => 'Foo' );
    is( $cache5, $cache6, "same - namespace Foo" );
    isnt( $cache1, $cache3, "different - post-clear" );

    my $cache7 = My::CHI->new( namespace => 'Foo' );
    my $cache8 = My::CHI->new( namespace => 'Foo' );
    isnt( $cache7, $cache8, "different - namespace Foo - no memoization" );
}

1;