|
Line 0
Link Here
|
| 0 |
- |
1 |
#!/usr/bin/perl |
|
|
2 |
|
| 3 |
use strict; |
| 4 |
use warnings; |
| 5 |
|
| 6 |
use Test::More tests => 1; |
| 7 |
use Cache::Memcached::Fast; |
| 8 |
use IO::Select; |
| 9 |
|
| 10 |
my $cache = Cache::Memcached::Fast->new({ |
| 11 |
servers => ["localhost:11211"], |
| 12 |
}); |
| 13 |
my $map = { |
| 14 |
akey => '100', |
| 15 |
bkey => 'hundred', |
| 16 |
ckey => 'cent', |
| 17 |
}; |
| 18 |
#Add keys for test |
| 19 |
foreach my $key ( keys %$map ){ |
| 20 |
$cache->add($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 |
key => "akey", |
| 33 |
iterations => int(rand(50)), |
| 34 |
}); |
| 35 |
my $b_problems = check_cache({ |
| 36 |
key => "bkey", |
| 37 |
iterations => int(rand(50)), |
| 38 |
}); |
| 39 |
my $c_problems = check_cache({ |
| 40 |
key => "ckey", |
| 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 |
#Delete keys that were added |
| 73 |
foreach my $key ( keys %$map ){ |
| 74 |
$cache->delete($key); |
| 75 |
} |
| 76 |
warn "Finished $problems\n"; |
| 77 |
is($problems,0,"There should be no problems reported."); |
| 78 |
|
| 79 |
sub check_cache { |
| 80 |
my ($args) = @_; |
| 81 |
my $problems = 0; |
| 82 |
my $key = $args->{key}; |
| 83 |
my $iterations = $args->{iterations}; |
| 84 |
if ($key && defined $iterations){ |
| 85 |
$iterations++; |
| 86 |
#warn "$$) Fetching $key $iterations times\n"; |
| 87 |
for ( 1 .. $iterations ){ |
| 88 |
my $cached_value = $cache->get($key); |
| 89 |
my $problem = ""; |
| 90 |
if ( ! defined $cached_value ){ |
| 91 |
$cached_value = 'NULL'; |
| 92 |
$problem = 1; |
| 93 |
} |
| 94 |
elsif ($cached_value ne $map->{$key}){ |
| 95 |
$problem = 1; |
| 96 |
} |
| 97 |
if ($problem){ |
| 98 |
$problems++; |
| 99 |
warn "Process:$$\t Key: $key\t Correct value: $map->{$key}\t Cached value: $cached_value\n"; |
| 100 |
} |
| 101 |
} |
| 102 |
} |
| 103 |
return $problems; |
| 104 |
} |