Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Merge remote-tracking branch 'origin/new/bug_8089'

Browse source
This commit is contained in:
Paul Poulain 2012-09-12 14:14:35 +02:00
commit da262047be
7 changed files with 108 additions and 111 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
C4/Biblio.pm
View file

@ -139,6 +139,16 @@ 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
@ -1047,18 +1057,16 @@ 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};
}
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 COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
# $sth->execute($frameworkcode);
# my ($total) = $sth->fetchrow;
# $frameworkcode = "" unless ( $total > 0 );
my $sth = $dbh->prepare(
"SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
FROM marc_tag_structure
@ -1122,9 +1130,6 @@ 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;
}

90
C4/Context.pm
View file

@ -18,9 +18,7 @@ package C4::Context;
use strict;
use warnings;
use vars qw($VERSION $AUTOLOAD $context @context_stack);
use Koha::Cache;
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
BEGIN {
if ($ENV{'HTTP_USER_AGENT'}) {
@ -81,6 +79,22 @@ 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';
}
@ -234,14 +248,38 @@ 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 (Koha::Cache->is_cache_active()) {
my $cache = Koha::Cache->new();
$cache->set_in_cache('kohaconf', $koha) if defined $cache;
if ($ismemcached) {
$memcached->set('kohaconf',$koha);
}
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
#
@ -285,8 +323,9 @@ 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 cache (if configured) and uses
those values until them expire and re-reads them.
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.
C<&new> does not set this context as the new default context; for
that, use C<&set_context>.
@ -323,14 +362,15 @@ sub new {
}
}
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 ($ismemcached) {
# retreive from memcached
$self = $memcached->get('kohaconf');
if (not defined $self) {
# not in memcached yet
$self = read_config_file($conf_fname);
}
if (!keys %$self) {
# not cached yet
} else {
# non-memcached env, read from file
$self = read_config_file($conf_fname);
}
@ -487,20 +527,11 @@ 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
@ -511,9 +542,6 @@ 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};
}
@ -536,10 +564,6 @@ 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
@ -570,10 +594,6 @@ 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;

38
C4/Languages.pm
View file

@ -23,9 +23,19 @@ 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;
@ -67,15 +77,6 @@ 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;
@ -98,9 +99,6 @@ sub getFrameworkLanguages {
}
}
}
if (Koha::Cache->is_cache_active() && defined $cache) {
$cache->set_in_cache("getFrameworkLanguages",\@languages,1000)
}
return \@languages;
}
@ -181,17 +179,6 @@ 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';
@ -226,9 +213,6 @@ 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;
}

49
C4/SQLHelper.pm
View file

@ -24,10 +24,26 @@ 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;
@ -234,22 +250,8 @@ Get the Primary Key field names of the table
sub GetPrimaryKeys($) {
my $tablename=shift;
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;
return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns;
}
@ -284,25 +286,12 @@ With
sub _get_columns($) {
my ($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} ) {
unless ( exists( $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};
}

2
Koha/Cache.pm
View file

@ -84,7 +84,7 @@ sub new {
}
sub is_cache_active {
return $ENV{CACHING_SYSTEM} ? '1' : undef;
return $ENV{CACHING_SYSTEM} ? '1' : '';
}
sub set_in_cache {

3
reports/guided_reports.pl
View file

@ -28,7 +28,6 @@ use C4::Output;
use C4::Dates;
use C4::Debug;
use C4::Branch; # XXX subfield_is_koha_internal_p
use Koha::Cache;
=head1 NAME
@ -41,7 +40,7 @@ Script to control the guided report creation
=cut
my $input = new CGI;
my $usecache = Koha::Cache->is_cache_active();
my $usecache = C4::Context->ismemcached;
my $phase = $input->param('phase');
my $flagsrequired;

4
t/Cache.t
View file

@ -13,10 +13,10 @@ BEGIN {
}
SKIP: {
skip "Memcached not enabled", 7 unless Koha::Cache->is_cache_active();
my $cache = Koha::Cache->new ();
skip "Cache not enabled", 7 unless (Koha::Cache->is_cache_active() && defined $cache);
# test fetching an item that isnt in the cache
is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache");