Attachment #26891 for bug #12041

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

Lines 99-105 sub GetOverDriveToken { Link Here

(-)a/C4/External/OverDrive.pm (-2 / +4 lines)
99		99
100	my $cache;	100	my $cache;
101		101
102	eval { $cache = Koha::Cache->new() };	102	eval { $cache = Koha::Cache->get_instance() };
103		103
104	my $token;	104	my $token;
105	$cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;	105	$cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;
Lines 124-130 sub GetOverDriveToken { Link Here
124	$token = $contents->{'token_type'} . ' ' . $contents->{'access_token'};	124	$token = $contents->{'token_type'} . ' ' . $contents->{'access_token'};
125		125
126	# Fudge factor to prevent spurious failures	126	# Fudge factor to prevent spurious failures
127	$cache and $cache->set_in_cache( 'overdrive_token', $token, $contents->{'expires_in'} - 5 );	127	$cache
		128	and $cache->set_in_cache( 'overdrive_token', $token,
		129	{ expiry => $contents->{'expires_in'} - 5 } );
128		130
129	return $token;	131	return $token;
130	}	132	}




=head1 DESCRIPTION

Koha caching routines. This class provides two interfaces for cache access.
The first, traditional OO interface provides the following functions:

=head1 FUNCTIONS

=cut

use strict;
use warnings;
use Carp;

__PACKAGE__->mk_ro_accessors(
    qw( cache memcached_cache fastmmap_cache memory_cache ));

=head2 get_instance

    my $cache = Koha::Cache->get_instance();

This gets a shared instance of the cache, set up in a very default way. This is
the recommended way to fetch a cache object. If possible, it'll be
persistent across multiple instances.

=cut

our $singleton_cache;
sub get_instance {
    my ($class) = @_;
    $singleton_cache = $class->new() unless $singleton_cache;
    return $singleton_cache;
}

=head2 new

Create a new Koha::Cache object. This is required for all cache-related functionality.

    $self->{'timeout'}   ||= 0;
    $self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE} || 'koha';

    if ( can_load( modules => { 'Cache::Memcached' => undef } ) ) {
        _initialize_memcached($self);
        if ( $self->{'default_type'} eq 'memcached'
            && defined( $self->{'memcached_cache'} ) )

        }
    }

    # Unless a default has already been picked, we go through in best-to-
    # least-best order, looking for something we can use. fastmmap_cache
    # is excluded because it doesn't support expiry in a useful way.
    unless ( defined( $self->{'cache'} ) ) {
        foreach my $cachemember (qw(memcached_cache memory_cache )) {
            if ( defined( $self->{$cachemember} ) ) {
                $self->{'cache'} = $self->{$cachemember};
                last;
            }
        }
    }

    $ENV{DEBUG} && carp "Selected caching system: " . ($self->{'cache'} // 'none');

    return
      bless $self,

      . join( ', ', @servers )
      . " with "
      . $self->{'namespace'};
    # Cache::Memcached::Fast doesn't allow a default expire time to be set
    my $memcached = Cache::Memcached->new(
        {
            servers            => \@servers,
            compress_threshold => 10_000,
            namespace          => $self->{'namespace'},
            expire_time        => 600,
            debug              => 0,
        }
    );
    # Ensure we can actually talk to the memcached server
    my $ismemcached = $memcached->set('ismemcached','1');
    return $self unless $ismemcached;
    $self->{'memcached_cache'} = $memcached;
    return $self;
}


sub _initialize_memory {
    my ($self) = @_;

    # Default cache time for memory is _always_ short unless it's specially
    # defined, to allow it to work reliably in a persistent environment.
    my $cache = Cache::Memory->new(
        'namespace'       => $self->{'namespace'},
        'default_expires' => "$self->{'timeout'} sec" || "10 sec",
    );
    $self->{'memory_cache'} = $cache;
    # Memory cache can't handle complex types for some reason, so we use its
    # freeze and thaw functions.
    $self->{ref($cache) . '_set'} = sub {
        my ($key, $val, $exp) = @_;
        # Refer to set_expiry in Cache::Entry for why we do this 'sec' thing.
        $exp = "$exp sec" if defined $exp;
        # Because we need to use freeze, it must be a reference type.
        $cache->freeze($key, [$val], $exp);
    };
    $self->{ref($cache) . '_get'} = sub {
        my $res = $cache->thaw(shift);
        return unless defined $res;
        return $res->[0];
    };
    return $self;
}

=head2 is_cache_active

Routine that checks whether or not a default caching method is active on this
object.

=cut

sub is_cache_active {
    my $self = shift;
    return $self->{'cache'} ? 1 : 0;
}

=head2 set_in_cache

    $cache->set_in_cache($key, $value, [$options]);

Save a value to the specified key in the cache. A hashref of options may be
specified.

The possible options are:

=over

=item expiry

Expiry time of this cached entry in seconds.

=item deepcopy

If set, this will perform a deep copy of the item when it's retrieved. This
means that it'll be safe if something later modifies the result of the
function. Will be ignored in situations where the same behaviour comes from
the caching layer anyway.

=item cache

The cache object to use if you want to provide your own. It should be an
instance of C<Cache::*> and follow the same interface as L<Cache::Memcache>.

=cut

sub set_in_cache {
    my ( $self, $key, $value, $options, $_cache) = @_;
    # This is a bit of a hack to support the old API in case things still use it
    if (defined $options && (ref($options) ne 'HASH')) {
        my $new_options;
        $new_options->{expiry} = $options;
        $new_options->{cache} = $_cache if defined $_cache;
        $options = $new_options;
    }

    # the key mustn't contain whitespace (or control characters) for memcache
    # but shouldn't be any harm in applying it globally.
    $key =~ s/[\x00-\x20]/_/g;

    my $cache = $options->{cache} || 'cache';
    croak "No key" unless $key;
    $ENV{DEBUG} && carp "set_in_cache for $key";

    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
    my $expiry = $options->{expiry};
    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
    if ( defined $expiry ) {
        return $set_sub
          ? $set_sub->( $key, $value, $expiry )
          : $self->{$cache}->set( $key, $value, $expiry );
        return $self->{$cache}->set( $key, $value, $expiry );
    }
    else {
        return $set_sub
          ? $set_sub->( $key, $value )
          : $self->{$cache}->set( $key, $value );
    }
}



sub get_from_cache {
    my ( $self, $key, $cache ) = @_;
    $key =~ s/[\x00-\x20]/_/g;
    $cache ||= 'cache';
    croak "No key" unless $key;
    $ENV{DEBUG} && carp "get_from_cache for $key";
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
    return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
}

=head2 clear_from_cache


sub clear_from_cache {
    my ( $self, $key, $cache ) = @_;
    $key =~ s/[\x00-\x20]/_/g;
    $cache ||= 'cache';
    croak "No key" unless $key;
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
    return $self->{$cache}->delete($key)
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
    return $self->{$cache}->remove($key);
}


    $cache ||= 'cache';
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
    return $self->{$cache}->flush_all()
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
    return $self->{$cache}->clear();
}





        $self->{'value'} = &{ $self->{'preload'} }( @{ $self->{'arguments'} } );
        if ( defined( $self->{'cache'} ) ) {
            $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
                { expiry => $self->{'timeout'} } );
        }
        $self->{'lastupdate'} = time;
    }

    if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
        && $self->{'cache'} )
    {
        $self->{'value'} = $self->{'cache'}->get_from_cache( $self->{'key'} );
          $self->{'cache'}
          ->get_from_cache( $self->{'key'}, $self->{'cache_type'} . '_cache' );
        $self->{'lastupdate'} = $now;
    }


            $self->{'value'}, $index );
        if ( defined( $self->{'cache'} ) ) {
            $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
                { expiry => $self->{'timeout'} } );
        }
        $self->{'lastupdate'} = $now;
    }

        && $self->{'allowupdate'}
        && defined( $self->{'cache'} ) )
    {
        $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
            { expiry => $self->{'timeout'} },
        );
    }

    return $self->{'value'};

        && $self->{'unset'}
        && defined( $self->{'cache'} ) )
    {
        $self->{'cache'}->clear_from_cache( $self->{'key'} );
            $self->{'cache_type'} . '_cache' );
    }

    undef $self->{'value'};

Lines 37-43 sub new { Link Here

(-)a/Koha/Template/Plugin/Cache.pm (-2 / +3 lines)
37	}	37	}
38	else {	38	else {
39	require Koha::Cache;	39	require Koha::Cache;
40	$cache = Koha::Cache->new( { 'cache_type' => 'memcached', 'cache_servers' => C4::Context->config('memcached_servers') });	40	$cache = Koha::Cache->get_instance();
41	}	41	}
42	my $self = bless {	42	my $self = bless {
43	CACHE => $cache,	43	CACHE => $cache,
Lines 84-90 sub _cached_action { Link Here
84	my $result = $self->{CACHE}->get_from_cache($key);	84	my $result = $self->{CACHE}->get_from_cache($key);
85	if ( !$result ) {	85	if ( !$result ) {
86	$result = $self->{CONTEXT}->$action( $params->{template} );	86	$result = $self->{CONTEXT}->$action( $params->{template} );
87	$self->{CACHE}->set_in_cache( $key, $result, $params->{ttl} );	87	$self->{CACHE}
		88	->set_in_cache( $key, $result, { expiry => $params->{ttl} } );
88	}	89	}
89	return $result;	90	return $result;
90	}	91	}





die "Sorry this report is not public\n" unless $report_rec->{public};

my $cache = Koha::Cache->get_instance();
my $cache_active = $cache->is_cache_active;
my ($cache_key, $json_text);
if ($cache_active) {
    $cache_key = "opac:report:".($report_name ? "name:$report_name" : "id:$report_id");
    $cache = Koha::Cache->new();
    $json_text = $cache->get_from_cache($cache_key);
}


        $json_text = to_json($lines);

        if ($cache_active) {
            $cache->set_in_cache( $cache_key, $json_text,
                { expiry => $report_rec->{cache_expiry} } );
        }
    }
    else {




    }
);

my $cache = Koha::Cache->get_instance();
my $cache_active = $cache->is_cache_active;
my ($cache_key, $json_text);
if ($cache_active) {
    $cache_key = "intranet:report:".($report_name ? "name:$report_name" : "id:$report_id");
    $cache = Koha::Cache->new();
    $json_text = $cache->get_from_cache($cache_key);
}





}

SKIP: {
    my $cache = Koha::Cache->get_instance();

    skip "Cache not enabled", 25
      unless ( $cache->is_cache_active() && defined $cache );

    # test fetching an item that isnt in the cache
    is( $cache->get_from_cache("not in here"),


END {
  SKIP: {
        my $cache = Koha::Cache->get_instance();
        skip "Cache not enabled", 1
          unless ( $cache->is_cache_active() );
        is( $destructorcount, 1, 'Destructor run exactly once' );
    }
}
- 

Return to bug 12041

Lines 71-77 sub TIESCALAR { Link Here

(-)a/Koha/Cache/Object.pm (-10 / +7 lines)
71	$self->{'value'} = &{ $self->{'preload'} }( @{ $self->{'arguments'} } );	71	$self->{'value'} = &{ $self->{'preload'} }( @{ $self->{'arguments'} } );
72	if ( defined( $self->{'cache'} ) ) {	72	if ( defined( $self->{'cache'} ) ) {
73	$self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},	73	$self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
74	$self->{'timeout'}, $self->{'cache_type'} . '_cache' );	74	{ expiry => $self->{'timeout'} } );
75	}	75	}
76	$self->{'lastupdate'} = time;	76	$self->{'lastupdate'} = time;
77	}	77	}
Lines 90-98 sub FETCH { Link Here
90	if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )	90	if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
91	&& $self->{'cache'} )	91	&& $self->{'cache'} )
92	{	92	{
93	$self->{'value'} =	93	$self->{'value'} = $self->{'cache'}->get_from_cache( $self->{'key'} );
94	$self->{'cache'}
95	->get_from_cache( $self->{'key'}, $self->{'cache_type'} . '_cache' );
96	$self->{'lastupdate'} = $now;	94	$self->{'lastupdate'} = $now;
97	}	95	}
98		96
Lines 106-112 sub FETCH { Link Here
106	$self->{'value'}, $index );	104	$self->{'value'}, $index );
107	if ( defined( $self->{'cache'} ) ) {	105	if ( defined( $self->{'cache'} ) ) {
108	$self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},	106	$self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
109	$self->{'timeout'}, $self->{'cache_type'} . '_cache' );	107	{ expiry => $self->{'timeout'} } );
110	}	108	}
111	$self->{'lastupdate'} = $now;	109	$self->{'lastupdate'} = $now;
112	}	110	}
Lines 130-138 sub STORE { Link Here
130	&& $self->{'allowupdate'}	128	&& $self->{'allowupdate'}
131	&& defined( $self->{'cache'} ) )	129	&& defined( $self->{'cache'} ) )
132	{	130	{
133	$self->{'cache'}	131	$self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
134	->set_in_cache( $self->{'key'}, $self->{'value'}, $self->{'timeout'},	132	{ expiry => $self->{'timeout'} },
135	$self->{'cache_type'} . '_cache' );	133	);
136	}	134	}
137		135
138	return $self->{'value'};	136	return $self->{'value'};
Lines 149-156 sub DESTROY { Link Here
149	&& $self->{'unset'}	147	&& $self->{'unset'}
150	&& defined( $self->{'cache'} ) )	148	&& defined( $self->{'cache'} ) )
151	{	149	{
152	$self->{'cache'}->clear_from_cache( $self->{'key'},	150	$self->{'cache'}->clear_from_cache( $self->{'key'} );
153	$self->{'cache_type'} . '_cache' );
154	}	151	}
155		152
156	undef $self->{'value'};	153	undef $self->{'value'};

Lines 46-56 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here

(-)a/svc/report (-3 / +3 lines)
46	}	46	}
47	);	47	);
48		48
49	my $cache_active = Koha::Cache->is_cache_active;	49	my $cache = Koha::Cache->get_instance();
50	my ($cache_key, $cache, $json_text);	50	my $cache_active = $cache->is_cache_active;
		51	my ($cache_key, $json_text);
51	if ($cache_active) {	52	if ($cache_active) {
52	$cache_key = "intranet:report:".($report_name ? "name:$report_name" : "id:$report_id");	53	$cache_key = "intranet:report:".($report_name ? "name:$report_name" : "id:$report_id");
53	$cache = Koha::Cache->new();
54	$json_text = $cache->get_from_cache($cache_key);	54	$json_text = $cache->get_from_cache($cache_key);
55	}	55	}
56		56

Lines 16-25 BEGIN { Link Here

(-)a/t/Cache.t (-4 / +4 lines)
16	}	16	}
17		17
18	SKIP: {	18	SKIP: {
19	my $cache = Koha::Cache->new();	19	my $cache = Koha::Cache->get_instance();
20		20
21	skip "Cache not enabled", 25	21	skip "Cache not enabled", 25
22	unless ( Koha::Cache->is_cache_active() && defined $cache );	22	unless ( $cache->is_cache_active() && defined $cache );
23		23
24	# test fetching an item that isnt in the cache	24	# test fetching an item that isnt in the cache
25	is( $cache->get_from_cache("not in here"),	25	is( $cache->get_from_cache("not in here"),
Lines 138-145 SKIP: { Link Here
138		138
139	END {	139	END {
140	SKIP: {	140	SKIP: {
		141	my $cache = Koha::Cache->get_instance();
141	skip "Cache not enabled", 1	142	skip "Cache not enabled", 1
142	unless ( Koha::Cache->is_cache_active() );	143	unless ( $cache->is_cache_active() );
143	is( $destructorcount, 1, 'Destructor run exactly once' );	144	is( $destructorcount, 1, 'Destructor run exactly once' );
144	}	145	}
145	}	146	}
146	-

Lines 30-41 Koha::Cache - Handling caching of html and Objects for Koha Link Here

(-)a/Koha/Cache.pm (-31 / +114 lines)
30	=head1 DESCRIPTION	30	=head1 DESCRIPTION
31		31
32	Koha caching routines. This class provides two interfaces for cache access.	32	Koha caching routines. This class provides two interfaces for cache access.
33	The first, traditional interface provides the following functions:	33	The first, traditional OO interface provides the following functions:
34		34
35	=head1 FUNCTIONS	35	=head1 FUNCTIONS
36		36
37	=cut	37	=cut
38
39	use strict;	38	use strict;
40	use warnings;	39	use warnings;
41	use Carp;	40	use Carp;
Lines 47-52 use base qw(Class::Accessor); Link Here
47	__PACKAGE__->mk_ro_accessors(	46	__PACKAGE__->mk_ro_accessors(
48	qw( cache memcached_cache fastmmap_cache memory_cache ));	47	qw( cache memcached_cache fastmmap_cache memory_cache ));
49		48
		49	=head2 get_instance
		50
		51	my $cache = Koha::Cache->get_instance();
		52
		53	This gets a shared instance of the cache, set up in a very default way. This is
		54	the recommended way to fetch a cache object. If possible, it'll be
		55	persistent across multiple instances.
		56
		57	=cut
		58
		59	our $singleton_cache;
		60	sub get_instance {
		61	my ($class) = @_;
		62	$singleton_cache = $class->new() unless $singleton_cache;
		63	return $singleton_cache;
		64	}
		65
50	=head2 new	66	=head2 new
51		67
52	Create a new Koha::Cache object. This is required for all cache-related functionality.	68	Create a new Koha::Cache object. This is required for all cache-related functionality.
Lines 65-71 sub new { Link Here
65	$self->{'timeout'} \|\|= 0;	81	$self->{'timeout'} \|\|= 0;
66	$self->{'namespace'} \|\|= $ENV{MEMCACHED_NAMESPACE} \|\| 'koha';	82	$self->{'namespace'} \|\|= $ENV{MEMCACHED_NAMESPACE} \|\| 'koha';
67		83
68	if ( can_load( modules => { 'Cache::Memcached::Fast' => undef } ) ) {	84	if ( can_load( modules => { 'Cache::Memcached' => undef } ) ) {
69	_initialize_memcached($self);	85	_initialize_memcached($self);
70	if ( $self->{'default_type'} eq 'memcached'	86	if ( $self->{'default_type'} eq 'memcached'
71	&& defined( $self->{'memcached_cache'} ) )	87	&& defined( $self->{'memcached_cache'} ) )
Lines 92-106 sub new { Link Here
92	}	108	}
93	}	109	}
94		110
95	# NOTE: The following five lines could be uncommented if we wanted to	111	# Unless a default has already been picked, we go through in best-to-
96	# fall back to any functioning cache. Commented out since this would	112	# least-best order, looking for something we can use. fastmmap_cache
97	# represent a change in behavior.	113	# is excluded because it doesn't support expiry in a useful way.
98	#	114	unless ( defined( $self->{'cache'} ) ) {
99	#unless (defined($self->{'cache'})) {	115	foreach my $cachemember (qw(memcached_cache memory_cache )) {
100	# foreach my $cachemember (qw(memory_cache fastmmap_cache memcached_cache)) {	116	if ( defined( $self->{$cachemember} ) ) {
101	# $self->{'cache'} = $self->{$cachemember} if (defined($self->{$cachemember}));	117	$self->{'cache'} = $self->{$cachemember};
102	# }	118	last;
103	#}	119	}
		120	}
		121	}
		122
		123	$ENV{DEBUG} && carp "Selected caching system: " . ($self->{'cache'} // 'none');
104		124
105	return	125	return
106	bless $self,	126	bless $self,
Lines 119-131 sub _initialize_memcached { Link Here
119	. join( ', ', @servers )	139	. join( ', ', @servers )
120	. " with "	140	. " with "
121	. $self->{'namespace'};	141	. $self->{'namespace'};
122	$self->{'memcached_cache'} = Cache::Memcached::Fast->new(	142	# Cache::Memcached::Fast doesn't allow a default expire time to be set
		143	my $memcached = Cache::Memcached->new(
123	{	144	{
124	servers => \@servers,	145	servers => \@servers,
125	compress_threshold => 10_000,	146	compress_threshold => 10_000,
126	namespace => $self->{'namespace'},	147	namespace => $self->{'namespace'},
		148	expire_time => 600,
		149	debug => 0,
127	}	150	}
128	);	151	);
		152	# Ensure we can actually talk to the memcached server
		153	my $ismemcached = $memcached->set('ismemcached','1');
		154	return $self unless $ismemcached;
		155	$self->{'memcached_cache'} = $memcached;
129	return $self;	156	return $self;
130	}	157	}
131		158
Lines 143-190 sub _initialize_fastmmap { Link Here
143	sub _initialize_memory {	170	sub _initialize_memory {
144	my ($self) = @_;	171	my ($self) = @_;
145		172
146	$self->{'memory_cache'} = Cache::Memory->new(	173	# Default cache time for memory is _always_ short unless it's specially
		174	# defined, to allow it to work reliably in a persistent environment.
		175	my $cache = Cache::Memory->new(
147	'namespace' => $self->{'namespace'},	176	'namespace' => $self->{'namespace'},
148	'default_expires' => $self->{'timeout'}	177	'default_expires' => "$self->{'timeout'} sec" \|\| "10 sec",
149	);	178	);
		179	$self->{'memory_cache'} = $cache;
		180	# Memory cache can't handle complex types for some reason, so we use its
		181	# freeze and thaw functions.
		182	$self->{ref($cache) . '_set'} = sub {
		183	my ($key, $val, $exp) = @_;
		184	# Refer to set_expiry in Cache::Entry for why we do this 'sec' thing.
		185	$exp = "$exp sec" if defined $exp;
		186	# Because we need to use freeze, it must be a reference type.
		187	$cache->freeze($key, [$val], $exp);
		188	};
		189	$self->{ref($cache) . '_get'} = sub {
		190	my $res = $cache->thaw(shift);
		191	return unless defined $res;
		192	return $res->[0];
		193	};
150	return $self;	194	return $self;
151	}	195	}
152		196
153	=head2 is_cache_active	197	=head2 is_cache_active
154		198
155	Routine that checks whether or not a caching system has been selected. This is	199	Routine that checks whether or not a default caching method is active on this
156	not an instance method.	200	object.
157		201
158	=cut	202	=cut
159		203
160	sub is_cache_active {	204	sub is_cache_active {
161	return $ENV{CACHING_SYSTEM} ? '1' : '';	205	my $self = shift;
		206	return $self->{'cache'} ? 1 : 0;
162	}	207	}
163		208
164	=head2 set_in_cache	209	=head2 set_in_cache
165		210
166	$cache->set_in_cache($key, $value, [$expiry]);	211	$cache->set_in_cache($key, $value, [$options]);
		212
		213	Save a value to the specified key in the cache. A hashref of options may be
		214	specified.
167		215
168	Save a value to the specified key in the default cache, optionally with a	216	The possible options are:
169	particular expiry.	217
		218	=over
		219
		220	=item expiry
		221
		222	Expiry time of this cached entry in seconds.
		223
		224	=item deepcopy
		225
		226	If set, this will perform a deep copy of the item when it's retrieved. This
		227	means that it'll be safe if something later modifies the result of the
		228	function. Will be ignored in situations where the same behaviour comes from
		229	the caching layer anyway.
		230
		231	=item cache
		232
		233	The cache object to use if you want to provide your own. It should be an
		234	instance of C<Cache::*> and follow the same interface as L<Cache::Memcache>.
170		235
171	=cut	236	=cut
172		237
173	sub set_in_cache {	238	sub set_in_cache {
174	my ( $self, $key, $value, $expiry, $cache ) = @_;	239	my ( $self, $key, $value, $options, $_cache) = @_;
175	$cache \|\|= 'cache';	240	# This is a bit of a hack to support the old API in case things still use it
		241	if (defined $options && (ref($options) ne 'HASH')) {
		242	my $new_options;
		243	$new_options->{expiry} = $options;
		244	$new_options->{cache} = $_cache if defined $_cache;
		245	$options = $new_options;
		246	}
		247
		248	# the key mustn't contain whitespace (or control characters) for memcache
		249	# but shouldn't be any harm in applying it globally.
		250	$key =~ s/[\x00-\x20]/_/g;
		251
		252	my $cache = $options->{cache} \|\| 'cache';
176	croak "No key" unless $key;	253	croak "No key" unless $key;
177	$ENV{DEBUG} && carp "set_in_cache for $key";	254	$ENV{DEBUG} && carp "set_in_cache for $key";
178		255
179	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );	256	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
		257	my $expiry = $options->{expiry};
		258	my $set_sub = $self->{ref($self->{$cache}) . "_set"};
180	if ( defined $expiry ) {	259	if ( defined $expiry ) {
181	if ( ref( $self->{$cache} ) eq 'Cache::Memory' ) {	260	return $set_sub
182	$expiry = "$expiry sec";	261	? $set_sub->( $key, $value, $expiry )
183	}	262	: $self->{$cache}->set( $key, $value, $expiry );
184	return $self->{$cache}->set( $key, $value, $expiry );
185	}	263	}
186	else {	264	else {
187	return $self->{$cache}->set( $key, $value );	265	return $set_sub
		266	? $set_sub->( $key, $value )
		267	: $self->{$cache}->set( $key, $value );
188	}	268	}
189	}	269	}
190		270
Lines 198-208 Retrieve the value stored under the specified key in the default cache. Link Here
198		278
199	sub get_from_cache {	279	sub get_from_cache {
200	my ( $self, $key, $cache ) = @_;	280	my ( $self, $key, $cache ) = @_;
		281	$key =~ s/[\x00-\x20]/_/g;
201	$cache \|\|= 'cache';	282	$cache \|\|= 'cache';
202	croak "No key" unless $key;	283	croak "No key" unless $key;
203	$ENV{DEBUG} && carp "get_from_cache for $key";	284	$ENV{DEBUG} && carp "get_from_cache for $key";
204	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );	285	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
205	return $self->{$cache}->get($key);	286	my $get_sub = $self->{ref($self->{$cache}) . "_get"};
		287	return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
206	}	288	}
207		289
208	=head2 clear_from_cache	290	=head2 clear_from_cache
Lines 215-225 Remove the value identified by the specified key from the default cache. Link Here
215		297
216	sub clear_from_cache {	298	sub clear_from_cache {
217	my ( $self, $key, $cache ) = @_;	299	my ( $self, $key, $cache ) = @_;
		300	$key =~ s/[\x00-\x20]/_/g;
218	$cache \|\|= 'cache';	301	$cache \|\|= 'cache';
219	croak "No key" unless $key;	302	croak "No key" unless $key;
220	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );	303	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
221	return $self->{$cache}->delete($key)	304	return $self->{$cache}->delete($key)
222	if ( ref( $self->{$cache} ) eq 'Cache::Memcached::Fast' );	305	if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
223	return $self->{$cache}->remove($key);	306	return $self->{$cache}->remove($key);
224	}	307	}
225		308
Lines 236-242 sub flush_all { Link Here
236	$cache \|\|= 'cache';	319	$cache \|\|= 'cache';
237	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );	320	return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
238	return $self->{$cache}->flush_all()	321	return $self->{$cache}->flush_all()
239	if ( ref( $self->{$cache} ) eq 'Cache::Memcached::Fast' );	322	if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
240	return $self->{$cache}->clear();	323	return $self->{$cache}->clear();
241	}	324	}
242		325

Lines 36-46 if (!$report_rec) { die "There is no such report.\n"; } Link Here

(-)a/opac/svc/report (-4 / +5 lines)
36		36
37	die "Sorry this report is not public\n" unless $report_rec->{public};	37	die "Sorry this report is not public\n" unless $report_rec->{public};
38		38
39	my $cache_active = Koha::Cache->is_cache_active;	39	my $cache = Koha::Cache->get_instance();
40	my ($cache_key, $cache, $json_text);	40	my $cache_active = $cache->is_cache_active;
		41	my ($cache_key, $json_text);
41	if ($cache_active) {	42	if ($cache_active) {
42	$cache_key = "opac:report:".($report_name ? "name:$report_name" : "id:$report_id");	43	$cache_key = "opac:report:".($report_name ? "name:$report_name" : "id:$report_id");
43	$cache = Koha::Cache->new();
44	$json_text = $cache->get_from_cache($cache_key);	44	$json_text = $cache->get_from_cache($cache_key);
45	}	45	}
46		46
Lines 59-65 unless ($json_text) { Link Here
59	$json_text = to_json($lines);	59	$json_text = to_json($lines);
60		60
61	if ($cache_active) {	61	if ($cache_active) {
62	$cache->set_in_cache( $cache_key, $json_text, $report_rec->{cache_expiry} );	62	$cache->set_in_cache( $cache_key, $json_text,
		63	{ expiry => $report_rec->{cache_expiry} } );
63	}	64	}
64	}	65	}
65	else {	66	else {