Attachment #32874 for bug #11998

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




use C4::Boolean;
use C4::Debug;
use C4::Log qw/ logaction /;
use Koha::Cache;
use POSIX ();
use DateTime::TimeZone;
use Module::Load::Conditional qw(can_load);

            return;
        }
    }

    if ($ismemcached) {
        # retreive from memcached
        $self = $memcached->get('kohaconf');

	return _common_config($_[1],'serverinfo');
}

=head2 _cache_preference($variable, [$value])

  _cache_preference('opacusercss', $css);
  my $val = _cache_preference('opacusercss');

An interface into the syspref caching. One argument to get a value, two to set
it. The single argument version will return C<undef> if the cache doesn't
contain the value. If the second argument is C<undef>, then the cache will be
cleared of that value.

The cache timeout length is 30 seconds when memcache is not in use. When
memcache is in use, it uses the default cache time for that.

=cut

my %syspref_cache;
my $use_syspref_cache = 1;

sub _cache_preference {
    return undef unless $use_syspref_cache;
    my $memcached        = memcached();
    my $memcached_prefix = "_syspref_";
    if ( scalar(@_) == 1 ) {
        # This means we want to fetch from the cache
        my ($var) = @_;
        if ($memcached) {
            my $val = $memcached->get( $memcached_prefix . lc($var) );
            return $val;
        }
        else {
            my $now          = time;
            my $cache_oldest = $now - 30;
            return undef unless exists $syspref_cache{ lc $var };
            my $val = $syspref_cache{ lc $var };
            return undef unless $val->[0] > $cache_oldest;
            return $val->[1];
        }
    }
    elsif ( scalar(@_) == 2 ) {
        # Set something in the cache
        my ( $var, $val ) = @_;
        if ($memcached) {
            if ( !defined($val) ) {
                $memcached->delete( $memcached_prefix . lc($var) );
            }
            else {
                $memcached->set( $memcached_prefix . lc($var), $val );
            }
        }
        else {
            if ( !defined($val) ) {
                delete $syspref_cache{ lc $var };
                return;
            }
            $syspref_cache{ lc $var } = [ time, $val ];
        }
    } else {
        confess "Invalid arguments to _cache_preference: " . join(', ', @_);
    }
}

=head2 preference

  $sys_preference = C4::Context->preference('some_variable');


=cut

my $syspref_cache = Koha::Cache->get_instance();
my $use_syspref_cache = 1;
sub preference {
    my $self = shift;
    my $var  = shift;    # The system preference to return

    my $cached_var = $syspref_cache->get_from_cache("syspref_$var") if $use_syspref_cache;
    return $cached_var if defined $cached_var;

    my $dbh  = C4::Context->dbh or return 0;

        $value = $dbh->selectrow_array( $sql, {}, lc $var );
    }

    $syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache;
    return $value;
}


=cut

sub clear_syspref_cache {
    $syspref_cache->flush_all if $use_syspref_cache;
    # It doesn't seem to be possible to list all the keys via Cache::Memcached
    # so we'll clear the whole cache.
    my $memcached = memcached();
    $memcached->flush_all if $memcached;
}

=head2 set_preference

    }
    my $sth = $dbh->prepare($query);
    if ( $sth->execute(@params) ) {
        $syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache;
        logaction( 'SYSTEMPREFERENCE', $logtype, undef, $var . " | " . $value );
    }
    $sth->finish;

    my $sth = $dbh->prepare("DELETE FROM systempreferences WHERE variable=?");
    my $res = $sth->execute($var);
    if ($res) {
        $syspref_cache->clear_from_cache("syspref_$var") if $use_syspref_cache;
        logaction( 'SYSTEMPREFERENCE', 'DELETE', undef,
            $var . " | " . ( $val // 'undefined' ) );
        return 1;

Lines 55-60 my $borrower = { Link Here

(-)a/t/db_dependent/Circulation.t (+1 lines)
55	};	55	};
56		56
57	# No userenv, PickupLibrary	57	# No userenv, PickupLibrary
		58	C4::Context->disable_syspref_cache();
58	C4::Context->set_preference('CircControl', 'PickupLibrary');	59	C4::Context->set_preference('CircControl', 'PickupLibrary');
59	is(	60	is(
60	C4::Context->preference('CircControl'),	61	C4::Context->preference('CircControl'),

Lines 53-58 $module->mock( Link Here

(-)a/t/db_dependent/Context.t (+1 lines)
53	);	53	);
54		54
55	my $history;	55	my $history;
		56	C4::Context->disable_syspref_cache();
56	$dbh = C4::Context->dbh({ new => 1 });	57	$dbh = C4::Context->dbh({ new => 1 });
57		58
58	$dbh->{mock_add_resultset} = [ ['value'], ['thing1'] ];	59	$dbh->{mock_add_resultset} = [ ['value'], ['thing1'] ];

Lines 23-28 use warnings; Link Here

(-)a/t/db_dependent/check_sysprefs.t (-1 / +1 lines)
23	use Getopt::Long;	23	use Getopt::Long;
24	use C4::Context;	24	use C4::Context;
25		25
		26	C4::Context->disable_syspref_cache();
26	# When this option is set, no tests are performed.	27	# When this option is set, no tests are performed.
27	# The missing sysprefs are displayed as sql inserts instead.	28	# The missing sysprefs are displayed as sql inserts instead.
28	our $showsql = 0;	29	our $showsql = 0;
29	-

Return to bug 11998

Lines 103-108 use XML::Simple; Link Here

(-)a/C4/Context.pm (-71 / +9 lines)
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 375-381 sub new { Link Here
375	return;	376	return;
376	}	377	}
377	}	378	}
378		379
379	if ($ismemcached) {	380	if ($ismemcached) {
380	# retreive from memcached	381	# retreive from memcached
381	$self = $memcached->get('kohaconf');	382	$self = $memcached->get('kohaconf');
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();
		539	my $use_syspref_cache = 1;
598	sub preference {	540	sub preference {
599	my $self = shift;	541	my $self = shift;
600	my $var = shift; # The system preference to return	542	my $var = shift; # The system preference to return
601		543
602	my $cached_var = _cache_preference($var);	544	my $cached_var = $syspref_cache->get_from_cache("syspref_$var") if $use_syspref_cache;
603	return $cached_var if defined $cached_var;	545	return $cached_var if defined $cached_var;
604		546
605	my $dbh = C4::Context->dbh or return 0;	547	my $dbh = C4::Context->dbh or return 0;
Lines 618-624 sub preference { Link Here
618	$value = $dbh->selectrow_array( $sql, {}, lc $var );	560	$value = $dbh->selectrow_array( $sql, {}, lc $var );
619	}	561	}
620		562
621	_cache_preference($var, $value);	563	$syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache;
622	return $value;	564	return $value;
623	}	565	}
624		566
Lines 669-679 will not be seen by this process. Link Here
669	=cut	611	=cut
670		612
671	sub clear_syspref_cache {	613	sub clear_syspref_cache {
672	%syspref_cache= ();	614	$syspref_cache->flush_all if $use_syspref_cache;
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	}	615	}
678		616
679	=head2 set_preference	617	=head2 set_preference
Lines 719-725 ON DUPLICATE KEY UPDATE value = VALUES(value)'; Link Here
719	}	657	}
720	my $sth = $dbh->prepare($query);	658	my $sth = $dbh->prepare($query);
721	if ( $sth->execute(@params) ) {	659	if ( $sth->execute(@params) ) {
722	_cache_preference($var, $value);	660	$syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache;
723	logaction( 'SYSTEMPREFERENCE', $logtype, undef, $var . " \| " . $value );	661	logaction( 'SYSTEMPREFERENCE', $logtype, undef, $var . " \| " . $value );
724	}	662	}
725	$sth->finish;	663	$sth->finish;
Lines 744-750 sub delete_preference { Link Here
744	my $sth = $dbh->prepare("DELETE FROM systempreferences WHERE variable=?");	682	my $sth = $dbh->prepare("DELETE FROM systempreferences WHERE variable=?");
745	my $res = $sth->execute($var);	683	my $res = $sth->execute($var);
746	if ($res) {	684	if ($res) {
747	_cache_preference($var, undef);	685	$syspref_cache->clear_from_cache("syspref_$var") if $use_syspref_cache;
748	logaction( 'SYSTEMPREFERENCE', 'DELETE', undef,	686	logaction( 'SYSTEMPREFERENCE', 'DELETE', undef,
749	$var . " \| " . ( $val // 'undefined' ) );	687	$var . " \| " . ( $val // 'undefined' ) );
750	return 1;	688	return 1;