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

(-)a/C4/Context.pm (-14 lines)
Lines 513-519 with this method. Link Here
513
=cut
513
=cut
514
514
515
my $syspref_cache = Koha::Cache->get_instance();
515
my $syspref_cache = Koha::Cache->get_instance();
516
my %syspref_L1_cache;
517
my $use_syspref_cache = 1;
516
my $use_syspref_cache = 1;
518
sub preference {
517
sub preference {
519
    my $self = shift;
518
    my $self = shift;
Lines 521-531 sub preference { Link Here
521
520
522
    $var = lc $var;
521
    $var = lc $var;
523
522
524
    # Return the value if the var has already been accessed
525
    if ($use_syspref_cache && exists $syspref_L1_cache{$var}) {
526
        return $syspref_L1_cache{$var};
527
    }
528
529
    my $cached_var = $use_syspref_cache
523
    my $cached_var = $use_syspref_cache
530
        ? $syspref_cache->get_from_cache("syspref_$var")
524
        ? $syspref_cache->get_from_cache("syspref_$var")
531
        : undef;
525
        : undef;
Lines 542-548 sub preference { Link Here
542
536
543
    if ( $use_syspref_cache ) {
537
    if ( $use_syspref_cache ) {
544
        $syspref_cache->set_in_cache("syspref_$var", $value);
538
        $syspref_cache->set_in_cache("syspref_$var", $value);
545
        $syspref_L1_cache{$var} = $value;
546
    }
539
    }
547
    return $value;
540
    return $value;
548
}
541
}
Lines 598-608 will not be seen by this process. Link Here
598
sub clear_syspref_cache {
591
sub clear_syspref_cache {
599
    return unless $use_syspref_cache;
592
    return unless $use_syspref_cache;
600
    $syspref_cache->flush_all;
593
    $syspref_cache->flush_all;
601
    clear_syspref_L1_cache()
602
}
603
604
sub clear_syspref_L1_cache {
605
    %syspref_L1_cache = ();
606
}
594
}
607
595
608
=head2 set_preference
596
=head2 set_preference
Lines 655-661 sub set_preference { Link Here
655
643
656
    if ( $use_syspref_cache ) {
644
    if ( $use_syspref_cache ) {
657
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
645
        $syspref_cache->set_in_cache( "syspref_$variable", $value );
658
        $syspref_L1_cache{$variable} = $value;
659
    }
646
    }
660
647
661
    return $syspref;
648
    return $syspref;
Lines 677-683 sub delete_preference { Link Here
677
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
664
    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
678
        if ( $use_syspref_cache ) {
665
        if ( $use_syspref_cache ) {
679
            $syspref_cache->clear_from_cache("syspref_$var");
666
            $syspref_cache->clear_from_cache("syspref_$var");
680
            delete $syspref_L1_cache{$var};
681
        }
667
        }
682
668
683
        return 1;
669
        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 lose -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