File Coverage

blib/lib/Net/Clacks/ClacksCache.pm
Criterion Covered Total %
statement 47 205 22.9
branch 0 36 0.0
condition 0 21 0.0
subroutine 16 33 48.4
pod 16 16 100.0
total 79 311 25.4


line stmt bran cond sub pod time code
1             package Net::Clacks::ClacksCache;
2             #---AUTOPRAGMASTART---
3 1     1   19 use 5.020;
  1         3  
4 1     1   5 use strict;
  1         1  
  1         25  
5 1     1   6 use warnings;
  1         2  
  1         44  
6 1     1   5 use diagnostics;
  1         2  
  1         7  
7 1     1   27 use mro 'c3';
  1         1  
  1         6  
8 1     1   33 use English;
  1         1  
  1         6  
9 1     1   397 use Carp;
  1         2  
  1         94  
10             our $VERSION = 23;
11 1     1   7 use autodie qw( close );
  1         2  
  1         25  
12 1     1   290 use Array::Contains;
  1         3  
  1         44  
13 1     1   5 use utf8;
  1         2  
  1         17  
14 1     1   33 use Encode qw(is_utf8 encode_utf8 decode_utf8);
  1         2  
  1         42  
15 1     1   6 use feature 'signatures';
  1         2  
  1         91  
16 1     1   13 no warnings qw(experimental::signatures);
  1         7  
  1         43  
17             #---AUTOPRAGMAEND---
18              
19 1     1   5 use Net::Clacks::Client;
  1         2  
  1         18  
20 1     1   4 use YAML::Syck;
  1         1  
  1         56  
21 1     1   5 use MIME::Base64;
  1         1  
  1         1576  
22              
23 0     0 1   sub new($proto, %config) {
  0            
  0            
  0            
24 0   0       my $class = ref($proto) || $proto;
25              
26 0           my $self = bless \%config, $class;
27              
28 0           $self->reconnect();
29              
30 0           $self->{initfromhandle} = 0;
31              
32 0 0         if(!defined($self->{user})) {
33 0           croak("User not defined!");
34             }
35              
36 0 0         if(!defined($self->{password})) {
37 0           croak("Password not defined!");
38             }
39              
40              
41 0           return $self;
42             }
43              
44 0     0 1   sub newFromHandle($proto, $clacks) {
  0            
  0            
  0            
45 0   0       my $class = ref($proto) || $proto;
46              
47 0           my $self = bless {}, $class;
48              
49 0           $self->{initfromhandle} = 1;
50 0           $self->{clacks} = $clacks;
51              
52 0           $self->extraInits(); # Hook for application specific inits
53              
54 0           return $self;
55             }
56              
57 0     0 1   sub reconnect($self) {
  0            
  0            
58 0 0         return if($self->{initfromhandle});
59 0 0         return if(defined($self->{clacks}));
60              
61 0           my $clacks;
62 0 0 0       if(defined($self->{host}) && defined($self->{port})) {
    0          
63             $clacks = Net::Clacks::Client->new($self->{host}, $self->{port},
64             $self->{user}, $self->{password},
65 0 0         $self->{APPNAME} . '/' . $VERSION, 0)
66             or croak("Can't connect to Clacks server");
67             } elsif(defined($self->{socketpath})) {
68             $clacks = Net::Clacks::Client->newSocket($self->{socketpath},
69             $self->{user}, $self->{password},
70 0 0         $self->{APPNAME} . '/' . $VERSION, 0)
71             or croak("Can't connect to Clacks server");
72             } else {
73 0           croak("No valid connection configured. Don't know where to connect to!");
74             }
75 0           $self->{clacks} = $clacks;
76              
77 0           $self->{clacks}->disablePing(); # Webclient doesn't know when it is called again
78              
79 0           $self->set("VERSION::" . $self->{APPNAME}, $VERSION);
80              
81 0           $self->{clacks}->activate_memcached_compat;
82 0           $self->{clacks}->disablePing();
83              
84 0           $self->extraInits(); # Hook for application specific inits
85              
86 0           return;
87             }
88              
89 0     0 1   sub extraInits($self) {
  0            
  0            
90             # Hook for application specific inits
91 0           return;
92             }
93              
94 0     0 1   sub extraDestroys($self) {
  0            
  0            
95             # Hook for application specific destroys
96 0           return;
97             }
98              
99 0     0 1   sub disconnect($self) {
  0            
  0            
100 0           eval {
101 0           $self->{clacks}->disconnect();
102             };
103              
104 0           return;
105             }
106              
107 0     0     DESTROY($self) {
  0            
  0            
108 0           eval {
109 0           $self->{clacks}->disconnect();
110             };
111              
112 0           $self->extraDestroys();
113 0           return;
114             };
115              
116 0     0 1   sub get($self, $key) {
  0            
  0            
  0            
117 0           $self->reconnect(); # Make sure we are connected
118              
119 0           $key = $self->sanitize_key($key);
120              
121 0           my $value = $self->{clacks}->retrieve($key);
122 0 0         return if(!defined($value));
123              
124 0 0         if($value =~ /^PAGECAMELCLACKSYAMLB64\:(.+)/o) {
    0          
125 0           $value = decode_base64($1);
126 0           $value = Load($value);
127 0           $value = $self->deref($value);
128             } elsif($value =~ /^PAGECAMELCLACKSB64\:(.+)/o) {
129 0           $value = decode_base64($1);
130             }
131 0           return $value;
132             }
133              
134 0     0 1   sub set($self, $key, $data) { ## no critic (NamingConventions::ProhibitAmbiguousNames)
  0            
  0            
  0            
  0            
135 0           $self->reconnect(); # Make sure we are connected
136              
137 0           $key = $self->sanitize_key($key);
138              
139 0 0 0       if(ref $data ne '') {
    0          
    0          
140             #$data = 'PAGECAMELCLACKSYAMLB64: ' . encode_base64(Dump($data), '');
141 0           $data = Dump($data);
142 0           $data = 'PAGECAMELCLACKSYAMLB64: ' . encode_base64($data, '');
143             } elsif($data =~ /^PAGECAMELCLACKSB64/o) {
144             # Already encoded? Clacks injection alert? Just don't store the thing...
145 0           return 0;
146             } elsif($data =~ /\n/o || $data =~ /\r/o) {
147 0           $data = 'PAGECAMELCLACKSB64:' . encode_base64($data, '');
148             }
149              
150 0           $self->{clacks}->store($key, $data);
151              
152 0           return 1;
153             }
154              
155 0     0 1   sub delete($self, $key) { ## no critic(BuiltinHomonyms)
  0            
  0            
  0            
156 0           $self->reconnect(); # Make sure we are connected
157              
158 0           $key = $self->sanitize_key($key);
159              
160 0           $self->{clacks}->remove($key);
161 0           return 1;
162             }
163              
164 0     0 1   sub incr($self, $key, $stepsize = '') {
  0            
  0            
  0            
  0            
165 0           $self->reconnect(); # Make sure we are connected
166              
167 0           $key = $self->sanitize_key($key);
168              
169 0 0 0       if(!defined($stepsize) || $stepsize eq '') {
170 0           $self->{clacks}->increment($key);
171             } else {
172 0           $self->{clacks}->increment($key, $stepsize);
173             }
174 0           return 1;
175             }
176              
177 0     0 1   sub decr($self, $key, $stepsize = '') {
  0            
  0            
  0            
  0            
178 0           $self->reconnect(); # Make sure we are connected
179              
180 0           $key = $self->sanitize_key($key);
181              
182 0 0 0       if(!defined($stepsize) || $stepsize eq '') {
183 0           $self->{clacks}->decrement($key);
184             } else {
185 0           $self->{clacks}->decrement($key, $stepsize);
186             }
187 0           return 1;
188             }
189              
190 0     0 1   sub clacks_set($self, $key, $data) {
  0            
  0            
  0            
  0            
191 0           $self->reconnect(); # Make sure we are connected
192              
193 0           $key = $self->sanitize_key($key);
194              
195 0           $self->{clacks}->set($key, $data);
196              
197 0           return 1;
198             }
199              
200 0     0 1   sub clacks_notify($self, $key) {
  0            
  0            
  0            
201 0           $self->reconnect(); # Make sure we are connected
202              
203 0           $key = $self->sanitize_key($key);
204              
205 0           $self->{clacks}->set($key);
206              
207 0           return 1;
208             }
209              
210 0     0 1   sub clacks_keylist($self) {
  0            
  0            
211 0           $self->reconnect(); # Make sure we are connected
212              
213 0           return $self->{clacks}->keylist();
214             }
215              
216              
217 0     0 1   sub sanitize_key($self, $key) {
  0            
  0            
  0            
218             # Certain chars are not allowed in keys for protocol reason.
219             # We handle this by substituting them with a tripple underline
220              
221 0           $key =~ s/\ /___/go;
222 0           $key =~ s/\=/___/go;
223              
224 0           return $key;
225             }
226              
227 0     0 1   sub deref($self, $val) {
  0            
  0            
  0            
228 0 0         return if(!defined($val));
229              
230 0   0       while(ref($val) eq "SCALAR" || ref($val) eq "REF") {
231 0           $val = ${$val};
  0            
232 0 0         last if(!defined($val));
233             }
234              
235 0           return $val;
236             }
237              
238             1;
239             __END__