File Coverage

blib/lib/CHI/t/Config.pm
Criterion Covered Total %
statement 62 62 100.0
branch n/a
condition n/a
subroutine 14 14 100.0
pod 0 2 0.0
total 76 78 97.4


line stmt bran cond sub pod time code
1             package CHI::t::Config;
2             $CHI::t::Config::VERSION = '0.60';
3 1     1   595 use CHI::Util qw(dump_one_line);
  1         2  
  1         99  
4 1     1   355 use CHI::Test;
  1         4  
  1         8  
5 1     1   709 use File::Temp qw(tempdir);
  1         15541  
  1         59  
6 1     1   6 use strict;
  1         1  
  1         23  
7 1     1   3 use warnings;
  1         1  
  1         27  
8 1     1   4 use base qw(CHI::Test::Class);
  1         1  
  1         346  
9              
10             my $root_dir = tempdir( 'CHI-t-Config-XXXX', TMPDIR => 1, CLEANUP => 1 );
11              
12             my %config = (
13             storage => {
14             memory => { driver => 'Memory', global => 1 },
15             file => { driver => 'File', root_dir => $root_dir },
16             },
17             namespace => {
18             'Foo' => { storage => 'file' },
19             'Bar' => { storage => 'file', depth => 3 },
20             },
21             defaults => { storage => 'memory' },
22             );
23              
24             {
25             package My::CHI;
26             $My::CHI::VERSION = '0.60';
27 1     1   7 use base qw(CHI);
  1         2  
  1         88  
28             My::CHI->config( {%config} );
29             }
30              
31             {
32             package My::CHI::Subclass;
33             $My::CHI::Subclass::VERSION = '0.60';
34 1     1   4 use base qw(My::CHI);
  1         1  
  1         329  
35             }
36              
37             {
38             package My::CHI::Memo;
39             $My::CHI::Memo::VERSION = '0.60';
40              
41 1     1   5 use base qw(CHI);
  1         2  
  1         328  
42             My::CHI::Memo->config( { %config, memoize_cache_objects => 1 } );
43             }
44              
45             sub _create {
46 5     5   13 my ( $params, $checks ) = @_;
47              
48 5         17 my $desc = dump_one_line($params);
49 5         454 foreach my $class (qw(My::CHI My::CHI::Subclass)) {
50 10         1249 my $cache = $class->new(%$params);
51 10         30 while ( my ( $key, $value ) = each(%$checks) ) {
52 50         10009 is( $cache->$key, $value, "$key == $value ($desc)" );
53             }
54             }
55             }
56              
57             sub test_config : Tests {
58 1     1 0 664 my $self = shift;
59              
60 1         9 _create(
61             { namespace => 'Foo' },
62             {
63             namespace => 'Foo',
64             storage => 'file',
65             short_driver_name => 'File',
66             root_dir => $root_dir,
67             depth => 2
68             },
69             );
70 1         275 _create(
71             { namespace => 'Bar' },
72             {
73             namespace => 'Bar',
74             storage => 'file',
75             short_driver_name => 'File',
76             root_dir => $root_dir,
77             depth => 3
78             }
79             );
80 1         248 _create(
81             { namespace => 'Foo', depth => 4 },
82             {
83             namespace => 'Foo',
84             storage => 'file',
85             short_driver_name => 'File',
86             root_dir => $root_dir,
87             depth => 4
88             }
89             );
90 1         215 _create(
91             { namespace => 'Bar', depth => 4 },
92             {
93             namespace => 'Bar',
94             storage => 'file',
95             short_driver_name => 'File',
96             root_dir => $root_dir,
97             depth => 4
98             }
99             );
100              
101 1         266 my %new_config = %config;
102 1         4 $new_config{namespace}->{'Bar'}->{depth} = 5;
103 1         6 My::CHI->config( {%new_config} );
104 1         6 _create(
105             { namespace => 'Bar' },
106             {
107             namespace => 'Bar',
108             storage => 'file',
109             short_driver_name => 'File',
110             root_dir => $root_dir,
111             depth => 5
112             }
113             );
114 1     1   5 }
  1         1  
  1         5  
115              
116             sub test_memoize : Tests {
117 1     1 0 512 my $cache1 = My::CHI::Memo->new( namespace => 'Foo' );
118 1         4 my $cache2 = My::CHI::Memo->new( namespace => 'Foo' );
119 1         3 is( $cache1, $cache2, "same - namespace Foo" );
120              
121 1         232 my $cache3 = My::CHI::Memo->new( namespace => 'Bar', depth => 4 );
122 1         3 my $cache4 = My::CHI::Memo->new( namespace => 'Bar', depth => 4 );
123 1         6 isnt( $cache3, $cache4, "different - namespace Bar" );
124              
125 1         237 My::CHI::Memo->clear_memoized_cache_objects();
126 1         4 my $cache5 = My::CHI::Memo->new( namespace => 'Foo' );
127 1         3 my $cache6 = My::CHI::Memo->new( namespace => 'Foo' );
128 1         4 is( $cache5, $cache6, "same - namespace Foo" );
129 1         225 isnt( $cache1, $cache3, "different - post-clear" );
130              
131 1         219 my $cache7 = My::CHI->new( namespace => 'Foo' );
132 1         4 my $cache8 = My::CHI->new( namespace => 'Foo' );
133 1         3 isnt( $cache7, $cache8, "different - namespace Foo - no memoization" );
134 1     1   412 }
  1         2  
  1         3  
135              
136             1;