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

(-)a/C4/Koha.pm (-14 / +14 lines)
Lines 1013-1018 C<$opac> If set to a true value, displays OPAC descriptions rather than normal o Link Here
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
(-)a/Koha/Cache.pm (-1 / +25 lines)
Lines 41-46 use Carp; Link Here
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
(-)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
        Koha::Cache->flush_L1_cache();
47
        Koha::Cache->flush_L1_if_needed();
48
        return $q;
48
        return $q;
49
    };
49
    };
50
}
50
}
(-)a/misc/plack/koha.psgi (-2 / +1 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
        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