File Coverage

blib/lib/ConfigCache.pm
Criterion Covered Total %
statement 9 37 24.3
branch 0 4 0.0
condition n/a
subroutine 3 11 27.2
pod 0 6 0.0
total 12 58 20.6


line stmt bran cond sub pod time code
1             package ConfigCache;
2 1     1   6 use strict;
  1         2  
  1         30  
3 1     1   6 use warnings;
  1         2  
  1         27  
4              
5 1     1   653 use Cache::FastMmap;
  1         5405  
  1         365  
6              
7             my $CACHE = Cache::FastMmap->new(cache_size => '1k');
8             my $CONFIGS_KEY = 'CONFIGS';
9              
10             sub set_configs {
11 0     0 0   my ($self, $configs) = @_;
12 0           $CACHE->set($CONFIGS_KEY, $configs);
13             }
14              
15             sub get_config_by_filename {
16 0     0 0   my ($self, $filename) = @_;
17 0           my $config = $CACHE->get($filename);
18 0 0         die "filename:$filename is not found" if (!$config);
19 0           return $config;
20             }
21              
22             sub set_config_by_pid {
23 0     0 0   my ($self, $pid, $config) = @_;
24 0           $CACHE->set($pid, $config);
25             }
26              
27             sub set_config_by_filename {
28 0     0 0   my ($self,$filename, $pid) = @_;
29 0           my $config = $CACHE->get($pid);
30 0           $CACHE->set($filename, $config);
31             }
32              
33             sub pop_configs {
34 0     0 0   my $config = '';
35              
36 0           while (!$config){
37             $CACHE->get_and_set($CONFIGS_KEY, sub {
38 0     0     my (undef, $configs) = @_;
39 0 0         if (scalar @{$configs} != 0){
  0            
40 0           $config = pop @{$configs};
  0            
41             }
42             else {
43 0           sleep 1;
44             }
45 0           return $configs;
46 0           });
47             }
48 0           return $config;
49             }
50              
51             sub push_configs {
52 0     0 0   my ($self, $config) = @_;
53             $CACHE->get_and_set($CONFIGS_KEY, sub {
54 0     0     my (undef, $configs) = @_;
55 0           unshift @{$configs}, $config;
  0            
56 0           return $configs;
57             })
58 0           }
59              
60             1;
61              
62             =head1 NAME
63              
64             ConfigCache - shared cache for MultipleConfig
65              
66             =head1 DESCRIPTION
67              
68             ConfigCache is shared cache for config files.
69             This module uses L
70              
71             =head1 LICENSE
72              
73             Copyright (C) takahito.yamada.
74              
75             This library is free software; you can redistribute it and/or modify
76             it under the same terms as Perl itself.
77              
78             =head1 AUTHOR
79              
80             takahito.yamada
81              
82             =head1 SEE ALSO
83              
84             L, L
85              
86             =cut