Lines 27-36
Koha::Cache - Handling caching of html and Objects for Koha
Link Here
|
27 |
|
27 |
|
28 |
=head1 DESCRIPTION |
28 |
=head1 DESCRIPTION |
29 |
|
29 |
|
30 |
Base class for Koha::Cache::X. Subclasses need to provide the following methods |
30 |
Base class for Koha::Cache::X. Subclasses must provide the following methods |
31 |
|
31 |
|
32 |
B<_cache_handle ($params_hr)> - cache handle creator |
32 |
B<_cache_handle ($params_hr)> - cache handle creator |
33 |
|
33 |
|
|
|
34 |
Subclasses may override the following methods if they are not using a |
35 |
CHI-derived cache |
36 |
|
34 |
B<set_in_cache ($key, $value, $expiry)> |
37 |
B<set_in_cache ($key, $value, $expiry)> |
35 |
|
38 |
|
36 |
B<get_from_cache ($key)> |
39 |
B<get_from_cache ($key)> |
Lines 46-56
B<flush_all ()>
Link Here
|
46 |
use strict; |
49 |
use strict; |
47 |
use warnings; |
50 |
use warnings; |
48 |
use Carp; |
51 |
use Carp; |
|
|
52 |
use Module::Load::Conditional qw(can_load); |
53 |
use Module::Load; |
54 |
use CHI; |
49 |
|
55 |
|
50 |
use base qw(Class::Accessor); |
56 |
use base qw(Class::Accessor); |
51 |
|
57 |
|
52 |
use Koha::Cache::Memcached; |
|
|
53 |
|
54 |
__PACKAGE__->mk_ro_accessors( qw( cache ) ); |
58 |
__PACKAGE__->mk_ro_accessors( qw( cache ) ); |
55 |
|
59 |
|
56 |
sub new { |
60 |
sub new { |
Lines 58-63
sub new {
Link Here
|
58 |
my $param = shift; |
62 |
my $param = shift; |
59 |
my $cache_type = $ENV{CACHING_SYSTEM} || $param->{cache_type} || 'memcached'; |
63 |
my $cache_type = $ENV{CACHING_SYSTEM} || $param->{cache_type} || 'memcached'; |
60 |
my $subclass = __PACKAGE__."::".ucfirst($cache_type); |
64 |
my $subclass = __PACKAGE__."::".ucfirst($cache_type); |
|
|
65 |
unless (can_load( modules => { $subclass => 0 }) ) { |
66 |
$subclass = __PACKAGE__."::".ucfirst('Null'); |
67 |
load $subclass; |
68 |
} |
61 |
my $cache = $subclass->_cache_handle($param) |
69 |
my $cache = $subclass->_cache_handle($param) |
62 |
or croak "Cannot create cache handle for '$cache_type'"; |
70 |
or croak "Cannot create cache handle for '$cache_type'"; |
63 |
return bless $class->SUPER::new({cache => $cache}), $subclass; |
71 |
return bless $class->SUPER::new({cache => $cache}), $subclass; |
Lines 67-72
sub is_cache_active {
Link Here
|
67 |
return $ENV{CACHING_SYSTEM} ? '1' : '' ; |
75 |
return $ENV{CACHING_SYSTEM} ? '1' : '' ; |
68 |
} |
76 |
} |
69 |
|
77 |
|
|
|
78 |
sub set_in_cache { |
79 |
my ( $self, $key, $value, $expiry ) = @_; |
80 |
croak "No key" unless $key; |
81 |
$ENV{DEBUG} && warn "set_in_cache for $key"; |
82 |
|
83 |
if ( defined $expiry ) { |
84 |
return $self->{cache}->set( $key, $value, $expiry ); |
85 |
} |
86 |
else { |
87 |
return $self->{cache}->set( $key, $value ); |
88 |
} |
89 |
} |
90 |
|
91 |
sub get_from_cache { |
92 |
my ( $self, $key ) = @_; |
93 |
croak "No key" unless $key; |
94 |
$ENV{DEBUG} && warn "get_from_cache for $key"; |
95 |
return $self->{cache}->get($key); |
96 |
} |
97 |
|
98 |
sub clear_from_cache { |
99 |
my ( $self, $key ) = @_; |
100 |
croak "No key" unless $key; |
101 |
return $self->{cache}->remove($key); |
102 |
} |
103 |
|
104 |
sub flush_all { |
105 |
my $self = shift; |
106 |
return $self->{cache}->clear(); |
107 |
} |
108 |
|
70 |
=head2 EXPORT |
109 |
=head2 EXPORT |
71 |
|
110 |
|
72 |
None by default. |
111 |
None by default. |
Lines 79-84
Koha::Cache::Memcached
Link Here
|
79 |
|
118 |
|
80 |
Chris Cormack, E<lt>chris@bigballofwax.co.nzE<gt> |
119 |
Chris Cormack, E<lt>chris@bigballofwax.co.nzE<gt> |
81 |
Paul Poulain, E<lt>paul.poulain@biblibre.comE<gt> |
120 |
Paul Poulain, E<lt>paul.poulain@biblibre.comE<gt> |
|
|
121 |
Jared Camins-Esakov, E<lt>jcamins@cpbibliography.comE<gt> |
82 |
|
122 |
|
83 |
=cut |
123 |
=cut |
84 |
|
124 |
|