View | Details | Raw Unified | Return to bug 7248
Collapse All | Expand All

(-)a/C4/Cache/Memoize/Memcached.pm (-57 lines)
Lines 1-57 Link Here
1
package Koha::Cache::Memoize::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
use strict;
21
use warnings;
22
use Carp;
23
24
use Memoize::Memcached;
25
26
use base qw(C4::Cache);
27
28
sub _cache_handle {
29
    my $class  = shift;
30
    my $params = shift;
31
    
32
    my @servers = split /,/, $params->{'cache_servers'};
33
    
34
    my $memcached = {
35
	servers    => \@servers,
36
	key_prefix => $params->{'namespace'} || 'koha',
37
    };
38
    my $cache = {};
39
    $cache->{memcache}=$memcached;
40
    return $cache;
41
}
42
43
sub memcached_memoize {
44
    my $self     = shift;
45
    my $function = shift;
46
    my $ttl      = shift;
47
    memoize_memcached($function, memcached => $self->{memcached}, expire_time => $ttl);
48
}
49
50
1;
51
__END__                                                                         
52
                                                                                  
53
=head1 NAME                                                                     
54
55
C4::Cache::Memoize::Memcached - subclass of C4::Cache
56
57
=cut
(-)a/C4/Cache.pm (-12 / +11 lines)
Lines 1-4 Link Here
1
package C4::Cache;
1
package Koha::Cache;
2
2
3
# Copyright 2009 Chris Cormack and The Koha Dev Team
3
# Copyright 2009 Chris Cormack and The Koha Dev Team
4
#
4
#
Lines 19-33 package C4::Cache; Link Here
19
19
20
=head1 NAME
20
=head1 NAME
21
21
22
C4::Cache - Handling caching of html and Objects for Koha
22
Koha::Cache - Handling caching of html and Objects for Koha
23
23
24
=head1 SYNOPSIS
24
=head1 SYNOPSIS
25
25
26
  use C4::Cache (cache_type => $cache_type, %params );
26
  use Koha::Cache (cache_type => $cache_type, %params );
27
27
28
=head1 DESCRIPTION
28
=head1 DESCRIPTION
29
29
30
Base class for C4::Cache::X. Subclasses need to provide the following methods
30
Base class for Koha::Cache::X. Subclasses need to 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
Lines 49-67 use Carp; Link Here
49
49
50
use base qw(Class::Accessor);
50
use base qw(Class::Accessor);
51
51
52
use C4::Cache::Memcached;
52
use Koha::Cache::Memcached;
53
53
54
__PACKAGE__->mk_ro_accessors( qw( cache ) );
54
__PACKAGE__->mk_ro_accessors( qw( cache ) );
55
55
56
sub new {
56
sub new {
57
    my $class = shift;                                                          
57
    my $class = shift;
58
    my %param = @_;                                                             
58
    my $param = shift;
59
    
59
    my $cache_type = $param->{cache_type} || 'memcached';
60
    my $cache_type = $param{cache_type} || 'memcached';
61
    my $subclass = __PACKAGE__."::".ucfirst($cache_type);
60
    my $subclass = __PACKAGE__."::".ucfirst($cache_type);
62
    my $cache    = $subclass->_cache_handle(\%param)
61
    my $cache    = $subclass->_cache_handle($param)
63
      or croak "Cannot create cache handle for '$cache_type'";
62
      or croak "Cannot create cache handle for '$cache_type'";
64
    return bless $class->SUPER::new({cache => $cache}), $subclass;              
63
    return bless $class->SUPER::new({cache => $cache}), $subclass;
65
}
64
}
66
65
67
=head2 EXPORT
66
=head2 EXPORT
Lines 70-76 None by default. Link Here
70
69
71
=head1 SEE ALSO
70
=head1 SEE ALSO
72
71
73
C4::Cache::Memcached
72
Koha::Cache::Memcached
74
73
75
=head1 AUTHOR
74
=head1 AUTHOR
76
75
(-)a/C4/Cache/Memcached.pm (-7 / +6 lines)
Lines 1-4 Link Here
1
package C4::Cache::Memcached;
1
package Koha::Cache::Memcached;
2
2
3
# Copyright 2009 Chris Cormack and The Koha Dev Team
3
# Copyright 2009 Chris Cormack and The Koha Dev Team
4
#
4
#
Lines 23-36 use Carp; Link Here
23
23
24
use Cache::Memcached;
24
use Cache::Memcached;
25
25
26
use base qw(C4::Cache);
26
use base qw(Koha::Cache);
27
27
28
sub _cache_handle {
28
sub _cache_handle {
29
    my $class  = shift;
29
    my $class  = shift;
30
    my $params = shift;
30
    my $params = shift;
31
32
    my @servers = split /,/, $params->{'cache_servers'};
31
    my @servers = split /,/, $params->{'cache_servers'};
33
34
    return Cache::Memcached->new(
32
    return Cache::Memcached->new(
35
        servers   => \@servers,
33
        servers   => \@servers,
36
        namespace => $params->{'namespace'} || 'KOHA',
34
        namespace => $params->{'namespace'} || 'KOHA',
Lines 40-45 sub _cache_handle { Link Here
40
sub set_in_cache {
38
sub set_in_cache {
41
    my ( $self, $key, $value, $expiry ) = @_;
39
    my ( $self, $key, $value, $expiry ) = @_;
42
    croak "No key" unless $key;
40
    croak "No key" unless $key;
41
    $self->cache->set_debug;
43
42
44
    if ( defined $expiry ) {
43
    if ( defined $expiry ) {
45
        return $self->cache->set( $key, $value, $expiry );
44
        return $self->cache->set( $key, $value, $expiry );
Lines 67-76 sub flush_all { Link Here
67
}
66
}
68
67
69
1;
68
1;
70
__END__                                                                         
69
__END__
71
                                                                                  
70
72
=head1 NAME
71
=head1 NAME
73
72
74
C4::Cache::Memcached - memcached subclass of C4::Cache
73
Koha::Cache::Memcached - memcached subclass of Koha::Cache
75
74
76
=cut
75
=cut
(-)a/t/Cache.t (-5 / +34 lines)
Lines 1-14 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
2
#
2
3
# This Koha test module is a stub!  
3
# Tests Koha::Cache and Koha::Cache::Memcached (through Koha::Cache)
4
# Add more tests here!!!
5
4
6
use strict;
5
use strict;
7
use warnings;
6
use warnings;
8
7
9
use Test::More tests => 1;
8
use Test::More tests => 9;
10
9
11
BEGIN {
10
BEGIN {
12
        use_ok('C4::Cache');
11
        use_ok('Koha::Cache');
12
        use_ok('C4::Context');
13
}
13
}
14
14
15
SKIP: {
16
    skip "Memcached not enabled", 7 unless C4::Context->ismemcached;
17
18
    my $cache = Koha::Cache->new ( { 'cache_servers' => $ENV{'MEMCACHED_SERVERS'} } );
19
20
    # test fetching an item that isnt in the cache
21
    is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache");
22
23
    # test expiry time in cache
24
    $cache->set_in_cache("timeout", "I AM DATA", 1); # expiry time of 1 second
25
    sleep 1;
26
    is( $cache->get_from_cache("timeout"), undef, "fetching expired item from cache");
27
28
    # test fetching a valid, non expired, item from cache
29
    $cache->set_in_cache("clear_me", "I AM MORE DATA", 1000); # overly large expiry time, clear below
30
    $cache->set_in_cache("dont_clear_me", "I AM MORE DATA22", 1000); # overly large expiry time, clear below
31
    is( $cache->get_from_cache("clear_me"), "I AM MORE DATA", "fetching valid item from cache");
32
33
    # test clearing from cache
34
    $cache->clear_from_cache("clear_me");
35
    is( $cache->get_from_cache("clear_me"), undef, "fetching cleared item from cache");
36
    is( $cache->get_from_cache("dont_clear_me"), "I AM MORE DATA22", "fetching valid item from cache (after clearing another item)");
37
38
    #test flushing from cache
39
    $cache->set_in_cache("flush_me", "testing 1 data");
40
    $cache->flush_all;
41
    is( $cache->get_from_cache("flush_me"), undef, "fetching flushed item from cache");
42
    is( $cache->get_from_cache("dont_clear_me"), undef, "fetching flushed item from cache");
43
}
(-)a/t/Cache_Memcached.t (-1 / +1 lines)
Lines 9-14 use warnings; Link Here
9
use Test::More tests => 1;
9
use Test::More tests => 1;
10
10
11
BEGIN {
11
BEGIN {
12
        use_ok('C4::Cache::Memcached');
12
        use_ok('Koha::Cache::Memcached');
13
}
13
}
14
14
(-)a/t/Cache_Memoize_Memcached.t (-15 lines)
Lines 1-14 Link Here
1
#!/usr/bin/perl
2
#
3
# This Koha test module is a stub!  
4
# Add more tests here!!!
5
6
use strict;
7
use warnings;
8
9
use Test::More tests => 1;
10
11
BEGIN {
12
        use_ok('C4::Cache::Memoize::Memcached');
13
}
14
15
- 

Return to bug 7248