File Coverage

blib/lib/Data/Tubes/Util/Cache.pm
Criterion Covered Total %
statement 52 68 76.4
branch 13 22 59.0
condition n/a
subroutine 13 14 92.8
pod 3 3 100.0
total 81 107 75.7


line stmt bran cond sub pod time code
1             package Data::Tubes::Util::Cache;
2 3     3   1347 use strict;
  3         7  
  3         94  
3 3     3   15 use warnings;
  3         6  
  3         84  
4 3     3   15 use English qw< -no_match_vars >;
  3         5  
  3         16  
5 3     3   1151 use 5.010;
  3         11  
6             our $VERSION = '0.740';
7 3     3   20 use File::Path qw< mkpath >;
  3         6  
  3         209  
8              
9 3     3   1514 use File::Spec::Functions qw< splitpath catpath >;
  3         2491  
  3         205  
10 3     3   2551 use Storable qw< nstore retrieve >;
  3         6998  
  3         190  
11 3     3   20 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
  3         7  
  3         19  
12 3     3   1918 use Mo qw< default >;
  3         1064  
  3         16  
13             has repository => (default => sub { return {} });
14             has __filenames => (default => sub { return undef });
15             has max_items => (default => 0);
16              
17             sub _path {
18 5     5   11 my ($dir, $filename) = @_;
19 5         12 my ($v, $d) = splitpath($dir, 'no-file');
20 5         41 return catpath($v, $d, $filename);
21             }
22              
23             sub get {
24 18     18 1 47 my ($self, $key) = @_;
25 18         54 my $repo = $self->repository();
26 18 100       162 if (ref($repo) eq 'HASH') {
27 15 100       65 return unless exists $repo->{$key};
28 4         10 return $repo->{$key};
29             }
30 3         7 my $path = _path($repo, $key);
31 3 100       110 return retrieve($path) if -r $path;
32 2         10 return;
33             } ## end sub get
34              
35             sub _filenames {
36 0     0   0 my $self = shift;
37 0 0       0 if (my $retval = $self->__filenames()) {
38 0         0 return $retval;
39             }
40 0         0 my $repo = $self->repository();
41 0         0 my ($v, $d) = splitpath($repo, 'no-file');
42 0 0       0 opendir my $dh, $repo or return;
43 0         0 my @filenames = map { catpath($v, $d, $_) } readdir $dh;
  0         0  
44 0         0 closedir $dh;
45 0         0 $self->__filenames(\@filenames);
46 0         0 return \@filenames;
47             }
48              
49             sub purge {
50 6     6 1 10 my $self = shift;
51 6 50       14 my $max = $self->max_items() or return;
52 6         41 my $repo = $self->repository();
53              
54 6 50       36 if (ref($repo) eq 'HASH') {
55 6         12 my $n = scalar keys %$repo;
56 6         29 delete $repo->{(keys %$repo)[0]} while $n-- > $max;
57 6         14 return;
58             }
59              
60 0 0       0 my $filenames = $self->_filenames() or return;
61 0         0 while (@$filenames > $max) {
62 0         0 my $filename = shift @$filenames;
63 0         0 unlink $filename;
64             }
65 0         0 return;
66             } ## end sub purge
67              
68             sub set {
69 13     13 1 24 my ($self, $key, $data) = @_;
70 13         31 my $repo = $self->repository();
71 13 100       107 return $repo->{$key} = $data if ref($repo) eq 'HASH';
72 2 50       3 eval {
73 2 100       8 mkpath($repo) unless -d $repo;
74 2         398 nstore($data, _path($repo, $key));
75 2         452 1;
76             } or LOGWARN $EVAL_ERROR;
77 2         8 return $data;
78             }