File Coverage

blib/lib/Bot/Cobalt/Plugin/RDB/SearchCache.pm
Criterion Covered Total %
statement 44 46 95.6
branch 16 22 72.7
condition 8 20 40.0
subroutine 9 9 100.0
pod 0 5 0.0
total 77 102 75.4


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Plugin::RDB::SearchCache;
2             $Bot::Cobalt::Plugin::RDB::SearchCache::VERSION = '0.021002';
3             ## This is a fairly generic in-memory cache object.
4             ##
5             ## It's intended for use with Plugin::RDB, but will likely work for
6             ## just about situation where you want to store a set number of keys
7             ## mapping an identifier to an array reference.
8             ##
9             ## This can be useful for caching the results of deep searches against
10             ## Bot::Cobalt::DB instances, for example.
11             ##
12             ## This may get moved out to the core lib directory, in which case this
13             ## module will become a placeholder.
14              
15 1     1   537 use 5.10.1;
  1         2  
16 1     1   395 use strictures 2;
  1         1212  
  1         41  
17              
18 1     1   550 use Time::HiRes ();
  1         955  
  1         403  
19              
20             sub new {
21 1     1 0 581 my $self = +{ Cache => +{} };
22 1         2 my $class = shift;
23 1         1 bless $self, $class;
24              
25 1         2 my %opts = @_;
26 1   50     8 $self->MaxKeys($opts{MaxKeys} || 30);
27            
28 1         2 $self
29             }
30              
31             sub cache {
32 8     8 0 601447 my ($self, $ckey, $match, $resultset) = @_;
33             ## should be passed rdb, search str, and array of matching indices
34              
35 8 50 33     82 return unless defined $ckey and defined $match;
36 8 50       37 $resultset = [] unless ref $resultset eq 'ARRAY';
37              
38             ## _shrink will do the right thing depending on size of cache
39             ## (MaxKeys can be used to adjust cachesize per-rdb 'on the fly')
40 8         28 $self->_shrink($ckey);
41            
42 8         96 $self->{Cache}->{$ckey}->{$match} = +{
43             TS => Time::HiRes::time(),
44             Results => $resultset,
45             };
46             }
47              
48             sub fetch {
49 5     5 0 13 my ($self, $ckey, $match) = @_;
50            
51             return
52             unless defined $ckey
53             and defined $match
54             and exists $self->{Cache}->{$ckey}
55 5 100 33     48 and $self->{Cache}->{$ckey}->{$match};
      33        
      33        
56              
57 3         4 my $ref = $self->{Cache}->{$ckey}->{$match};
58 1         4 wantarray ? @{ $ref->{Results} } : $ref->{Results}
59 3 100       12 }
60              
61             sub MaxKeys {
62 10     10 0 17 my ($self, $max) = @_;
63 10 100       25 return $self->{MAX_KEYS} = $max if defined $max;
64             $self->{MAX_KEYS}
65 8         50 }
66              
67             sub invalidate {
68 1     1 0 360 my ($self, $ckey, $match) = @_;
69             ## should be called on add/del operations
70              
71 1 50       3 unless (defined $ckey) {
72             ## invalidate all by not passing an arg
73 0         0 $self->{Cache} = +{};
74             return
75 0         0 }
76              
77             return unless exists $self->{Cache}->{$ckey}
78 1 50 33     3 and keys %{ $self->{Cache}->{$ckey} } ;
  1         5  
79              
80 1 50       2 return delete $self->{Cache}->{$ckey}->{$match}
81             if defined $match;
82              
83 1         3 delete $self->{Cache}->{$ckey}
84             }
85              
86             sub _shrink {
87 8     8   14 my ($self, $ckey) = @_;
88            
89 8 100 66     51 return unless defined $ckey and ref $self->{Cache}->{$ckey};
90              
91 6         14 my $cacheref = $self->{Cache}->{$ckey};
92              
93 6 100       27 return unless scalar keys %$cacheref > $self->MaxKeys;
94              
95             my @cached = sort {
96 1         11 $cacheref->{$a}->{TS} <=> $cacheref->{$b}->{TS}
97 10         25 } keys %$cacheref;
98            
99 1         2 my $deleted = 0;
100              
101 1         3 while (scalar keys %$cacheref > $self->MaxKeys) {
102 1         3 my $nextkey = shift @cached;
103 1 50       10 ++$deleted if delete $cacheref->{$nextkey};
104             }
105              
106             $deleted
107 1         2 }
108              
109             1;
110             __END__