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 =head1 NAME
C4::Biblio - cataloging management functions C4::Biblio - cataloging management functions
@ -1047,18 +1057,16 @@ sub GetMarcStructure {
my ( $forlibrarian, $frameworkcode ) = @_; my ( $forlibrarian, $frameworkcode ) = @_;
my $dbh = C4::Context->dbh; my $dbh = C4::Context->dbh;
$frameworkcode = "" unless $frameworkcode; $frameworkcode = "" unless $frameworkcode;
my $cache;
if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) { if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
return $marc_structure_cache->{$forlibrarian}->{$frameworkcode}; return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
} }
if (Koha::Cache->is_cache_active()) {
$cache = Koha::Cache->new(); # my $sth = $dbh->prepare(
if ($cache) { # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
my $cached = $cache->get_from_cache("GetMarcStructure:$frameworkcode:$forlibrarian"); # $sth->execute($frameworkcode);
return $cached if $cached; # my ($total) = $sth->fetchrow;
} # $frameworkcode = "" unless ( $total > 0 );
}
my $sth = $dbh->prepare( my $sth = $dbh->prepare(
"SELECT tagfield,liblibrarian,libopac,mandatory,repeatable "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
FROM marc_tag_structure FROM marc_tag_structure
@ -1122,9 +1130,6 @@ sub GetMarcStructure {
$marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res; $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; return $res;
} }

92
C4/Context.pm
View file

@ -18,9 +18,7 @@ package C4::Context;
use strict; use strict;
use warnings; use warnings;
use vars qw($VERSION $AUTOLOAD $context @context_stack); use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
use Koha::Cache;
BEGIN { BEGIN {
if ($ENV{'HTTP_USER_AGENT'}) { if ($ENV{'HTTP_USER_AGENT'}) {
@ -81,6 +79,22 @@ BEGIN {
} }
} # else there is no browser to send fatals to! } # 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'; $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 sub read_config_file { # Pass argument naming config file to read
my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
if (Koha::Cache->is_cache_active()) { if ($ismemcached) {
my $cache = Koha::Cache->new(); $memcached->set('kohaconf',$koha);
$cache->set_in_cache('kohaconf', $koha) if defined $cache;
} }
return $koha; # Return value: ref-to-hash holding the configuration 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 # db_scheme2dbi
# Translates the full text name of a database into de appropiate dbi name # 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> file, which defaults to either the file given by the C<$KOHA_CONF>
environment variable, or F</etc/koha/koha-conf.xml>. environment variable, or F</etc/koha/koha-conf.xml>.
It saves the koha-conf.xml values in the cache (if configured) and uses It saves the koha-conf.xml values in the declared memcached server(s)
those values until them expire and re-reads them. 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 C<&new> does not set this context as the new default context; for
that, use C<&set_context>. that, use C<&set_context>.
@ -323,14 +362,15 @@ sub new {
} }
} }
if (Koha::Cache->is_cache_active()) { if ($ismemcached) {
# retrieve from cache # retreive from memcached
my $cache = Koha::Cache->new(); $self = $memcached->get('kohaconf');
$self = $cache->get_from_cache('kohaconf') if defined $cache; if (not defined $self) {
$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); $self = read_config_file($conf_fname);
} }
@ -487,20 +527,11 @@ my %sysprefs;
sub preference { sub preference {
my $self = shift; my $self = shift;
my $var = lc(shift); # The system preference to return my $var = lc(shift); # The system preference to return
my $cache;
if (exists $sysprefs{$var}) { if (exists $sysprefs{$var}) {
return $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; my $dbh = C4::Context->dbh or return 0;
# Look up systempreferences.variable==$var # Look up systempreferences.variable==$var
@ -511,9 +542,6 @@ sub preference {
LIMIT 1 LIMIT 1
END_SQL END_SQL
$sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var ); $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var );
if (Koha::Cache->is_cache_active() && defined $cache) {
$cache->set_in_cache("syspref:$var");
}
return $sysprefs{$var}; return $sysprefs{$var};
} }
@ -536,10 +564,6 @@ will not be seen by this process.
sub clear_syspref_cache { sub clear_syspref_cache {
%sysprefs = (); %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 =head2 set_preference
@ -570,10 +594,6 @@ sub set_preference {
" ); " );
if($sth->execute( $var, $value )) { 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; $sysprefs{$var} = $value;
} }
$sth->finish; $sth->finish;

38
C4/Languages.pm
View file

@ -23,9 +23,19 @@ use strict;
#use warnings; FIXME - Bug 2505 #use warnings; FIXME - Bug 2505
use Carp; use Carp;
use C4::Context; use C4::Context;
use Koha::Cache;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG); 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 { BEGIN {
$VERSION = 3.07.00.049; $VERSION = 3.07.00.049;
require Exporter; require Exporter;
@ -67,15 +77,6 @@ Returns a reference to an array of hashes:
=cut =cut
sub getFrameworkLanguages { 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 # get a hash with all language codes, names, and locale names
my $all_languages = getAllLanguages(); my $all_languages = getAllLanguages();
my @languages; 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; return \@languages;
} }
@ -181,17 +179,6 @@ Returns a reference to an array of hashes:
=cut =cut
sub getAllLanguages { 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 @languages_loop;
my $dbh=C4::Context->dbh; my $dbh=C4::Context->dbh;
my $current_language = shift || 'en'; my $current_language = shift || 'en';
@ -226,9 +213,6 @@ sub getAllLanguages {
} }
push @languages_loop, $language_subtag_registry; 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; return \@languages_loop;
} }

53
C4/SQLHelper.pm
View file

@ -24,10 +24,26 @@ use List::MoreUtils qw(first_value any);
use C4::Context; use C4::Context;
use C4::Dates qw(format_date_in_iso); use C4::Dates qw(format_date_in_iso);
use C4::Debug; use C4::Debug;
use Koha::Cache;
require Exporter; require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); 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 { BEGIN {
# set the version for version checking # set the version for version checking
$VERSION = 3.07.00.049; $VERSION = 3.07.00.049;
@ -220,7 +236,7 @@ sub DeleteInTable{
my $result; my $result;
eval{$result=$sth->execute(@$values)}; eval{$result=$sth->execute(@$values)};
warn $@ if ($@ && $debug); warn $@ if ($@ && $debug);
return $result; return $result;
} }
} }
@ -234,22 +250,8 @@ Get the Primary Key field names of the table
sub GetPrimaryKeys($) { sub GetPrimaryKeys($) {
my $tablename=shift; my $tablename=shift;
my $result; my $hash_columns=_get_columns($tablename);
my $cache; return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns;
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;
} }
@ -284,25 +286,12 @@ With
sub _get_columns($) { sub _get_columns($) {
my ($tablename) = @_; my ($tablename) = @_;
my $cache; unless ( exists( $hashref->{$tablename} ) ) {
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 $dbh = C4::Context->dbh;
my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename }); my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
$sth->execute; $sth->execute;
my $columns = $sth->fetchall_hashref(qw(Field)); my $columns = $sth->fetchall_hashref(qw(Field));
$hashref->{$tablename} = $columns; $hashref->{$tablename} = $columns;
if (Koha::Cache->is_cache_active() && defined $cache) {
$cache->set_in_cache("sqlhelper:_get_columns:$tablename", $hashref->{$tablename});
}
} }
return $hashref->{$tablename}; return $hashref->{$tablename};
} }

2
Koha/Cache.pm
View file

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

3
reports/guided_reports.pl
View file

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

4
t/Cache.t
View file

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