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

(-)a/C4/Context.pm (-14 lines)
Lines 505-511 with this method. Link Here
505
=cut
505
=cut
506
506
507
my $syspref_cache = Koha::Cache->get_instance();
507
my $syspref_cache = Koha::Cache->get_instance();
508
my %syspref_L1_cache;
509
my $use_syspref_cache = 1;
508
my $use_syspref_cache = 1;
510
sub preference {
509
sub preference {
511
    my $self = shift;
510
    my $self = shift;
Lines 513-523 sub preference { Link Here
513
512
514
    $var = lc $var;
513
    $var = lc $var;
515
514
516
    # Return the value if the var has already been accessed
517
    if ($use_syspref_cache && exists $syspref_L1_cache{$var}) {
518
        return $syspref_L1_cache{$var};
519
    }
520
521
    my $cached_var = $use_syspref_cache
515
    my $cached_var = $use_syspref_cache
522
        ? $syspref_cache->get_from_cache("syspref_$var")
516
        ? $syspref_cache->get_from_cache("syspref_$var")
523
        : undef;
517
        : undef;
Lines 534-540 sub preference { Link Here
534
528
535
    if ( $use_syspref_cache ) {
529
    if ( $use_syspref_cache ) {
536
        $syspref_cache->set_in_cache("syspref_$var", $value);
530
        $syspref_cache->set_in_cache("syspref_$var", $value);
537
        $syspref_L1_cache{$var} = $value;
538
    }
531
    }
539
    return $value;
532
    return $value;
540
}
533
}
Lines 590-600 will not be seen by this process. Link Here
590
sub clear_syspref_cache {
583
sub clear_syspref_cache {
591
    return unless $use_syspref_cache;
584
    return unless $use_syspref_cache;
592
    $syspref_cache->flush_all;
585
    $syspref_cache->flush_all;
593
    clear_syspref_L1_cache()
594
}
595
596
sub clear_syspref_L1_cache {
597
    %syspref_L1_cache = ();
598
}
586
}
599
587
600
=head2 set_preference
588
=head2 set_preference
Lines 647-653 sub set_preference { Link Here
647
635
648
    if ( $use_syspref_cache ) {
636
    if ( $use_syspref_cache ) {
649
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
637
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
650
        $syspref_L1_cache{$variable} = $value;
651
    }
638
    }
652
639
653
    return $syspref;
640
    return $syspref;
Lines 669-675 sub delete_preference { Link Here
669
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
656
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
670
        if ( $use_syspref_cache ) {
657
        if ( $use_syspref_cache ) {
671
            $syspref_cache->clear_from_cache("syspref_$var");
658
            $syspref_cache->clear_from_cache("syspref_$var");
672
            delete $syspref_L1_cache{$var};
673
        }
659
        }
674
660
675
        return 1;
661
        return 1;
(-)a/Koha/Cache.pm (+22 lines)
Lines 46-51 use base qw(Class::Accessor); Link Here
46
__PACKAGE__->mk_ro_accessors(
46
__PACKAGE__->mk_ro_accessors(
47
    qw( cache memcached_cache fastmmap_cache memory_cache ));
47
    qw( cache memcached_cache fastmmap_cache memory_cache ));
48
48
49
our %L1_cache;
50
49
=head2 get_instance
51
=head2 get_instance
50
52
51
    my $cache = Koha::Cache->get_instance();
53
    my $cache = Koha::Cache->get_instance();
Lines 277-282 sub set_in_cache { Link Here
277
    my $expiry = $options->{expiry};
279
    my $expiry = $options->{expiry};
278
    $expiry //= $self->{timeout};
280
    $expiry //= $self->{timeout};
279
    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
281
    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
282
283
    # Set in L1 cache
284
    $L1_cache{ $key } = $value;
285
280
    # We consider an expiry of 0 to be inifinite
286
    # We consider an expiry of 0 to be inifinite
281
    if ( $expiry ) {
287
    if ( $expiry ) {
282
        return $set_sub
288
        return $set_sub
Lines 305-310 sub get_from_cache { Link Here
305
    croak "No key" unless $key;
311
    croak "No key" unless $key;
306
    $ENV{DEBUG} && carp "get_from_cache for $key";
312
    $ENV{DEBUG} && carp "get_from_cache for $key";
307
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
313
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
314
315
    # Return L1 cache value if exists
316
    return $L1_cache{$key} if exists $L1_cache{$key};
317
308
    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
318
    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
309
    return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
319
    return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
310
}
320
}
Lines 323-328 sub clear_from_cache { Link Here
323
    $cache ||= 'cache';
333
    $cache ||= 'cache';
324
    croak "No key" unless $key;
334
    croak "No key" unless $key;
325
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
335
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
336
337
    # Clear from L1 cache
338
    delete $L1_cache{$key};
339
326
    return $self->{$cache}->delete($key)
340
    return $self->{$cache}->delete($key)
327
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
341
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
328
    return $self->{$cache}->remove($key);
342
    return $self->{$cache}->remove($key);
Lines 340-350 sub flush_all { Link Here
340
    my ( $self, $cache ) = shift;
354
    my ( $self, $cache ) = shift;
341
    $cache ||= 'cache';
355
    $cache ||= 'cache';
342
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
356
    return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
357
358
    $self->flush_L1_cache();
359
343
    return $self->{$cache}->flush_all()
360
    return $self->{$cache}->flush_all()
344
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
361
      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
345
    return $self->{$cache}->clear();
362
    return $self->{$cache}->clear();
346
}
363
}
347
364
365
sub flush_L1_cache {
366
    my( $self ) = @_;
367
    %L1_cache = ();
368
}
369
348
=head1 TIED INTERFACE
370
=head1 TIED INTERFACE
349
371
350
Koha::Cache also provides a tied interface which enables users to provide a
372
Koha::Cache also provides a tied interface which enables users to provide a
(-)a/debian/templates/plack.psgi (-1 / +1 lines)
Lines 44-50 use CGI qw(-utf8 ); # we will loose -utf8 under plack, otherwise Link Here
44
    *CGI::new = sub {
44
    *CGI::new = sub {
45
        my $q = $old_new->( @_ );
45
        my $q = $old_new->( @_ );
46
        $CGI::PARAM_UTF8 = 1;
46
        $CGI::PARAM_UTF8 = 1;
47
        C4::Context->clear_syspref_L1_cache();
47
        Koha::Cache->flush_L1_cache();
48
        return $q;
48
        return $q;
49
    };
49
    };
50
}
50
}
(-)a/misc/plack/koha.psgi (-2 / +2 lines)
Lines 12-18 use CGI qw(-utf8 ); # we will loose -utf8 under plack Link Here
12
    *CGI::new = sub {
12
    *CGI::new = sub {
13
        my $q = $old_new->( @_ );
13
        my $q = $old_new->( @_ );
14
        $CGI::PARAM_UTF8 = 1;
14
        $CGI::PARAM_UTF8 = 1;
15
        C4::Context->clear_syspref_L1_cache();
15
        Koha::Cache->flush_L1_cache();
16
        return $q;
16
        return $q;
17
    };
17
    };
18
}
18
}
Lines 45-50 use C4::XSLT; Link Here
45
use C4::Branch;
45
use C4::Branch;
46
use C4::Category;
46
use C4::Category;
47
use Koha::DateUtils;
47
use Koha::DateUtils;
48
use Koha::Cache;
48
=for preload
49
=for preload
49
use C4::Tags; # FIXME
50
use C4::Tags; # FIXME
50
=cut
51
=cut
51
- 

Return to bug 16044