File Coverage

blib/lib/Text/APL/WithCaching.pm
Criterion Covered Total %
statement 30 30 100.0
branch 8 10 80.0
condition n/a
subroutine 7 7 100.0
pod n/a
total 45 47 95.7


line stmt bran cond sub pod time code
1             package Text::APL::WithCaching;
2              
3 2     2   8 use strict;
  2         2  
  2         65  
4 2     2   10 use warnings;
  2         2  
  2         65  
5              
6 2     2   7 use base 'Text::APL::Core';
  2         2  
  2         539  
7              
8             sub _process {
9 3     3   5 my $self = shift;
10 3         5 my ($input, $context, $cb) = @_;
11              
12 3 100       7 if (my $cache = $self->_load_cache($context)) {
13 2 100       6 if ($cache->{id} ne $context->id) {
14 1         7 $cache->{sub_ref} =
15             $self->SUPER::_compile($cache->{code}, $context);
16             }
17              
18 2         10 return $cb->($self, $cache->{sub_ref});
19             }
20              
21 1         8 $self->SUPER::_process(@_);
22             }
23              
24             sub _compile {
25 1     1   2 my $self = shift;
26 1         4 my ($code, $context) = @_;
27              
28 1         7 my $sub_ref = $self->SUPER::_compile($code, $context);
29              
30 1         4 $self->_cache($code, $context, $sub_ref);
31              
32 1         3 return $sub_ref;
33             }
34              
35             sub _load_cache {
36 3     3   4 my $self = shift;
37 3         4 my ($context) = @_;
38              
39 3 50       11 return unless defined $context->name;
40              
41 3 100       9 return unless exists $self->{cache}->{$context->name};
42              
43 2         6 return $self->{cache}->{$context->name};
44             }
45              
46             sub _cache {
47 1     1   2 my $self = shift;
48 1         2 my ($code, $context, $sub_ref) = @_;
49              
50 1 50       2 return unless defined $context->name;
51              
52 1         4 $self->{cache}->{$context->name} = {
53             id => $context->id,
54             code => $code,
55             sub_ref => $sub_ref
56             };
57             }
58              
59             1;
60             __END__