1 |
3 |
ahitrov@rambler.ru |
package Contenido::Cache::MemcachedBackend; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use warnings 'all'; |
5 |
|
|
|
6 |
459 |
ahitrov |
use Cache::Memcached::Fast; |
7 |
3 |
ahitrov@rambler.ru |
|
8 |
|
|
|
9 |
|
|
######################################### |
10 |
|
|
# Cache::Backend interface implementation |
11 |
|
|
######################################### |
12 |
|
|
|
13 |
|
|
my $memd; |
14 |
|
|
|
15 |
|
|
sub new { |
16 |
|
|
my ($class, $opts) = @_; |
17 |
|
|
my $implementation = $opts->{mc_backend}; |
18 |
|
|
$memd ||= $implementation->new({ |
19 |
|
|
servers => $$opts{mc_servers}, |
20 |
|
|
namespace => $$opts{mc_namespace}, |
21 |
|
|
}); |
22 |
|
|
bless {memd=>$memd}, $class; |
23 |
|
|
} |
24 |
|
|
|
25 |
|
|
sub delete_key { |
26 |
|
|
my ($self, $nspace, $key) = @_; |
27 |
|
|
$$self{memd}->delete($self->_make_key($nspace, $key)); |
28 |
|
|
} |
29 |
|
|
|
30 |
|
|
sub delete_namespace { |
31 |
|
|
my ($self, $nspace) = @_; |
32 |
|
|
$self->_not_implemented('delete_namespace'); |
33 |
|
|
} |
34 |
|
|
|
35 |
|
|
sub get_keys { |
36 |
|
|
my ($self, $nspace) = @_; |
37 |
|
|
$self->_not_implemented('get_keys'); |
38 |
|
|
} |
39 |
|
|
|
40 |
|
|
sub get_namespaces { |
41 |
|
|
my ($self) = @_; |
42 |
|
|
$self->_not_implemented('get_namespaces'); |
43 |
|
|
} |
44 |
|
|
|
45 |
|
|
sub get_size { |
46 |
|
|
my ($self, $nspace, $key) = @_; |
47 |
|
|
my $val = $self->restore($nspace, $key); |
48 |
|
|
defined($val) ? length($val) : undef; |
49 |
|
|
} |
50 |
|
|
|
51 |
|
|
sub restore { |
52 |
|
|
my ($self, $nspace, $key) = @_; |
53 |
|
|
$$self{memd}->get($self->_make_key($nspace, $key)); |
54 |
|
|
} |
55 |
|
|
|
56 |
|
|
sub store { |
57 |
|
|
my ($self, $nspace, $key, $val) = @_; |
58 |
|
|
$$self{memd}->set($self->_make_key($nspace, $key), $val); |
59 |
|
|
} |
60 |
|
|
|
61 |
|
|
|
62 |
|
|
################### |
63 |
|
|
# Internal routines |
64 |
|
|
################### |
65 |
|
|
|
66 |
|
|
sub _make_key { |
67 |
|
|
my $self = shift; |
68 |
|
|
join ':', map {defined($_) ? $_ : ''} @_; |
69 |
|
|
} |
70 |
|
|
|
71 |
|
|
sub _not_implemented { |
72 |
|
|
my ($self, $meth) = @_; |
73 |
|
|
warn "WARNING! ".ref($self)."::$meth not implemented\n"; |
74 |
|
|
} |
75 |
|
|
|
76 |
|
|
1; |