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

(-)a/t/02-memcached.t (-1 / +102 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use strict;
4
use warnings;
5
6
use Koha::Caches;
7
use Test::More tests => 1;
8
use Cache::Memcached::Fast;
9
use IO::Select;
10
11
my $cache = Koha::Caches->get_instance('syspref');
12
13
my $map = {
14
    'syspref_timeout' => '1d',
15
    'syspref_independentbranches' => '0',
16
    'syspref_version' => '18.1101000'
17
};
18
#Set keys for test
19
foreach my $key ( keys %$map ){
20
    $cache->set_in_cache($key,$map->{$key});
21
}
22
23
my @children = ();
24
my $select = IO::Select->new();
25
for ( 1..10 ){
26
    my ($read_child,$write_parent);
27
    pipe($read_child,$write_parent);
28
    my $pid = fork;
29
    if ($pid == 0){
30
        close($read_child);
31
        my $a_problems = check_cache({
32
            keys => ["syspref_version","syspref_timeout","syspref_independentbranches"],
33
            iterations => int(rand(50)),
34
        });
35
        my $b_problems = check_cache({
36
            keys => ["syspref_version","syspref_timeout","syspref_independentbranches"],
37
            iterations => int(rand(50)),
38
        });
39
        my $c_problems = check_cache({
40
            keys => ["syspref_version","syspref_timeout","syspref_independentbranches"],
41
            iterations => int(rand(50)),
42
        });
43
        my $total_problems = $a_problems + $b_problems + $c_problems;
44
45
        print $write_parent "$total_problems\n";
46
        close($write_parent);
47
        exit;
48
    }
49
    else {
50
        close($write_parent);
51
        $select->add($read_child);
52
        push(@children,$pid);
53
    }
54
}
55
56
my $problems = 0;
57
while ( my @ready = $select->can_read(.25) ){
58
    foreach my $fh (@ready){
59
        my $msg = <$fh>;
60
        if ($msg){
61
            chomp($msg);
62
            $problems += $msg;
63
            $select->remove($fh);
64
            $fh->close;
65
        }
66
    }
67
}
68
69
foreach my $child (@children){
70
    waitpid($child,0);
71
}
72
warn "Finished $problems\n";
73
is($problems,0,"There should be no problems reported.");
74
75
sub check_cache {
76
    my ($args) = @_;
77
    my $problems = 0;
78
    my $keys = $args->{keys};
79
    my $iterations = $args->{iterations};
80
    if ($keys && defined $iterations){
81
        $iterations++;
82
        for ( 1 .. $iterations ){
83
            my $index = int(rand(3));
84
            my $key = $keys->[$index];
85
            my $cached_value = $cache->get_from_cache($key);
86
            Koha::Caches->flush_L1_caches();
87
            my $problem = "";
88
            if ( ! defined $cached_value ){
89
                $cached_value = 'NULL';
90
                $problem = 1;
91
            }
92
            elsif ($cached_value ne $map->{$key}){
93
                $problem = 1;
94
            }
95
            if ($problem){
96
                $problems++;
97
                warn "Process:$$\t Key: $key\t Correct value: $map->{$key}\t Cached value: $cached_value\n";
98
            }
99
        }
100
    }
101
    return $problems;
102
}

Return to bug 13193