File Coverage

blib/lib/DTL/Fast/Cache.pm
Criterion Covered Total %
statement 33 42 78.5
branch 9 18 50.0
condition 3 9 33.3
subroutine 6 9 66.6
pod 0 7 0.0
total 51 85 60.0


line stmt bran cond sub pod time code
1             package DTL::Fast::Cache;
2 98     98   31124 use strict;
  98         204  
  98         2708  
3 98     98   437 use warnings FATAL => 'all';
  98         210  
  98         38186  
4             # This is a prototype class for caching templates
5              
6             sub new
7             {
8 7     7 0 31 my ( $proto, %kwargs ) = @_;
9              
10 7         32 @kwargs{'hits', 'misses'} = (0, 0);
11              
12 7         93 return bless{ %kwargs }, $proto;
13             }
14              
15             sub get
16             {
17 92     92 0 209 my ( $self, $key ) = @_;
18              
19 92         290 my $template = $self->validate_template(
20             $self->read_data(
21             $key
22             )
23             );
24              
25             defined $template ?
26             $self->{hits}++
27 92 100       227 : $self->{misses}++;
28              
29 92         423 return $template;
30             }
31              
32             sub put
33             {
34 53     53 0 143 my ( $self, $key, $template, %kwargs ) = @_;
35              
36 53 50       144 if (defined $template)
37             {
38 53         122 my @keys = ('cache', 'url_source');
39 53         90 my @backup = @{$template}{@keys};
  53         122  
40 53         88 delete @{$template}{@keys};
  53         101  
41 53         208 $self->write_data($key, $template, %kwargs);
42 53         92 @{$template}{@keys} = @backup;
  53         145  
43             }
44 53         132 return $self;
45             }
46              
47             sub read_data
48             {
49 0     0 0 0 my ( $self, $key ) = @_;
50 0         0 die "read_data method was not defined in ".(ref $self);
51             }
52              
53             sub clear
54             {
55 0     0 0 0 my ( $self ) = @_;
56 0         0 die "clear method was not defined in ".(ref $self);
57             }
58              
59             sub write_data
60             {
61 0     0 0 0 my ( $self, $key, $value ) = @_;
62              
63 0         0 die "write_data method was not defined in ".(ref $self);
64             }
65              
66             sub validate_template
67             {
68 92     92 0 185 my ( $self, $template ) = @_;
69 92 100       255 return if (not defined $template);
70              
71             # here we check if template is still valid
72              
73             # check perl version
74 24 50 33     118 return if (not $template->{perl} or $template->{perl} != $]);
75              
76             # check modules version
77 24 50       68 if (my $modules = $template->{modules})
78             {
79 24         70 foreach my $module (keys(%$modules))
80             {
81 82   66     373 my $current_version = $module->VERSION // $DTL::Fast::VERSION;
82 82 50       242 return if ($modules->{$module} ne $current_version);
83             }
84             }
85              
86             # check files modification
87 24 50       64 if (my $files = $template->{inherits})
88             {
89 0         0 foreach my $file (keys( %$files ))
90             {
91 0 0       0 next if ($file eq 'inline');
92             return if
93             (not -e $file
94 0 0 0     0 or $files->{$file} != (stat($file))[9])
95             }
96             }
97              
98 24         48 return $template;
99             }
100              
101             1;