Bug 7248 Added caching support and and moved Caching into Koha namespace
Unit test for Koha/Cache.pm (which includes Koha/Cache/Memcached.pm) Note that in order to test Koha::Cache you must export the environment variable MEMCACHED_SERVERS. For example: $ export MEMCACHED_SERVERS=127.0.0.1:11211 Signed-off-by: Jared Camins-Esakov <jcamins@cpbibliography.com> Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
This commit is contained in:
Chris Hall
Paul Poulain
parent
978ac74b34
commit
03fee7a590
|
|
@ -1,57 +0,0 @@
|
|||
package Koha::Cache::Memoize::Memcached;
|
||||
|
||||
# Copyright 2009 Chris Cormack and The Koha Dev Team
|
||||
#
|
||||
# This file is part of Koha.
|
||||
#
|
||||
# Koha is free software; you can redistribute it and/or modify it under the
|
||||
# terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation; either version 2 of the License, or (at your option) any later
|
||||
# version.
|
||||
#
|
||||
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
||||
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along
|
||||
# with Koha; if not, write to the Free Software Foundation, Inc.,
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
use Memoize::Memcached;
|
||||
|
||||
use base qw(C4::Cache);
|
||||
|
||||
sub _cache_handle {
|
||||
my $class = shift;
|
||||
my $params = shift;
|
||||
|
||||
my @servers = split /,/, $params->{'cache_servers'};
|
||||
|
||||
my $memcached = {
|
||||
servers => \@servers,
|
||||
key_prefix => $params->{'namespace'} || 'koha',
|
||||
};
|
||||
my $cache = {};
|
||||
$cache->{memcache}=$memcached;
|
||||
return $cache;
|
||||
}
|
||||
|
||||
sub memcached_memoize {
|
||||
my $self = shift;
|
||||
my $function = shift;
|
||||
my $ttl = shift;
|
||||
memoize_memcached($function, memcached => $self->{memcached}, expire_time => $ttl);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
C4::Cache::Memoize::Memcached - subclass of C4::Cache
|
||||
|
||||
=cut
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
package C4::Cache;
|
||||
package Koha::Cache;
|
||||
|
||||
# Copyright 2009 Chris Cormack and The Koha Dev Team
|
||||
#
|
||||
|
|
@ -19,15 +19,15 @@ package C4::Cache;
|
|||
|
||||
=head1 NAME
|
||||
|
||||
C4::Cache - Handling caching of html and Objects for Koha
|
||||
Koha::Cache - Handling caching of html and Objects for Koha
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use C4::Cache (cache_type => $cache_type, %params );
|
||||
use Koha::Cache (cache_type => $cache_type, %params );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Base class for C4::Cache::X. Subclasses need to provide the following methods
|
||||
Base class for Koha::Cache::X. Subclasses need to provide the following methods
|
||||
|
||||
B<_cache_handle ($params_hr)> - cache handle creator
|
||||
|
||||
|
|
@ -49,19 +49,18 @@ use Carp;
|
|||
|
||||
use base qw(Class::Accessor);
|
||||
|
||||
use C4::Cache::Memcached;
|
||||
use Koha::Cache::Memcached;
|
||||
|
||||
__PACKAGE__->mk_ro_accessors( qw( cache ) );
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %param = @_;
|
||||
|
||||
my $cache_type = $param{cache_type} || 'memcached';
|
||||
my $class = shift;
|
||||
my $param = shift;
|
||||
my $cache_type = $param->{cache_type} || 'memcached';
|
||||
my $subclass = __PACKAGE__."::".ucfirst($cache_type);
|
||||
my $cache = $subclass->_cache_handle(\%param)
|
||||
my $cache = $subclass->_cache_handle($param)
|
||||
or croak "Cannot create cache handle for '$cache_type'";
|
||||
return bless $class->SUPER::new({cache => $cache}), $subclass;
|
||||
return bless $class->SUPER::new({cache => $cache}), $subclass;
|
||||
}
|
||||
|
||||
=head2 EXPORT
|
||||
|
|
@ -70,7 +69,7 @@ None by default.
|
|||
|
||||
=head1 SEE ALSO
|
||||
|
||||
C4::Cache::Memcached
|
||||
Koha::Cache::Memcached
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
package C4::Cache::Memcached;
|
||||
package Koha::Cache::Memcached;
|
||||
|
||||
# Copyright 2009 Chris Cormack and The Koha Dev Team
|
||||
#
|
||||
|
|
@ -23,14 +23,12 @@ use Carp;
|
|||
|
||||
use Cache::Memcached;
|
||||
|
||||
use base qw(C4::Cache);
|
||||
use base qw(Koha::Cache);
|
||||
|
||||
sub _cache_handle {
|
||||
my $class = shift;
|
||||
my $params = shift;
|
||||
|
||||
my @servers = split /,/, $params->{'cache_servers'};
|
||||
|
||||
return Cache::Memcached->new(
|
||||
servers => \@servers,
|
||||
namespace => $params->{'namespace'} || 'KOHA',
|
||||
|
|
@ -40,6 +38,7 @@ sub _cache_handle {
|
|||
sub set_in_cache {
|
||||
my ( $self, $key, $value, $expiry ) = @_;
|
||||
croak "No key" unless $key;
|
||||
$self->cache->set_debug;
|
||||
|
||||
if ( defined $expiry ) {
|
||||
return $self->cache->set( $key, $value, $expiry );
|
||||
|
|
@ -67,10 +66,10 @@ sub flush_all {
|
|||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
C4::Cache::Memcached - memcached subclass of C4::Cache
|
||||
Koha::Cache::Memcached - memcached subclass of Koha::Cache
|
||||
|
||||
=cut
|
||||
39
t/Cache.t
39
t/Cache.t
|
|
@ -1,14 +1,43 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This Koha test module is a stub!
|
||||
# Add more tests here!!!
|
||||
|
||||
# Tests Koha::Cache and Koha::Cache::Memcached (through Koha::Cache)
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 1;
|
||||
use Test::More tests => 9;
|
||||
|
||||
BEGIN {
|
||||
use_ok('C4::Cache');
|
||||
use_ok('Koha::Cache');
|
||||
use_ok('C4::Context');
|
||||
}
|
||||
|
||||
SKIP: {
|
||||
skip "Memcached not enabled", 7 unless C4::Context->ismemcached;
|
||||
|
||||
my $cache = Koha::Cache->new ( { 'cache_servers' => $ENV{'MEMCACHED_SERVERS'} } );
|
||||
|
||||
# test fetching an item that isnt in the cache
|
||||
is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache");
|
||||
|
||||
# test expiry time in cache
|
||||
$cache->set_in_cache("timeout", "I AM DATA", 1); # expiry time of 1 second
|
||||
sleep 1;
|
||||
is( $cache->get_from_cache("timeout"), undef, "fetching expired item from cache");
|
||||
|
||||
# test fetching a valid, non expired, item from cache
|
||||
$cache->set_in_cache("clear_me", "I AM MORE DATA", 1000); # overly large expiry time, clear below
|
||||
$cache->set_in_cache("dont_clear_me", "I AM MORE DATA22", 1000); # overly large expiry time, clear below
|
||||
is( $cache->get_from_cache("clear_me"), "I AM MORE DATA", "fetching valid item from cache");
|
||||
|
||||
# test clearing from cache
|
||||
$cache->clear_from_cache("clear_me");
|
||||
is( $cache->get_from_cache("clear_me"), undef, "fetching cleared item from cache");
|
||||
is( $cache->get_from_cache("dont_clear_me"), "I AM MORE DATA22", "fetching valid item from cache (after clearing another item)");
|
||||
|
||||
#test flushing from cache
|
||||
$cache->set_in_cache("flush_me", "testing 1 data");
|
||||
$cache->flush_all;
|
||||
is( $cache->get_from_cache("flush_me"), undef, "fetching flushed item from cache");
|
||||
is( $cache->get_from_cache("dont_clear_me"), undef, "fetching flushed item from cache");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,6 +9,6 @@ use warnings;
|
|||
use Test::More tests => 1;
|
||||
|
||||
BEGIN {
|
||||
use_ok('C4::Cache::Memcached');
|
||||
use_ok('Koha::Cache::Memcached');
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This Koha test module is a stub!
|
||||
# Add more tests here!!!
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 1;
|
||||
|
||||
BEGIN {
|
||||
use_ok('C4::Cache::Memoize::Memcached');
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue