Bug 8585 : Add System Preference to specify Holds to Pull List Start Date
[koha.git] / Koha / Cache.pm
1 package Koha::Cache;
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 =head1 NAME
21
22 Koha::Cache - Handling caching of html and Objects for Koha
23
24 =head1 SYNOPSIS
25
26   use Koha::Cache (cache_type => $cache_type, %params );
27
28 =head1 DESCRIPTION
29
30 Base class for Koha::Cache::X. Subclasses must provide the following methods
31
32 B<_cache_handle ($params_hr)> - cache handle creator
33
34 Subclasses may override the following methods if they are not using a
35 CHI-derived cache
36
37 B<set_in_cache ($key, $value, $expiry)>
38
39 B<get_from_cache ($key)>
40
41 B<clear_from_cache ($key)>
42
43 B<flush_all ()>
44
45 =head1 FUNCTIONS
46
47 =cut
48
49 use strict;
50 use warnings;
51 use Carp;
52 use Module::Load::Conditional qw(can_load);
53 use Module::Load;
54
55 my $have_chi = 0;
56
57 BEGIN: {
58     if ( can_load( modules => { CHI => undef } ) ) {
59         $have_chi = 1;
60     }
61 }
62
63 use base qw(Class::Accessor);
64
65 __PACKAGE__->mk_ro_accessors(qw( cache ));
66
67 sub new {
68     my $class = shift;
69     my $param = shift;
70     my $cache_type =
71          $ENV{CACHING_SYSTEM}
72       || $param->{cache_type}
73       || 'memcached';
74     my $subclass = __PACKAGE__ . "::" . ucfirst($cache_type);
75     $param->{have_chi} = $have_chi;
76     unless ( can_load( modules => { $subclass => undef } ) ) {
77         $subclass = __PACKAGE__ . "::" . ucfirst('Null');
78         load $subclass;
79     }
80     my $cache = $subclass->_cache_handle($param);
81     return
82       bless $class->SUPER::new( { cache => $cache, have_chi => $have_chi } ),
83       $subclass;
84 }
85
86 sub is_cache_active {
87     return $ENV{CACHING_SYSTEM} ? '1' : '';
88 }
89
90 sub set_in_cache {
91     my ( $self, $key, $value, $expiry ) = @_;
92     croak "No key" unless $key;
93     $ENV{DEBUG} && warn "set_in_cache for $key";
94
95     return unless $self->{cache};
96     return unless $self->{have_chi};
97
98     if ( defined $expiry ) {
99         return $self->{cache}->set( $key, $value, $expiry );
100     }
101     else {
102         return $self->{cache}->set( $key, $value );
103     }
104 }
105
106 sub get_from_cache {
107     my ( $self, $key ) = @_;
108     croak "No key" unless $key;
109     $ENV{DEBUG} && warn "get_from_cache for $key";
110     return unless $self->{cache};
111     return unless $self->{have_chi};
112     return $self->{cache}->get($key);
113 }
114
115 sub clear_from_cache {
116     my ( $self, $key ) = @_;
117     croak "No key" unless $key;
118     return unless $self->{cache};
119     return unless $self->{have_chi};
120     return $self->{cache}->remove($key);
121 }
122
123 sub flush_all {
124     my $self = shift;
125     return unless $self->{cache};
126     return unless $self->{have_chi};
127     return $self->{cache}->clear();
128 }
129
130 =head2 EXPORT
131
132 None by default.
133
134 =head1 SEE ALSO
135
136 Koha::Cache::Memcached
137
138 =head1 AUTHOR
139
140 Chris Cormack, E<lt>chris@bigballofwax.co.nzE<gt>
141 Paul Poulain, E<lt>paul.poulain@biblibre.comE<gt>
142 Jared Camins-Esakov, E<lt>jcamins@cpbibliography.comE<gt>
143
144 =cut
145
146 1;
147
148 __END__