File: | C4/Cache/Memcached.pm |
Coverage: | 38.5% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package C4::Cache::Memcached; | |||||
2 | ||||||
3 | # Copyright 2009 Chris Cormack and The Koha Dev Team | |||||
4 | # | |||||
5 | # This file is part of Koha. | |||||
6 | # | |||||
7 | # Koha is free software; you can redistribute it and/or modify it under the | |||||
8 | # terms of the GNU General Public License as published by the Free Software | |||||
9 | # Foundation; either version 2 of the License, or (at your option) any later | |||||
10 | # version. | |||||
11 | # | |||||
12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | |||||
13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | |||||
14 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | |||||
15 | # | |||||
16 | # You should have received a copy of the GNU General Public License along | |||||
17 | # with Koha; if not, write to the Free Software Foundation, Inc., | |||||
18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |||||
19 | ||||||
20 | 3 3 3 | 305 4 103 | use strict; | |||
21 | 3 3 3 | 13 4 143 | use warnings; | |||
22 | 3 3 3 | 11 4 169 | use Carp; | |||
23 | ||||||
24 | 3 3 3 | 34326 353294 108 | use Cache::Memcached; | |||
25 | ||||||
26 | 3 3 3 | 4174 3 235 | use base qw(C4::Cache); | |||
27 | ||||||
28 | sub _cache_handle { | |||||
29 | 0 | my $class = shift; | ||||
30 | 0 | my $params = shift; | ||||
31 | ||||||
32 | 0 | my @servers = split /,/, $params->{'cache_servers'}; | ||||
33 | ||||||
34 | 0 | return Cache::Memcached->new( | ||||
35 | servers => \@servers, | |||||
36 | namespace => $params->{'namespace'} || 'KOHA', | |||||
37 | ); | |||||
38 | } | |||||
39 | ||||||
40 | sub set_in_cache { | |||||
41 | 0 | my ( $self, $key, $value, $expiry ) = @_; | ||||
42 | 0 | croak "No key" unless $key; | ||||
43 | ||||||
44 | 0 | if ( defined $expiry ) { | ||||
45 | 0 | return $self->cache->set( $key, $value, $expiry ); | ||||
46 | } | |||||
47 | else { | |||||
48 | 0 | return $self->cache->set( $key, $value ); | ||||
49 | } | |||||
50 | } | |||||
51 | ||||||
52 | sub get_from_cache { | |||||
53 | 0 | my ( $self, $key ) = @_; | ||||
54 | 0 | croak "No key" unless $key; | ||||
55 | 0 | return $self->cache->get($key); | ||||
56 | } | |||||
57 | ||||||
58 | sub clear_from_cache { | |||||
59 | 0 | my ( $self, $key ) = @_; | ||||
60 | 0 | croak "No key" unless $key; | ||||
61 | 0 | return $self->cache->delete($key); | ||||
62 | } | |||||
63 | ||||||
64 | sub flush_all { | |||||
65 | 0 | my $self = shift; | ||||
66 | 0 | return $self->cache->flush_all; | ||||
67 | } | |||||
68 | ||||||
69 | 1; |