+++ /dev/null
-package C4::Cache;
-
-# 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.
-
-=head1 NAME
-
-C4::Cache - Handling caching of html and Objects for Koha
-
-=head1 SYNOPSIS
-
- use C4::Cache (cache_type => $cache_type, %params );
-
-=head1 DESCRIPTION
-
-Base class for C4::Cache::X. Subclasses need to provide the following methods
-
-B<_cache_handle ($params_hr)> - cache handle creator
-
-B<set_in_cache ($key, $value, $expiry)>
-
-B<get_from_cache ($key)>
-
-B<clear_from_cache ($key)>
-
-B<flush_all ()>
-
-=head1 FUNCTIONS
-
-=cut
-
-use strict;
-use warnings;
-use Carp;
-
-use base qw(Class::Accessor);
-
-use C4::Cache::Memcached;
-
-__PACKAGE__->mk_ro_accessors( qw( cache ) );
-
-sub new {
- my $class = shift;
- my %param = @_;
-
- my $cache_type = $param{cache_type} || 'memcached';
- my $subclass = __PACKAGE__."::".ucfirst($cache_type);
- my $cache = $subclass->_cache_handle(\%param)
- or croak "Cannot create cache handle for '$cache_type'";
- return bless $class->SUPER::new({cache => $cache}), $subclass;
-}
-
-=head2 EXPORT
-
-None by default.
-
-=head1 SEE ALSO
-
-C4::Cache::Memcached
-
-=head1 AUTHOR
-
-Chris Cormack, E<lt>chris@bigballofwax.co.nzE<gt>
-
-=cut
-
-1;
-
-__END__
+++ /dev/null
-package C4::Cache::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 Cache::Memcached;
-
-use base qw(C4::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',
- );
-}
-
-sub set_in_cache {
- my ( $self, $key, $value, $expiry ) = @_;
- croak "No key" unless $key;
-
- if ( defined $expiry ) {
- return $self->cache->set( $key, $value, $expiry );
- }
- else {
- return $self->cache->set( $key, $value );
- }
-}
-
-sub get_from_cache {
- my ( $self, $key ) = @_;
- croak "No key" unless $key;
- return $self->cache->get($key);
-}
-
-sub clear_from_cache {
- my ( $self, $key ) = @_;
- croak "No key" unless $key;
- return $self->cache->delete($key);
-}
-
-sub flush_all {
- my $self = shift;
- return $self->cache->flush_all;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-C4::Cache::Memcached - memcached subclass of C4::Cache
-
-=cut
+++ /dev/null
-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
--- /dev/null
+package Koha::Cache;
+
+# 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.
+
+=head1 NAME
+
+Koha::Cache - Handling caching of html and Objects for Koha
+
+=head1 SYNOPSIS
+
+ use Koha::Cache (cache_type => $cache_type, %params );
+
+=head1 DESCRIPTION
+
+Base class for Koha::Cache::X. Subclasses need to provide the following methods
+
+B<_cache_handle ($params_hr)> - cache handle creator
+
+B<set_in_cache ($key, $value, $expiry)>
+
+B<get_from_cache ($key)>
+
+B<clear_from_cache ($key)>
+
+B<flush_all ()>
+
+=head1 FUNCTIONS
+
+=cut
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(Class::Accessor);
+
+use Koha::Cache::Memcached;
+
+__PACKAGE__->mk_ro_accessors( qw( cache ) );
+
+sub new {
+ 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)
+ or croak "Cannot create cache handle for '$cache_type'";
+ return bless $class->SUPER::new({cache => $cache}), $subclass;
+}
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+Koha::Cache::Memcached
+
+=head1 AUTHOR
+
+Chris Cormack, E<lt>chris@bigballofwax.co.nzE<gt>
+
+=cut
+
+1;
+
+__END__
--- /dev/null
+package Koha::Cache::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 Cache::Memcached;
+
+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',
+ );
+}
+
+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 );
+ }
+ else {
+ return $self->cache->set( $key, $value );
+ }
+}
+
+sub get_from_cache {
+ my ( $self, $key ) = @_;
+ croak "No key" unless $key;
+ return $self->cache->get($key);
+}
+
+sub clear_from_cache {
+ my ( $self, $key ) = @_;
+ croak "No key" unless $key;
+ return $self->cache->delete($key);
+}
+
+sub flush_all {
+ my $self = shift;
+ return $self->cache->flush_all;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Koha::Cache::Memcached - memcached subclass of Koha::Cache
+
+=cut
#!/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");
+}
use Test::More tests => 1;
BEGIN {
- use_ok('C4::Cache::Memcached');
+ use_ok('Koha::Cache::Memcached');
}
+++ /dev/null
-#!/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');
-}
-
projects / koha.git / commitdiff