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

(-)a/C4/Context.pm (-100 / +7 lines)
Lines 103-108 use XML::Simple; Link Here
103
use C4::Boolean;
103
use C4::Boolean;
104
use C4::Debug;
104
use C4::Debug;
105
use C4::Log qw/ logaction /;
105
use C4::Log qw/ logaction /;
106
use Koha::Cache;
106
use POSIX ();
107
use POSIX ();
107
use DateTime::TimeZone;
108
use DateTime::TimeZone;
108
use Module::Load::Conditional qw(can_load);
109
use Module::Load::Conditional qw(can_load);
Lines 518-584 sub ModZebrations { Link Here
518
	return _common_config($_[1],'serverinfo');
519
	return _common_config($_[1],'serverinfo');
519
}
520
}
520
521
521
=head2 _cache_preference($variable, [$value])
522
523
  _cache_preference('opacusercss', $css);
524
  my $val = _cache_preference('opacusercss');
525
526
An interface into the syspref caching. One argument to get a value, two to set
527
it. The single argument version will return C<undef> if the cache doesn't
528
contain the value. If the second argument is C<undef>, then the cache will be
529
cleared of that value.
530
531
The cache timeout length is 30 seconds when memcache is not in use. When
532
memcache is in use, it uses the default cache time for that.
533
534
=cut
535
536
my %syspref_cache;
537
my $use_syspref_cache = 1;
538
539
sub _cache_preference {
540
    return undef unless $use_syspref_cache;
541
    my $memcached        = memcached();
542
    my $memcached_prefix = "_syspref_";
543
    if ( scalar(@_) == 1 ) {
544
        # This means we want to fetch from the cache
545
        my ($var) = @_;
546
        if ($memcached) {
547
            my $val = $memcached->get( $memcached_prefix . lc($var) );
548
            return $val;
549
        }
550
        else {
551
            my $now          = time;
552
            my $cache_oldest = $now - 30;
553
            return undef unless exists $syspref_cache{ lc $var };
554
            my $val = $syspref_cache{ lc $var };
555
            return undef unless $val->[0] > $cache_oldest;
556
            return $val->[1];
557
        }
558
    }
559
    elsif ( scalar(@_) == 2 ) {
560
        # Set something in the cache
561
        my ( $var, $val ) = @_;
562
        if ($memcached) {
563
            if ( !defined($val) ) {
564
                $memcached->delete( $memcached_prefix . lc($var) );
565
            }
566
            else {
567
                $memcached->set( $memcached_prefix . lc($var), $val );
568
            }
569
        }
570
        else {
571
            if ( !defined($val) ) {
572
                delete $syspref_cache{ lc $var };
573
                return;
574
            }
575
            $syspref_cache{ lc $var } = [ time, $val ];
576
        }
577
    } else {
578
        confess "Invalid arguments to _cache_preference: " . join(', ', @_);
579
    }
580
}
581
582
=head2 preference
522
=head2 preference
583
523
584
  $sys_preference = C4::Context->preference('some_variable');
524
  $sys_preference = C4::Context->preference('some_variable');
Lines 595-605 with this method. Link Here
595
535
596
=cut
536
=cut
597
537
538
my $syspref_cache = Koha::Cache->get_instance();
598
sub preference {
539
sub preference {
599
    my $self = shift;
540
    my $self = shift;
600
    my $var  = shift;    # The system preference to return
541
    my $var  = shift;    # The system preference to return
601
542
602
    my $cached_var = _cache_preference($var);
543
    my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
603
    return $cached_var if defined $cached_var;
544
    return $cached_var if defined $cached_var;
604
545
605
    my $dbh  = C4::Context->dbh or return 0;
546
    my $dbh  = C4::Context->dbh or return 0;
Lines 618-624 sub preference { Link Here
618
        $value = $dbh->selectrow_array( $sql, {}, lc $var );
559
        $value = $dbh->selectrow_array( $sql, {}, lc $var );
619
    }
560
    }
620
561
621
    _cache_preference($var, $value);
562
    $syspref_cache->set_in_cache("syspref_$var", $value);
622
    return $value;
563
    return $value;
623
}
564
}
624
565
Lines 629-663 sub boolean_preference { Link Here
629
    return defined($it)? C4::Boolean::true_p($it): undef;
570
    return defined($it)? C4::Boolean::true_p($it): undef;
630
}
571
}
631
572
632
=head2 enable_syspref_cache
633
634
  C4::Context->enable_syspref_cache();
635
636
Enable the in-memory syspref cache used by C4::Context. This is the
637
default behavior.
638
639
=cut
640
641
sub enable_syspref_cache {
642
    my ($self) = @_;
643
    $use_syspref_cache = 1;
644
}
645
646
=head2 disable_syspref_cache
647
648
  C4::Context->disable_syspref_cache();
649
650
Disable the in-memory syspref cache used by C4::Context. This should be
651
used with Plack and other persistent environments.
652
653
=cut
654
655
sub disable_syspref_cache {
656
    my ($self) = @_;
657
    $use_syspref_cache = 0;
658
    $self->clear_syspref_cache();
659
}
660
661
=head2 clear_syspref_cache
573
=head2 clear_syspref_cache
662
574
663
  C4::Context->clear_syspref_cache();
575
  C4::Context->clear_syspref_cache();
Lines 669-679 will not be seen by this process. Link Here
669
=cut
581
=cut
670
582
671
sub clear_syspref_cache {
583
sub clear_syspref_cache {
672
    %syspref_cache= ();
584
    $syspref_cache->flush_all;
673
    # It doesn't seem to be possible to list all the keys via Cache::Memcached
674
    # so we'll clear the whole cache.
675
    my $memcached = memcached();
676
    $memcached->flush_all if $memcached;
677
}
585
}
678
586
679
=head2 set_preference
587
=head2 set_preference
Lines 719-725 ON DUPLICATE KEY UPDATE value = VALUES(value)'; Link Here
719
    }
627
    }
720
    my $sth = $dbh->prepare($query);
628
    my $sth = $dbh->prepare($query);
721
    if ( $sth->execute(@params) ) {
629
    if ( $sth->execute(@params) ) {
722
        _cache_preference($var, $value);
630
        $syspref_cache->set_in_cache("syspref_$var", $value);
723
        logaction( 'SYSTEMPREFERENCE', $logtype, undef, $var . " | " . $value );
631
        logaction( 'SYSTEMPREFERENCE', $logtype, undef, $var . " | " . $value );
724
    }
632
    }
725
    $sth->finish;
633
    $sth->finish;
Lines 744-750 sub delete_preference { Link Here
744
    my $sth = $dbh->prepare("DELETE FROM systempreferences WHERE variable=?");
652
    my $sth = $dbh->prepare("DELETE FROM systempreferences WHERE variable=?");
745
    my $res = $sth->execute($var);
653
    my $res = $sth->execute($var);
746
    if ($res) {
654
    if ($res) {
747
        _cache_preference($var, undef);
655
        $syspref_cache->clear_from_cache("syspref_$var");
748
        logaction( 'SYSTEMPREFERENCE', 'DELETE', undef,
656
        logaction( 'SYSTEMPREFERENCE', 'DELETE', undef,
749
            $var . " | " . ( $val // 'undefined' ) );
657
            $var . " | " . ( $val // 'undefined' ) );
750
        return 1;
658
        return 1;
751
- 

Return to bug 11998