From 9b3cc5596e3d3f2ec0893485580164200412dc2f Mon Sep 17 00:00:00 2001 From: Jared Camins-Esakov Date: Mon, 14 May 2012 13:27:29 +0200 Subject: [PATCH] Bug 8089: Use Koha::Cache for all caching 1. Replace all instances of memoize_memcached with appropriate calls into Koha::Cache: * reports/guided_reports.pl * C4::Biblio::GetMarcStructure * C4::Languages::getFrameworkLanguages * C4::Languages::getAllLanguages * C4::SQLHelper::GetPrimaryKeys * C4::SQLHelper::_get_columns 2. Replace all references to memcached with the appropriate calls into Koha::Cache in C4::Context. Test plan : * have DEBUG env set to 1 * reach addbiblio page to test the patch in Biblio.pm, or setup more than 1 language * you should see in the logs that you're reading and writing from cache * run the test suite twice both with and without the following environment variables set: export MEMCACHED_SERVERS=127.0.0.1:11211 export MEMCACHED_NAMESPACE=KOHA export CACHING_SYSTEM=memcached Signed-off-by: Chris Cormack I'm unsure about some of the caching times 10000 is a long long time, but other than that, works fine. --- C4/Biblio.pm | 27 +++++++---------- C4/Context.pm | 72 ++++++++++----------------------------------- C4/Languages.pm | 38 +++++++++++++++++------- C4/SQLHelper.pm | 53 ++++++++++++++++++++------------- Koha/Cache.pm | 2 +- reports/guided_reports.pl | 3 +- t/Cache.t | 4 +- 7 files changed, 91 insertions(+), 108 deletions(-) diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 083cbae..0f8379e 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -137,16 +137,6 @@ BEGIN { ); } -eval { - if (C4::Context->ismemcached) { - require Memoize::Memcached; - import Memoize::Memcached qw(memoize_memcached); - - memoize_memcached( 'GetMarcStructure', - memcached => C4::Context->memcached); - } -}; - =head1 NAME C4::Biblio - cataloging management functions @@ -1055,16 +1045,18 @@ sub GetMarcStructure { my ( $forlibrarian, $frameworkcode ) = @_; my $dbh = C4::Context->dbh; $frameworkcode = "" unless $frameworkcode; + my $cache; if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) { return $marc_structure_cache->{$forlibrarian}->{$frameworkcode}; } - - # my $sth = $dbh->prepare( - # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?"); - # $sth->execute($frameworkcode); - # my ($total) = $sth->fetchrow; - # $frameworkcode = "" unless ( $total > 0 ); + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if ($cache) { + my $cached = $cache->get_from_cache("GetMarcStructure:$frameworkcode:$forlibrarian"); + return $cached if $cached; + } + } my $sth = $dbh->prepare( "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable FROM marc_tag_structure @@ -1128,6 +1120,9 @@ sub GetMarcStructure { $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res; + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("GetMarcStructure:$frameworkcode:$forlibrarian",$res,10000); + } return $res; } diff --git a/C4/Context.pm b/C4/Context.pm index 67d31ee..a451aa4 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,9 @@ package C4::Context; use strict; use warnings; -use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached); +use vars qw($VERSION $AUTOLOAD $context @context_stack); + +use Koha::Cache; BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { @@ -79,22 +81,6 @@ BEGIN { } } # else there is no browser to send fatals to! - # Check if there are memcached servers set - $servers = $ENV{'MEMCACHED_SERVERS'}; - if ($servers) { - # Load required libraries and create the memcached object - require Cache::Memcached; - $memcached = Cache::Memcached->new({ - servers => [ $servers ], - debug => 0, - compress_threshold => 10_000, - expire_time => 600, - namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha' - }); - # Verify memcached available (set a variable and test the output) - $ismemcached = $memcached->set('ismemcached','1'); - } - $VERSION = '3.00.00.036'; } @@ -248,38 +234,14 @@ Returns undef in case of error. sub read_config_file { # Pass argument naming config file to read my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); - if ($ismemcached) { - $memcached->set('kohaconf',$koha); + if (Koha::Cache->is_cache_active()) { + my $cache = Koha::Cache->new(); + $cache->set_in_cache('kohaconf', $koha) if defined $cache; } return $koha; # Return value: ref-to-hash holding the configuration } -=head2 ismemcached - -Returns the value of the $ismemcached variable (0/1) - -=cut - -sub ismemcached { - return $ismemcached; -} - -=head2 memcached - -If $ismemcached is true, returns the $memcache variable. -Returns undef otherwise - -=cut - -sub memcached { - if ($ismemcached) { - return $memcached; - } else { - return undef; - } -} - # db_scheme2dbi # Translates the full text name of a database into de appropiate dbi name # @@ -323,9 +285,8 @@ Allocates a new context. Initializes the context from the specified file, which defaults to either the file given by the C<$KOHA_CONF> environment variable, or F. -It saves the koha-conf.xml values in the declared memcached server(s) -if currently available and uses those values until them expire and -re-reads them. +It saves the koha-conf.xml values in the cache (if configured) and uses +those values until them expire and re-reads them. C<&new> does not set this context as the new default context; for that, use C<&set_context>. @@ -362,15 +323,14 @@ sub new { } } - if ($ismemcached) { - # retreive from memcached - $self = $memcached->get('kohaconf'); - if (not defined $self) { - # not in memcached yet - $self = read_config_file($conf_fname); - } - } else { - # non-memcached env, read from file + if (Koha::Cache->is_cache_active()) { + # retrieve from cache + my $cache = Koha::Cache->new(); + $self = $cache->get_from_cache('kohaconf') if defined $cache; + $self = { }; + } + if (!keys %$self) { + # not cached yet $self = read_config_file($conf_fname); } diff --git a/C4/Languages.pm b/C4/Languages.pm index 6f269ac..a746182 100644 --- a/C4/Languages.pm +++ b/C4/Languages.pm @@ -23,19 +23,9 @@ use strict; #use warnings; FIXME - Bug 2505 use Carp; use C4::Context; +use Koha::Cache; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG); -eval { - if (C4::Context->ismemcached) { - require Memoize::Memcached; - import Memoize::Memcached qw(memoize_memcached); - - memoize_memcached('getTranslatedLanguages', memcached => C4::Context->memcached); - memoize_memcached('getFrameworkLanguages' , memcached => C4::Context->memcached); - memoize_memcached('getAllLanguages', memcached => C4::Context->memcached); - } -}; - BEGIN { $VERSION = 3.00; require Exporter; @@ -77,6 +67,15 @@ Returns a reference to an array of hashes: =cut sub getFrameworkLanguages { + + my $cache; + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if (defined $cache) { + my $cached = $cache->get_from_cache("getFrameworkLanguages"); + return $cached if $cached; + } + } # get a hash with all language codes, names, and locale names my $all_languages = getAllLanguages(); my @languages; @@ -99,6 +98,9 @@ sub getFrameworkLanguages { } } } + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("getFrameworkLanguages",\@languages,10000) + } return \@languages; } @@ -179,6 +181,17 @@ Returns a reference to an array of hashes: =cut sub getAllLanguages { + # retrieve from cache if applicable + my $cache; + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if (defined $cache) { + my $cached = $cache->get_from_cache("getAllLanguages"); + if ($cached) { + return $cached; + } + } + } my @languages_loop; my $dbh=C4::Context->dbh; my $current_language = shift || 'en'; @@ -213,6 +226,9 @@ sub getAllLanguages { } push @languages_loop, $language_subtag_registry; } + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("getAllLanguages",\@languages_loop,1000); + } return \@languages_loop; } diff --git a/C4/SQLHelper.pm b/C4/SQLHelper.pm index e1cb5d0..d6d3917 100644 --- a/C4/SQLHelper.pm +++ b/C4/SQLHelper.pm @@ -24,26 +24,10 @@ use List::MoreUtils qw(first_value any); use C4::Context; use C4::Dates qw(format_date_in_iso); use C4::Debug; +use Koha::Cache; require Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); -eval { - my $servers = C4::Context->config('memcached_servers'); - if ($servers) { - require Memoize::Memcached; - import Memoize::Memcached qw(memoize_memcached); - - my $memcached = { - servers => [$servers], - key_prefix => C4::Context->config('memcached_namespace') || 'koha', - expire_time => 600 - }; # cache for 10 mins - - memoize_memcached( '_get_columns', memcached => $memcached ); - memoize_memcached( 'GetPrimaryKeys', memcached => $memcached ); - } -}; - BEGIN { # set the version for version checking $VERSION = 0.5; @@ -236,7 +220,7 @@ sub DeleteInTable{ my $result; eval{$result=$sth->execute(@$values)}; warn $@ if ($@ && $debug); - return $result; + return $result; } } @@ -250,8 +234,22 @@ Get the Primary Key field names of the table sub GetPrimaryKeys($) { my $tablename=shift; - my $hash_columns=_get_columns($tablename); - return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns; + my $result; + my $cache; + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if (defined $cache) { + $result = $cache->get_from_cache("sqlhelper:GetPrimaryKeys:$tablename"); + } + } + unless (defined $result) { + my $hash_columns=_get_columns($tablename); + $result = grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns; + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("sqlhelper:GetPrimaryKeys:$tablename", $result); + } + } + return $result; } @@ -286,12 +284,25 @@ With sub _get_columns($) { my ($tablename) = @_; - unless ( exists( $hashref->{$tablename} ) ) { + my $cache; + if ( exists( $hashref->{$tablename} ) ) { + return $hashref->{$tablename}; + } + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if (defined $cache) { + $hashref->{$tablename} = $cache->get_from_cache("sqlhelper:_get_columns:$tablename"); + } + } + unless ( defined $hashref->{$tablename} ) { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename }); $sth->execute; my $columns = $sth->fetchall_hashref(qw(Field)); $hashref->{$tablename} = $columns; + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("sqlhelper:_get_columns:$tablename", $hashref->{$tablename}); + } } return $hashref->{$tablename}; } diff --git a/Koha/Cache.pm b/Koha/Cache.pm index 636d73e..2e116b7 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -84,7 +84,7 @@ sub new { } sub is_cache_active { - return $ENV{CACHING_SYSTEM} ? '1' : ''; + return $ENV{CACHING_SYSTEM} ? '1' : undef; } sub set_in_cache { diff --git a/reports/guided_reports.pl b/reports/guided_reports.pl index 1112274..ff062f1 100755 --- a/reports/guided_reports.pl +++ b/reports/guided_reports.pl @@ -28,6 +28,7 @@ use C4::Output; use C4::Dates; use C4::Debug; use C4::Branch; # XXX subfield_is_koha_internal_p +use Koha::Cache; =head1 NAME @@ -40,7 +41,7 @@ Script to control the guided report creation =cut my $input = new CGI; -my $usecache = C4::Context->ismemcached; +my $usecache = Koha::Cache->is_cache_active(); my $phase = $input->param('phase'); my $flagsrequired; diff --git a/t/Cache.t b/t/Cache.t index d595dc9..6192d35 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -13,9 +13,9 @@ BEGIN { } SKIP: { - my $cache = Koha::Cache->new (); + skip "Memcached not enabled", 7 unless Koha::Cache->is_cache_active(); - skip "Cache not enabled", 7 unless (Koha::Cache->is_cache_active() && defined $cache); + my $cache = Koha::Cache->new (); # test fetching an item that isnt in the cache is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache"); -- 1.7.2.5