line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Cache::CodeBlock; |
2
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
3
|
2
|
|
|
2
|
|
118420
|
use 5.006; use strict; use warnings; use feature qw/state/; |
|
2
|
|
|
2
|
|
14
|
|
|
2
|
|
|
2
|
|
10
|
|
|
2
|
|
|
2
|
|
3
|
|
|
2
|
|
|
|
|
68
|
|
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
76
|
|
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
221
|
|
4
|
2
|
|
|
2
|
|
1124
|
use CHI; |
|
2
|
|
|
|
|
177294
|
|
|
2
|
|
|
|
|
142
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
state $CACHE; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub import { |
9
|
2
|
|
|
2
|
|
24
|
my ($package, %chi) = @_; |
10
|
2
|
|
|
|
|
10
|
$CACHE = CHI->new( |
11
|
|
|
|
|
|
|
driver => 'Memory', |
12
|
|
|
|
|
|
|
global => 1, |
13
|
|
|
|
|
|
|
%chi |
14
|
|
|
|
|
|
|
); |
15
|
2
|
|
|
|
|
211567
|
do { |
16
|
2
|
|
|
2
|
|
16
|
no strict 'refs'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
326
|
|
17
|
2
|
|
|
|
|
13
|
my $package = caller(); |
18
|
2
|
|
|
|
|
5
|
*{"${package}::cache"} = \&cache; |
|
2
|
|
|
|
|
1786
|
|
19
|
|
|
|
|
|
|
}; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub cache (&) { |
23
|
2
|
|
|
2
|
1
|
1257
|
my $code = shift; |
24
|
2
|
|
|
|
|
8
|
my @caller = caller(); |
25
|
2
|
|
|
|
|
11
|
my $addr = sprintf("%s-%s-%s", $caller[0], $caller[1], $caller[2]); |
26
|
2
|
|
|
|
|
29
|
my $value = $CACHE->get($addr); |
27
|
2
|
100
|
|
|
|
702
|
return $value if defined $value; |
28
|
1
|
|
|
|
|
5
|
$value = $code->(); |
29
|
1
|
|
|
|
|
22
|
$CACHE->set( $addr, $value ); |
30
|
1
|
|
|
|
|
2401
|
return $value; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
1; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
__END__ |