File Coverage

blib/lib/Cache/CodeBlock.pm
Criterion Covered Total %
statement 30 30 100.0
branch 2 2 100.0
condition 4 5 80.0
subroutine 8 8 100.0
pod 1 1 100.0
total 45 46 97.8


line stmt bran cond sub pod time code
1             package Cache::CodeBlock;
2             our $VERSION = '0.02';
3 3     3   177264 use 5.006; use strict; use warnings; use feature qw/state/;
  3     3   24  
  3     3   15  
  3     3   4  
  3         92  
  3         16  
  3         6  
  3         92  
  3         16  
  3         6  
  3         332  
4 3     3   1518 use CHI;
  3         254619  
  3         211  
5              
6             state $CACHE;
7              
8             sub import {
9 3     3   38 my ($package, %chi) = @_;
10 3         15 $CACHE = CHI->new(
11             driver => 'Memory',
12             global => 1,
13             %chi
14             );
15 3         310897 do {
16 3     3   25 no strict 'refs';
  3         5  
  3         517  
17 3         18 my $package = caller();
18 3         9 *{"${package}::cache"} = \&cache;
  3         3437  
19             };
20             }
21              
22             sub cache (&@) {
23 4     4 1 2215 my ($code, $timeout, $unique) = @_;
24 4         14 my @caller = caller();
25 4   100     31 my $addr = sprintf("%s-%s-%s-%s", $caller[0], $caller[1], $caller[2], $unique || 'default');
26 4   66     41 return $CACHE->get($addr) // do {
27 2         554 my $value = $code->();
28 2 100       46 $CACHE->set( $addr, $value, (defined $timeout ? $timeout : ()) );
29 2         3889 return $value;
30             };
31             }
32              
33             1;
34              
35             __END__