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 <chris@bigballofwax.co.nz>
I'm unsure about some of the caching times 10000 is a long long time,
but other than that, works fine.

diff --git a/C4/Biblio.pm b/C4/Biblio.pm
index 3a47854..19a23af 100644 (file)
--- a/C4/Biblio.pm
+++ b/C4/Biblio.pm
@@ -139,16 +139,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
@@ -1057,16 +1047,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 
@@ -1130,6 +1122,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 9ce6c74..5e9feae 100644 (file)
--- 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.07.00.049';
 }
 
@@ -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</etc/koha/koha-conf.xml>.
 
-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 d0eed69..238123f 100644 (file)
--- 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.07.00.049;
     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 703c28d..e86d2b7 100644 (file)
--- 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 = 3.07.00.049;
@@ -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 740a133..8850c06 100644 (file)
--- 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 8a2aada..25a2ffb 100755 (executable)
--- 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 (file)
--- 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");