Attachment #49487 for bug #16140

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

Lines 1013-1018 C<$opac> If set to a true value, displays OPAC descriptions rather than normal o Link Here

(-)a/C4/Koha.pm (-14 / +14 lines)
1013		1013
1014	=cut	1014	=cut
1015		1015
		1016	sub _AddSelectedAuthVal {
		1017	my ( $authorised_values, $selected ) = @_;
		1018	foreach my $data ( @$authorised_values ) {
		1019	$data->{selected} = $selected eq $data->{authorised_value} ? 1 : 0;
		1020	}
		1021	}
		1022
1016	sub GetAuthorisedValues {	1023	sub GetAuthorisedValues {
1017	my ( $category, $selected, $opac ) = @_;	1024	my ( $category, $selected, $opac ) = @_;
1018		1025
Lines 1025-1036 sub GetAuthorisedValues { Link Here
1025	$opac = $opac ? 1 : 0; # normalise to be safe	1032	$opac = $opac ? 1 : 0; # normalise to be safe
1026	my $branch_limit =	1033	my $branch_limit =
1027	C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";	1034	C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1028	my $selected_key = defined($selected) ? $selected : '';
1029	my $cache_key =	1035	my $cache_key =
1030	"AuthorisedValues-$category-$selected_key-$opac-$branch_limit";	1036	"AuthorisedValues-$category-$opac-$branch_limit";
1031	my $cache = Koha::Cache->get_instance();	1037	my $cache = Koha::Cache->get_instance();
1032	my $result = $cache->get_from_cache($cache_key);	1038	my $result = $cache->get_from_cache($cache_key);
1033	return $result if $result;	1039	if ($result) {
		1040	_AddSelectedAuthVal( $result, $selected ) if defined $selected;
		1041	return $result;
		1042	}
1034		1043
1035	my @results;	1044	my @results;
1036	my $dbh = C4::Context->dbh;	1045	my $dbh = C4::Context->dbh;
Lines 1064-1076 sub GetAuthorisedValues { Link Here
1064		1073
1065	$sth->execute( @where_args );	1074	$sth->execute( @where_args );
1066	while (my $data=$sth->fetchrow_hashref) {	1075	while (my $data=$sth->fetchrow_hashref) {
1067	if ( defined $selected and $selected eq $data->{authorised_value} ) {
1068	$data->{selected} = 1;
1069	}
1070	else {
1071	$data->{selected} = 0;
1072	}
1073
1074	if ($opac && $data->{lib_opac}) {	1076	if ($opac && $data->{lib_opac}) {
1075	$data->{lib} = $data->{lib_opac};	1077	$data->{lib} = $data->{lib_opac};
1076	}	1078	}
Lines 1078-1087 sub GetAuthorisedValues { Link Here
1078	}	1080	}
1079	$sth->finish;	1081	$sth->finish;
1080		1082
1081	# We can't cache for long because of that "selected" thing which	1083	$cache->set_in_cache( $cache_key, \@results, { deepcopy => 1 } );
1082	# makes it impossible to clear the cache without iterating through every	1084	_AddSelectedAuthVal( \@results, $selected );
1083	# value, which sucks. This'll cover this request, and not a whole lot more.
1084	$cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
1085	return \@results;	1085	return \@results;
1086	}	1086	}
1087		1087




use Clone qw( clone );
use Module::Load::Conditional qw(can_load);
use Koha::Cache::Object;
use Time::HiRes qw(time);

use base qw(Class::Accessor);


    qw( cache memcached_cache fastmmap_cache memory_cache ));

our %L1_cache;
our $L1_cache_time;

=head2 get_instance


      $class;
}

sub flush_L1_if_needed {
    my ($self) = @_;

    if ( $self->{cache} ) {
        if ( $L1_cache_time ) {
            my $upstream_cache_mtime = $self->{cache}->get('upstream_cache_mtime');

            if ( $upstream_cache_mtime && $upstream_cache_mtime > $L1_cache_time ) {
                $self->flush_L1_cache();
            }
        }

        $L1_cache_time = time();
    }
}

sub _initialize_memcached {
    my ($self) = @_;
    my @servers =

    # Set in L1 cache
    $L1_cache{ $key } = $value;

    $self->{$cache}->set( 'upstream_cache_mtime', time() );

    # We consider an expiry of 0 to be inifinite
    if ( $expiry ) {
        return $set_sub

    }

    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
    my $value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);

    $L1_cache{$key} = $value;

    return $value;
}

=head2 clear_from_cache

Lines 44-50 use CGI qw(-utf8 ); # we will loose -utf8 under plack, otherwise Link Here

(-)a/debian/templates/plack.psgi (-1 / +1 lines)
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	Koha::Cache->flush_L1_cache();	47	Koha::Cache->flush_L1_if_needed();
48	return $q;	48	return $q;
49	};	49	};
50	}	50	}

Lines 12-18 use CGI qw(-utf8 ); # we will loose -utf8 under plack Link Here

(-)a/misc/plack/koha.psgi (-2 / +1 lines)
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	Koha::Cache->flush_L1_cache();	15	Koha::Cache->flush_L1_if_needed();
16	return $q;	16	return $q;
17	};	17	};
18	}	18	}
19	-

Return to bug 16140

Lines 41-46 use Carp; Link Here

(-)a/Koha/Cache.pm (-1 / +25 lines)
41	use Clone qw( clone );	41	use Clone qw( clone );
42	use Module::Load::Conditional qw(can_load);	42	use Module::Load::Conditional qw(can_load);
43	use Koha::Cache::Object;	43	use Koha::Cache::Object;
		44	use Time::HiRes qw(time);
44		45
45	use base qw(Class::Accessor);	46	use base qw(Class::Accessor);
46		47
Lines 48-53 __PACKAGE__->mk_ro_accessors( Link Here
48	qw( cache memcached_cache fastmmap_cache memory_cache ));	49	qw( cache memcached_cache fastmmap_cache memory_cache ));
49		50
50	our %L1_cache;	51	our %L1_cache;
		52	our $L1_cache_time;
51		53
52	=head2 get_instance	54	=head2 get_instance
53		55
Lines 131-136 sub new { Link Here
131	$class;	133	$class;
132	}	134	}
133		135
		136	sub flush_L1_if_needed {
		137	my ($self) = @_;
		138
		139	if ( $self->{cache} ) {
		140	if ( $L1_cache_time ) {
		141	my $upstream_cache_mtime = $self->{cache}->get('upstream_cache_mtime');
		142
		143	if ( $upstream_cache_mtime && $upstream_cache_mtime > $L1_cache_time ) {
		144	$self->flush_L1_cache();
		145	}
		146	}
		147
		148	$L1_cache_time = time();
		149	}
		150	}
		151
134	sub _initialize_memcached {	152	sub _initialize_memcached {
135	my ($self) = @_;	153	my ($self) = @_;
136	my @servers =	154	my @servers =
Lines 284-289 sub set_in_cache { Link Here
284	# Set in L1 cache	302	# Set in L1 cache
285	$L1_cache{ $key } = $value;	303	$L1_cache{ $key } = $value;
286		304
		305	$self->{$cache}->set( 'upstream_cache_mtime', time() );
		306
287	# We consider an expiry of 0 to be inifinite	307	# We consider an expiry of 0 to be inifinite
288	if ( $expiry ) {	308	if ( $expiry ) {
289	return $set_sub	309	return $set_sub
Lines 329-335 sub get_from_cache { Link Here
329	}	349	}
330		350
331	my $get_sub = $self->{ref($self->{$cache}) . "_get"};	351	my $get_sub = $self->{ref($self->{$cache}) . "_get"};
332	return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);	352	my $value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
		353
		354	$L1_cache{$key} = $value;
		355
		356	return $value;
333	}	357	}
334		358
335	=head2 clear_from_cache	359	=head2 clear_from_cache