File Coverage

blib/lib/Mail/BIMI/Role/Cacheable.pm
Criterion Covered Total %
statement 53 57 92.9
branch 10 12 83.3
condition 2 5 40.0
subroutine 11 12 91.6
pod 1 1 100.0
total 77 87 88.5


line stmt bran cond sub pod time code
1             package Mail::BIMI::Role::Cacheable;
2             # ABSTRACT: Cache handling
3             our $VERSION = '3.20210512'; # VERSION
4 29     29   19589 use 5.20.0;
  29         191  
5 29     29   263 use Moose::Role;
  29         137  
  29         338  
6 29     29   155758 use Mail::BIMI;
  29         119  
  29         1589  
7 29     29   260 use Mail::BIMI::Prelude;
  29         130  
  29         300  
8 29     29   8632 use Mail::BIMI::Trait::Cacheable;
  29         127  
  29         1065  
9 29     29   17319 use Mail::BIMI::Trait::CacheKey;
  29         124  
  29         1160  
10 29     29   16184 use Mail::BIMI::CacheBackend::FastMmap;
  29         120  
  29         1443  
11 29     29   17397 use Mail::BIMI::CacheBackend::File;
  29         118  
  29         1268  
12 29     29   17028 use Mail::BIMI::CacheBackend::Null;
  29         105  
  29         34952  
13              
14             has _do_not_cache => ( is => 'rw', isa => 'Bool', required => 0 );
15             has _cache_read_timestamp => ( is => 'rw', required => 0 );
16             has _cache_key => ( is => 'rw' );
17             has _cache_fields => ( is => 'rw' );
18             has cache_backend => ( is => 'ro', lazy => 1, builder => '_build_cache_backend' );
19             requires 'cache_valid_for';
20              
21              
22              
23 0     0 1 0 sub do_not_cache($self) {
  0         0  
  0         0  
24 0         0 $self->_do_not_cache(1);
25             }
26              
27 78     78   196 sub _build_cache_backend($self) {
  78         181  
  78         158  
28 78         2364 my %opts = (
29             bimi_object => $self->bimi_object,
30             parent => $self,
31             );
32 78         1906 my $backend_type = $self->bimi_object->options->cache_backend;
33 78 50       1357 my $backend
    100          
    100          
34             = $backend_type eq 'FastMmap' ? Mail::BIMI::CacheBackend::FastMmap->new( %opts )
35             : $backend_type eq 'File' ? Mail::BIMI::CacheBackend::File->new( %opts )
36             : $backend_type eq 'Null' ? Mail::BIMI::CacheBackend::Null->new( %opts )
37             : croak 'Unknown Cache Backend';
38 78         43245 $self->log_verbose('Using cache backend '.$backend_type);
39 78         2160 return $backend;
40             }
41              
42             around new => sub{
43             my $original = shift;
44             my $class = shift;
45             my $self = $class->$original(@_);
46             my @cache_key;
47             my @cache_fields;
48              
49             my $meta = $self->meta;
50             foreach my $attribute_name ( sort $meta->get_attribute_list ) {
51             my $attribute = $meta->get_attribute($attribute_name);
52             if ( $attribute->does('Mail::BIMI::Trait::CacheKey') && $attribute->does('Mail::BIMI::Trait::Cacheable') ) {
53             croak "Attribute $attribute_name cannot be BOTH is_cacheable AND is_cache_key";
54             }
55             elsif ( $attribute->does('Mail::BIMI::Trait::CacheKey') ) {
56             push @cache_key, "$attribute_name=".($self->{$attribute_name}//'');
57             }
58             elsif ( $attribute->does('Mail::BIMI::Trait::Cacheable') ) {
59             push @cache_fields, $attribute_name;
60             }
61             }
62              
63             croak "No cache key defined" if ! @cache_key;
64             croak "No cacheable fields defined" if ! @cache_fields;
65              
66             $self->_cache_key( join("\n",
67             ref $self,
68             @cache_key,
69             ));
70             $self->_cache_fields( \@cache_fields );
71              
72             my $data = $self->cache_backend->get_from_cache;
73             return $self if !$data;
74             $self->log_verbose('Build '.(ref $self).' from cache');
75             if ($data->{cache_key} ne $self->_cache_key){
76             warn 'Cache is invalid';
77             return $self;
78             }
79             my $version = $Mail::BIMI::VERSION;
80             $version //= 'dev';
81             if ($data->{cache_version} ne $version){
82             warn 'Cache is invalid';
83             return $self;
84             }
85             if ($data->{timestamp}+$self->cache_valid_for < $self->bimi_object->time) {
86             $self->cache_backend->delete_cache;
87             return $self;
88             }
89              
90             $self->_cache_read_timestamp($data->{timestamp});
91             foreach my $cache_field ( $self->_cache_fields->@* ) {
92             if ( exists ( $data->{data}->{$cache_field} )) {
93             my $value = $data->{data}->{$cache_field};
94             my $attribute = $meta->get_attribute($cache_field);
95             if ( $attribute->does('Mail::BIMI::Trait::CacheSerial') ) {
96             my $method_name = 'deserialize_'.$cache_field;
97             $self->$method_name($value);
98             }
99             else {
100             $self->{$cache_field} = $value;
101             }
102             }
103             }
104              
105             return $self;
106             };
107              
108 10     10   27 sub _write_cache($self) {
  10         24  
  10         18  
109 10 50       418 return if $self->_do_not_cache;
110 10         259 $self->_do_not_cache(1);
111 10         80 my $meta = $self->meta;
112 10         575 my $time = $self->bimi_object->time;
113 10         32 my $version = $Mail::BIMI::VERSION;
114 10   50     33 $version //= 'dev';
115 10   33     280 my $data = {
116             cache_key => $self->_cache_key,
117             cache_version => $version,
118             timestamp => $self->_cache_read_timestamp // $time,
119             data => {},
120             };
121 10         288 foreach my $cache_field ( $self->_cache_fields->@* ) {
122 80 100       220 if ( defined ( $self->{$cache_field} )) {
123              
124 62         111 my $value = $self->{$cache_field};
125 62         198 my $attribute = $meta->get_attribute($cache_field);
126 62 100       697 if ( $attribute->does('Mail::BIMI::Trait::CacheSerial') ) {
127 10         3868 my $method_name = 'serialize_'.$cache_field;
128 10         112 $value = $self->$method_name;
129             }
130              
131 62         17782 $data->{data}->{$cache_field} = $value;
132             }
133             }
134              
135 10         354 $self->cache_backend->put_to_cache($data);
136             }
137              
138             1;
139              
140             __END__
141              
142             =pod
143              
144             =encoding UTF-8
145              
146             =head1 NAME
147              
148             Mail::BIMI::Role::Cacheable - Cache handling
149              
150             =head1 VERSION
151              
152             version 3.20210512
153              
154             =head1 DESCRIPTION
155              
156             Role allowing the cacheing of data in a class based on defined cache keys
157              
158             =head1 METHODS
159              
160             =head2 I<do_not_cache()>
161              
162             Do not cache this object
163              
164             =head1 REQUIRES
165              
166             =over 4
167              
168             =item * L<Mail::BIMI|Mail::BIMI>
169              
170             =item * L<Mail::BIMI::CacheBackend::FastMmap|Mail::BIMI::CacheBackend::FastMmap>
171              
172             =item * L<Mail::BIMI::CacheBackend::File|Mail::BIMI::CacheBackend::File>
173              
174             =item * L<Mail::BIMI::CacheBackend::Null|Mail::BIMI::CacheBackend::Null>
175              
176             =item * L<Mail::BIMI::Prelude|Mail::BIMI::Prelude>
177              
178             =item * L<Mail::BIMI::Trait::CacheKey|Mail::BIMI::Trait::CacheKey>
179              
180             =item * L<Mail::BIMI::Trait::Cacheable|Mail::BIMI::Trait::Cacheable>
181              
182             =item * L<Moose::Role|Moose::Role>
183              
184             =back
185              
186             =head1 AUTHOR
187              
188             Marc Bradshaw <marc@marcbradshaw.net>
189              
190             =head1 COPYRIGHT AND LICENSE
191              
192             This software is copyright (c) 2020 by Marc Bradshaw.
193              
194             This is free software; you can redistribute it and/or modify it under
195             the same terms as the Perl 5 programming language system itself.
196              
197             =cut