File Coverage

blib/lib/YAML/CacheLoader.pm
Criterion Covered Total %
statement 24 56 42.8
branch 0 18 0.0
condition 0 9 0.0
subroutine 8 14 57.1
pod 4 4 100.0
total 36 101 35.6


line stmt bran cond sub pod time code
1             # ABSTRACT: load YAML from cache or disk, whichever seems better
2             package YAML::CacheLoader;
3 2     2   190990 use strict;
  2         2  
  2         42  
4 2     2   6 use warnings;
  2         4  
  2         58  
5              
6             our $VERSION = '0.019';
7              
8 2     2   6 use base qw( Exporter );
  2         2  
  2         140  
9             our @EXPORT_OK = qw( LoadFile DumpFile FlushCache FreshenCache);
10              
11 2     2   6 use constant CACHE_SECONDS => 3607; # Relatively nice prime number just over 1 hour.
  2         2  
  2         88  
12 2     2   6 use constant CACHE_NAMESPACE => 'YAML-CACHELOADER'; # Make clear who dirtied up the memory
  2         2  
  2         76  
13              
14 2     2   760 use Cache::RedisDB 0.07;
  2         112210  
  2         52  
15 2     2   12 use Path::Tiny 0.061;
  2         28  
  2         84  
16 2     2   8 use YAML::XS 0.59;
  2         28  
  2         710  
17              
18             =head1 FUNCTIONS
19              
20             =over
21              
22             =item LoadFile
23              
24             my $structure = LoadFile('/path/to/yml'[, $force_reload]);
25              
26             Loads the structure from '/path/to/yml' into $structure, preferring the cached version if available,
27             otherwise reading the file and caching the result for 593 seconds (about 10 minutes).
28              
29             If $force_reload is set to a true value, the file will be loaded from disk without regard
30             to the current cache status.
31              
32             =cut
33              
34             sub LoadFile {
35 0     0 1   my ($path, $force_reload) = @_;
36              
37 0           my $file_loc = path($path)->canonpath; # realpath would be more accurate, but slower.
38 0           my $structure;
39 0 0         if ($force_reload) {
40 0           $structure = _load_and_cache($file_loc);
41             } else {
42 0   0       $structure = Cache::RedisDB->get(CACHE_NAMESPACE, $file_loc) // _load_and_cache($file_loc);
43             }
44              
45 0           return $structure;
46             }
47              
48             sub _load_and_cache {
49 0     0     my $loc = shift;
50              
51 0           my $structure = YAML::XS::LoadFile($loc); # Let this fail in whatever ways it might.
52 0 0         Cache::RedisDB->set(CACHE_NAMESPACE, $loc, $structure, CACHE_SECONDS) if ($structure);
53              
54 0           return $structure;
55             }
56              
57             =item DumpFile
58              
59             DumpFile('/path/to/yml', $structure);
60              
61             Dump the structure from $structure into '/path/to/yml', filling the cache along the way.
62              
63             =cut
64              
65             sub DumpFile {
66 0     0 1   my ($path, $structure) = @_;
67              
68 0           my $file_loc = path($path)->canonpath; # realpath would be more accurate, but slower.
69              
70 0 0         if ($structure) {
71 0           YAML::XS::DumpFile($file_loc, $structure);
72 0           Cache::RedisDB->set(CACHE_NAMESPACE, $file_loc, $structure, CACHE_SECONDS);
73             }
74              
75 0           return $structure;
76             }
77              
78             =item FlushCache
79              
80             FlushCache();
81              
82             Remove all currently cached YAML documents from the cache server.
83              
84             =cut
85              
86             sub FlushCache {
87 0     0 1   my @cached_files = _cached_files_list();
88              
89 0 0         return (@cached_files) ? Cache::RedisDB->del(CACHE_NAMESPACE, @cached_files) : 0;
90             }
91              
92             =item FreshenCache
93              
94             FreshenCache();
95              
96             Freshen currently cached files which may be out of date, either by deleting the cache (for now deleted files) or reloading from the disk (for changed ones)
97              
98             May optionally provide a list of files to check, otherwise all known cached files are checked.
99              
100             Returns a stats hash-ref.
101              
102             =back
103             =cut
104              
105             sub FreshenCache {
106 0     0 1   my (@file_list) = @_;
107              
108 0 0         @file_list = _cached_files_list() unless @file_list; # By default check all currently cached.
109              
110 0           my @to_check = map { path($_) } @file_list;
  0            
111             # A good rough cut is to see if something _might_ have changed in the meantime
112 0           my $cutoff = time - CACHE_SECONDS;
113              
114 0           my $stats = {
115             examined => scalar @to_check,
116             cleared => 0,
117             freshened => 0,
118             };
119              
120 0           foreach my $file (@to_check) {
121 0 0 0       if (!$file->exists) {
    0          
122 0 0         $stats->{cleared}++ if (Cache::RedisDB->del(CACHE_NAMESPACE, $file->canonpath)); # Let's not cache things which don't exist.
123             } elsif ((my $mtime = $file->stat->mtime) > $cutoff
124             && (my $reloaded_ago = CACHE_SECONDS - Cache::RedisDB->ttl(CACHE_NAMESPACE, $file->canonpath)))
125             {
126 0 0 0       $stats->{freshened}++ if (time - $reloaded_ago < $mtime && LoadFile($file, 1));
127             }
128             }
129              
130 0           return $stats;
131             }
132              
133             sub _cached_files_list {
134              
135 0     0     return @{Cache::RedisDB->keys(CACHE_NAMESPACE)};
  0            
136              
137             }
138              
139             1;