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__