File Coverage

blib/lib/Mojar/Cache.pm
Criterion Covered Total %
statement 38 60 63.3
branch 8 10 80.0
condition 5 7 71.4
subroutine 7 15 46.6
pod 3 14 21.4
total 61 106 57.5


line stmt bran cond sub pod time code
1             package Mojar::Cache;
2 2     2   20926 use Mojo::Base -base;
  2         3  
  2         15  
3              
4             # Attributes
5              
6             has namespace => 'main';
7             has on_get_error => sub { sub { require Carp; Carp::croak @_ } };
8             has on_set_error => sub { sub { require Carp; Carp::croak @_ } };
9              
10             has slots => sub { [] };
11             has 'max_keys';
12              
13             # Public methods
14              
15             sub new {
16 3     3 1 2309 my ($proto, %param) = @_;
17 3         23 my $self = $proto->SUPER::new(%param);
18 3         25 $self->{store} = {};
19 3         8 return $self;
20             }
21              
22             # Getting and setting
23              
24             sub get {
25 23     23 1 2668 my ($self, $key) = @_;
26 23         21 my $value;
27             eval {
28 23         52 $value = $self->{store}{$self->namespace}{$key};
29 21         86 1;
30             }
31 23 100       25 or do {
32 2   50     6 my $e = $@ // 'Failed get';
33 2         6 $self->on_get_error->($e);
34             };
35 22         76 return $value;
36             }
37              
38             sub set {
39 14     14 1 5095 my ($self, $key, $value) = @_;
40             eval {
41 14         25 my $slots = $self->slots;
42 14 100       57 unless ($self->is_valid($key)) {
43 12         97 push @$slots, $key;
44 12   100     23 while ($self->max_keys and scalar @$slots > $self->max_keys) {
45             # Too many in the bed
46 3         26 $self->remove(shift @$slots);
47             }
48             }
49 13         70 $self->{store}{$self->namespace}{$key} = $value;
50 13         60 1;
51             }
52 14 100       20 or do {
53 1   50     4 my $e = $@ // 'Failed set';
54 1         5 $self->on_set_error->($e);
55             };
56 13         23 return $self;
57             }
58              
59             sub compute {
60 2     2 0 3 my ($self, $key, $code) = @_;
61 2         6 my $cache = $self->{store}{$self->namespace};
62 2 100       15 return $cache->{$key} if exists $cache->{$key};
63              
64 1         3 my $value = $code->($key);
65 1         5 $self->set($key => $value);
66 1         4 return $value;
67             }
68              
69             # Removing
70              
71             sub remove {
72 5     5 0 1571 my ($self, $key) = @_;
73 5         12 delete $self->{store}{$self->namespace}{$key};
74 5         22 return $self;
75             }
76              
77             # Inspecting keys
78              
79             sub is_valid {
80 16     16 0 14 my ($self, $key) = @_;
81 16         42 return exists $self->{store}{$self->namespace}{$key};
82             }
83              
84             # Atomic operations
85              
86             sub append {
87 0     0 0   my ($self, $key, $further_text) = @_;
88 0           $self->{store}{$self->namespace}{$key} .= $further_text;
89 0           return $self;
90             }
91              
92             # Namespace operations
93              
94             sub clear {
95 0     0 0   my $self = shift;
96 0           $self->{store}{$self->namespace} = {};
97 0           return $self;
98             }
99              
100 0     0 0   sub get_keys { keys %{ $_[0]{store}{$_[0]->namespace} } }
  0            
101              
102             # Multiple key/value operations
103              
104             sub get_multi_arrayref {
105 0     0 0   my ($self, $keys_ref) = @_;
106 0           my $cache = $self->{store}{$self->namespace};
107 0           return [ map $cache->{$_}, @$keys_ref ];
108             }
109              
110             sub get_multi_hashref {
111 0     0 0   my ($self, $keys_ref) = @_;
112 0           my $cache = $self->{store}{$self->namespace};
113 0           return { map $_ => $cache->{$_}, @$keys_ref };
114             }
115              
116             sub set_multi {
117 0     0 0   my ($self, $hashref) = @_;
118 0           while (my ($k, $v) = each %$hashref) {
119 0           $self->set($k => $v);
120             }
121 0           return $self;
122             }
123              
124             sub remove_multi {
125 0     0 0   my ($self, $keys_ref) = @_;
126 0           $self->remove($_) foreach @$keys_ref;
127 0           return $self;
128             }
129              
130 0 0   0 0   sub to_hashref { $_[0]{store}{$_[0]->namespace} || {} }
131              
132             1;
133             __END__