@@ -, +, @@ language variables set: --- C4/Biblio.pm | 27 +++++-------- C4/Context.pm | 92 +++++++++++++++++--------------------------- C4/Languages.pm | 38 +++++++++++++----- C4/SQLHelper.pm | 53 +++++++++++++++---------- Koha/Cache.pm | 2 +- reports/guided_reports.pl | 3 +- t/Cache.t | 4 +- 7 files changed, 111 insertions(+), 108 deletions(-) --- a/C4/Biblio.pm +++ a/C4/Biblio.pm @@ -136,16 +136,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 @@ -1054,16 +1044,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 @@ -1127,6 +1119,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; } --- a/C4/Context.pm +++ a/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); } @@ -527,11 +487,20 @@ my %sysprefs; sub preference { my $self = shift; my $var = lc(shift); # The system preference to return + my $cache; if (exists $sysprefs{$var}) { return $sysprefs{$var}; } + if (Koha::Cache->is_cache_active()) { + $cache = Koha::Cache->new(); + if (defined $cache) { + $sysprefs{$var} = $cache->get_from_cache("syspref:$var"); + return $sysprefs{$var} if (defined $sysprefs{$var}); + } + } + my $dbh = C4::Context->dbh or return 0; # Look up systempreferences.variable==$var @@ -542,6 +511,9 @@ sub preference { LIMIT 1 END_SQL $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var ); + if (Koha::Cache->is_cache_active() && defined $cache) { + $cache->set_in_cache("syspref:$var"); + } return $sysprefs{$var}; } @@ -564,6 +536,10 @@ will not be seen by this process. sub clear_syspref_cache { %sysprefs = (); + if (Koha::Cache->is_cache_active()) { + my $cache = Koha::Cache->new(); + $cache->flush_all() if defined $cache; # Sorry, this is unpleasant + } } =head2 set_preference @@ -594,6 +570,10 @@ sub set_preference { " ); if($sth->execute( $var, $value )) { + if (Koha::Cache->is_cache_active()) { + my $cache = Koha::Cache->new(); + $cache->set_in_cache("syspref:$var", $value) if defined $cache; + } $sysprefs{$var} = $value; } $sth->finish; --- a/C4/Languages.pm +++ a/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; } --- a/C4/SQLHelper.pm +++ a/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}; } --- a/Koha/Cache.pm +++ a/Koha/Cache.pm @@ -64,7 +64,7 @@ sub new { } sub is_cache_active { - return $ENV{CACHING_SYSTEM} ? '1' : '' ; + return $ENV{CACHING_SYSTEM} ? '1' : undef ; } =head2 EXPORT --- a/reports/guided_reports.pl +++ a/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; --- a/t/Cache.t +++ a/t/Cache.t @@ -13,9 +13,9 @@ BEGIN { } SKIP: { - skip "Memcached not enabled", 7 unless C4::Context->ismemcached; + skip "Memcached not enabled", 7 unless Koha::Cache->is_cache_active(); - my $cache = Koha::Cache->new ( { 'cache_servers' => $ENV{'MEMCACHED_SERVERS'} } ); + 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"); --