View | Details | Raw Unified | Return to bug 8089
Collapse All | Expand All

(-)a/C4/Biblio.pm (-16 / +11 lines)
Lines 136-151 BEGIN { Link Here
136
    );
136
    );
137
}
137
}
138
138
139
eval {
140
    if (C4::Context->ismemcached) {
141
        require Memoize::Memcached;
142
        import Memoize::Memcached qw(memoize_memcached);
143
144
        memoize_memcached( 'GetMarcStructure',
145
                            memcached => C4::Context->memcached);
146
    }
147
};
148
149
=head1 NAME
139
=head1 NAME
150
140
151
C4::Biblio - cataloging management functions
141
C4::Biblio - cataloging management functions
Lines 1054-1069 sub GetMarcStructure { Link Here
1054
    my ( $forlibrarian, $frameworkcode ) = @_;
1044
    my ( $forlibrarian, $frameworkcode ) = @_;
1055
    my $dbh = C4::Context->dbh;
1045
    my $dbh = C4::Context->dbh;
1056
    $frameworkcode = "" unless $frameworkcode;
1046
    $frameworkcode = "" unless $frameworkcode;
1047
    my $cache;
1057
1048
1058
    if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1049
    if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
1059
        return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1050
        return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
1060
    }
1051
    }
1061
1052
    if (Koha::Cache->is_cache_active()) {
1062
    #     my $sth = $dbh->prepare(
1053
        $cache = Koha::Cache->new();
1063
    #         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1054
        if ($cache) {
1064
    #     $sth->execute($frameworkcode);
1055
            my $cached = $cache->get_from_cache("GetMarcStructure:$frameworkcode:$forlibrarian");
1065
    #     my ($total) = $sth->fetchrow;
1056
            return $cached if $cached;
1066
    #     $frameworkcode = "" unless ( $total > 0 );
1057
        }
1058
    }
1067
    my $sth = $dbh->prepare(
1059
    my $sth = $dbh->prepare(
1068
        "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
1060
        "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
1069
        FROM marc_tag_structure 
1061
        FROM marc_tag_structure 
Lines 1127-1132 sub GetMarcStructure { Link Here
1127
1119
1128
    $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1120
    $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
1129
1121
1122
    if (Koha::Cache->is_cache_active() && defined $cache) {
1123
        $cache->set_in_cache("GetMarcStructure:$frameworkcode:$forlibrarian",$res,10000);
1124
    }
1130
    return $res;
1125
    return $res;
1131
}
1126
}
1132
1127
(-)a/C4/Context.pm (-56 / +16 lines)
Lines 18-24 package C4::Context; Link Here
18
18
19
use strict;
19
use strict;
20
use warnings;
20
use warnings;
21
use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
21
use vars qw($VERSION $AUTOLOAD $context @context_stack);
22
23
use Koha::Cache;
22
24
23
BEGIN {
25
BEGIN {
24
	if ($ENV{'HTTP_USER_AGENT'})	{
26
	if ($ENV{'HTTP_USER_AGENT'})	{
Lines 79-100 BEGIN { Link Here
79
		}
81
		}
80
    }  	# else there is no browser to send fatals to!
82
    }  	# else there is no browser to send fatals to!
81
83
82
    # Check if there are memcached servers set
83
    $servers = $ENV{'MEMCACHED_SERVERS'};
84
    if ($servers) {
85
        # Load required libraries and create the memcached object
86
        require Cache::Memcached;
87
        $memcached = Cache::Memcached->new({
88
        servers => [ $servers ],
89
        debug   => 0,
90
        compress_threshold => 10_000,
91
        expire_time => 600,
92
        namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha'
93
    });
94
        # Verify memcached available (set a variable and test the output)
95
    $ismemcached = $memcached->set('ismemcached','1');
96
    }
97
98
    $VERSION = '3.00.00.036';
84
    $VERSION = '3.00.00.036';
99
}
85
}
100
86
Lines 248-285 Returns undef in case of error. Link Here
248
sub read_config_file {		# Pass argument naming config file to read
234
sub read_config_file {		# Pass argument naming config file to read
249
    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
235
    my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
250
236
251
    if ($ismemcached) {
237
    if (Koha::Cache->is_cache_active()) {
252
      $memcached->set('kohaconf',$koha);
238
        my $cache = Koha::Cache->new();
239
        $cache->set_in_cache('kohaconf', $koha) if defined $cache;
253
    }
240
    }
254
241
255
    return $koha;			# Return value: ref-to-hash holding the configuration
242
    return $koha;			# Return value: ref-to-hash holding the configuration
256
}
243
}
257
244
258
=head2 ismemcached
259
260
Returns the value of the $ismemcached variable (0/1)
261
262
=cut
263
264
sub ismemcached {
265
    return $ismemcached;
266
}
267
268
=head2 memcached
269
270
If $ismemcached is true, returns the $memcache variable.
271
Returns undef otherwise
272
273
=cut
274
275
sub memcached {
276
    if ($ismemcached) {
277
      return $memcached;
278
    } else {
279
      return undef;
280
    }
281
}
282
283
# db_scheme2dbi
245
# db_scheme2dbi
284
# Translates the full text name of a database into de appropiate dbi name
246
# Translates the full text name of a database into de appropiate dbi name
285
# 
247
# 
Lines 323-331 Allocates a new context. Initializes the context from the specified Link Here
323
file, which defaults to either the file given by the C<$KOHA_CONF>
285
file, which defaults to either the file given by the C<$KOHA_CONF>
324
environment variable, or F</etc/koha/koha-conf.xml>.
286
environment variable, or F</etc/koha/koha-conf.xml>.
325
287
326
It saves the koha-conf.xml values in the declared memcached server(s)
288
It saves the koha-conf.xml values in the cache (if configured) and uses
327
if currently available and uses those values until them expire and
289
those values until them expire and re-reads them.
328
re-reads them.
329
290
330
C<&new> does not set this context as the new default context; for
291
C<&new> does not set this context as the new default context; for
331
that, use C<&set_context>.
292
that, use C<&set_context>.
Lines 362-376 sub new { Link Here
362
        }
323
        }
363
    }
324
    }
364
    
325
    
365
    if ($ismemcached) {
326
    if (Koha::Cache->is_cache_active()) {
366
        # retreive from memcached
327
        # retrieve from cache
367
        $self = $memcached->get('kohaconf');
328
        my $cache = Koha::Cache->new();
368
        if (not defined $self) {
329
        $self = $cache->get_from_cache('kohaconf') if defined $cache;
369
            # not in memcached yet
330
        $self = { };
370
            $self = read_config_file($conf_fname);
331
    }
371
        }
332
    if (!keys %$self) {
372
    } else {
333
        # not cached yet
373
        # non-memcached env, read from file
374
        $self = read_config_file($conf_fname);
334
        $self = read_config_file($conf_fname);
375
    }
335
    }
376
336
(-)a/C4/Languages.pm (-11 / +27 lines)
Lines 23-41 use strict; Link Here
23
#use warnings; FIXME - Bug 2505
23
#use warnings; FIXME - Bug 2505
24
use Carp;
24
use Carp;
25
use C4::Context;
25
use C4::Context;
26
use Koha::Cache;
26
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
27
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
27
28
28
eval {
29
    if (C4::Context->ismemcached) {
30
        require Memoize::Memcached;
31
        import Memoize::Memcached qw(memoize_memcached);
32
33
        memoize_memcached('getTranslatedLanguages', memcached => C4::Context->memcached);
34
        memoize_memcached('getFrameworkLanguages' , memcached => C4::Context->memcached);
35
        memoize_memcached('getAllLanguages',        memcached => C4::Context->memcached);
36
    }
37
};
38
39
BEGIN {
29
BEGIN {
40
    $VERSION = 3.00;
30
    $VERSION = 3.00;
41
    require Exporter;
31
    require Exporter;
Lines 77-82 Returns a reference to an array of hashes: Link Here
77
=cut
67
=cut
78
68
79
sub getFrameworkLanguages {
69
sub getFrameworkLanguages {
70
71
    my $cache;
72
    if (Koha::Cache->is_cache_active()) {
73
        $cache = Koha::Cache->new();
74
        if (defined $cache) {
75
            my $cached = $cache->get_from_cache("getFrameworkLanguages");
76
            return $cached if $cached;
77
        }
78
    }
80
    # get a hash with all language codes, names, and locale names
79
    # get a hash with all language codes, names, and locale names
81
    my $all_languages = getAllLanguages();
80
    my $all_languages = getAllLanguages();
82
    my @languages;
81
    my @languages;
Lines 99-104 sub getFrameworkLanguages { Link Here
99
            }
98
            }
100
        }
99
        }
101
    }
100
    }
101
    if (Koha::Cache->is_cache_active() && defined $cache) {
102
        $cache->set_in_cache("getFrameworkLanguages",\@languages,10000)
103
    }
102
    return \@languages;
104
    return \@languages;
103
}
105
}
104
106
Lines 179-184 Returns a reference to an array of hashes: Link Here
179
=cut
181
=cut
180
182
181
sub getAllLanguages {
183
sub getAllLanguages {
184
    # retrieve from cache if applicable
185
    my $cache;
186
    if (Koha::Cache->is_cache_active()) {
187
        $cache = Koha::Cache->new();
188
        if (defined $cache) {
189
            my $cached = $cache->get_from_cache("getAllLanguages");
190
            if ($cached) {
191
                return $cached;
192
            }
193
        }
194
    }
182
    my @languages_loop;
195
    my @languages_loop;
183
    my $dbh=C4::Context->dbh;
196
    my $dbh=C4::Context->dbh;
184
    my $current_language = shift || 'en';
197
    my $current_language = shift || 'en';
Lines 213-218 sub getAllLanguages { Link Here
213
        }
226
        }
214
        push @languages_loop, $language_subtag_registry;
227
        push @languages_loop, $language_subtag_registry;
215
    }
228
    }
229
    if (Koha::Cache->is_cache_active() && defined $cache) {
230
        $cache->set_in_cache("getAllLanguages",\@languages_loop,1000);
231
    }
216
    return \@languages_loop;
232
    return \@languages_loop;
217
}
233
}
218
234
(-)a/C4/SQLHelper.pm (-21 / +32 lines)
Lines 24-49 use List::MoreUtils qw(first_value any); Link Here
24
use C4::Context;
24
use C4::Context;
25
use C4::Dates qw(format_date_in_iso);
25
use C4::Dates qw(format_date_in_iso);
26
use C4::Debug;
26
use C4::Debug;
27
use Koha::Cache;
27
require Exporter;
28
require Exporter;
28
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
29
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
29
30
30
eval {
31
    my $servers = C4::Context->config('memcached_servers');
32
    if ($servers) {
33
        require Memoize::Memcached;
34
        import Memoize::Memcached qw(memoize_memcached);
35
36
        my $memcached = {
37
            servers     => [$servers],
38
            key_prefix  => C4::Context->config('memcached_namespace') || 'koha',
39
            expire_time => 600
40
        };    # cache for 10 mins
41
42
        memoize_memcached( '_get_columns',   memcached => $memcached );
43
        memoize_memcached( 'GetPrimaryKeys', memcached => $memcached );
44
    }
45
};
46
47
BEGIN {
31
BEGIN {
48
	# set the version for version checking
32
	# set the version for version checking
49
	$VERSION = 0.5;
33
	$VERSION = 0.5;
Lines 236-242 sub DeleteInTable{ Link Here
236
   		my $result;
220
   		my $result;
237
    	eval{$result=$sth->execute(@$values)}; 
221
    	eval{$result=$sth->execute(@$values)}; 
238
		warn $@ if ($@ && $debug);
222
		warn $@ if ($@ && $debug);
239
    	return $result;
223
        return $result;
240
	}
224
	}
241
}
225
}
242
226
Lines 250-257 Get the Primary Key field names of the table Link Here
250
234
251
sub GetPrimaryKeys($) {
235
sub GetPrimaryKeys($) {
252
	my $tablename=shift;
236
	my $tablename=shift;
253
	my $hash_columns=_get_columns($tablename);
237
    my $result;
254
	return  grep { $hash_columns->{$_}->{'Key'} =~/PRI/i}  keys %$hash_columns;
238
    my $cache;
239
    if (Koha::Cache->is_cache_active()) {
240
        $cache = Koha::Cache->new();
241
        if (defined $cache) {
242
            $result = $cache->get_from_cache("sqlhelper:GetPrimaryKeys:$tablename");
243
        }
244
    }
245
    unless (defined $result) {
246
        my $hash_columns=_get_columns($tablename);
247
        $result = grep { $hash_columns->{$_}->{'Key'} =~/PRI/i}  keys %$hash_columns;
248
        if (Koha::Cache->is_cache_active() && defined $cache) {
249
            $cache->set_in_cache("sqlhelper:GetPrimaryKeys:$tablename", $result);
250
        }
251
    }
252
    return $result;
255
}
253
}
256
254
257
255
Lines 286-297 With Link Here
286
284
287
sub _get_columns($) {
285
sub _get_columns($) {
288
    my ($tablename) = @_;
286
    my ($tablename) = @_;
289
    unless ( exists( $hashref->{$tablename} ) ) {
287
    my $cache;
288
    if ( exists( $hashref->{$tablename} ) ) {
289
        return $hashref->{$tablename};
290
    }
291
    if (Koha::Cache->is_cache_active()) {
292
        $cache = Koha::Cache->new();
293
        if (defined $cache) {
294
            $hashref->{$tablename} = $cache->get_from_cache("sqlhelper:_get_columns:$tablename");
295
        }
296
    }
297
    unless ( defined $hashref->{$tablename}  ) {
290
        my $dbh = C4::Context->dbh;
298
        my $dbh = C4::Context->dbh;
291
        my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
299
        my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
292
        $sth->execute;
300
        $sth->execute;
293
        my $columns = $sth->fetchall_hashref(qw(Field));
301
        my $columns = $sth->fetchall_hashref(qw(Field));
294
        $hashref->{$tablename} = $columns;
302
        $hashref->{$tablename} = $columns;
303
        if (Koha::Cache->is_cache_active() && defined $cache) {
304
            $cache->set_in_cache("sqlhelper:_get_columns:$tablename", $hashref->{$tablename});
305
        }
295
    }
306
    }
296
    return $hashref->{$tablename};
307
    return $hashref->{$tablename};
297
}
308
}
(-)a/Koha/Cache.pm (-1 / +1 lines)
Lines 64-70 sub new { Link Here
64
}
64
}
65
65
66
sub is_cache_active {
66
sub is_cache_active {
67
    return $ENV{CACHING_SYSTEM} ? '1' : '' ;
67
    return $ENV{CACHING_SYSTEM} ? '1' : undef ;
68
}
68
}
69
69
70
=head2 EXPORT
70
=head2 EXPORT
(-)a/reports/guided_reports.pl (-1 / +2 lines)
Lines 28-33 use C4::Output; Link Here
28
use C4::Dates;
28
use C4::Dates;
29
use C4::Debug;
29
use C4::Debug;
30
use C4::Branch; # XXX subfield_is_koha_internal_p
30
use C4::Branch; # XXX subfield_is_koha_internal_p
31
use Koha::Cache;
31
32
32
=head1 NAME
33
=head1 NAME
33
34
Lines 40-46 Script to control the guided report creation Link Here
40
=cut
41
=cut
41
42
42
my $input = new CGI;
43
my $input = new CGI;
43
my $usecache = C4::Context->ismemcached;
44
my $usecache = Koha::Cache->is_cache_active();
44
45
45
my $phase = $input->param('phase');
46
my $phase = $input->param('phase');
46
my $flagsrequired;
47
my $flagsrequired;
(-)a/t/Cache.t (-3 / +2 lines)
Lines 13-21 BEGIN { Link Here
13
}
13
}
14
14
15
SKIP: {
15
SKIP: {
16
    skip "Memcached not enabled", 7 unless C4::Context->ismemcached;
16
    skip "Memcached not enabled", 7 unless Koha::Cache->is_cache_active();
17
17
18
    my $cache = Koha::Cache->new ( { 'cache_servers' => $ENV{'MEMCACHED_SERVERS'} } );
18
    my $cache = Koha::Cache->new ();
19
19
20
    # test fetching an item that isnt in the cache
20
    # test fetching an item that isnt in the cache
21
    is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache");
21
    is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache");
22
- 

Return to bug 8089