0
|
1 #!/usr/bin/perl
|
|
2 #
|
|
3
|
|
4 use strict;
|
|
5 use lib '../../api/perl/lib';
|
|
6 use Cache::Memcached;
|
|
7 use Time::HiRes qw(time);
|
|
8
|
|
9 unless (@ARGV == 2) {
|
|
10 die "Usage: stress-memcached.pl ip:port threads\n";
|
|
11 }
|
|
12
|
|
13 my $host = shift;
|
|
14 my $threads = shift;
|
|
15
|
|
16 my $memc = new Cache::Memcached;
|
|
17 $memc->set_servers([$host]);
|
|
18
|
|
19 unless ($memc->set("foo", "bar") &&
|
|
20 $memc->get("foo") eq "bar") {
|
|
21 die "memcached not running at $host ?\n";
|
|
22 }
|
|
23 $memc->disconnect_all();
|
|
24
|
|
25
|
|
26 my $running = 0;
|
|
27 while (1) {
|
|
28 if ($running < $threads) {
|
|
29 my $cpid = fork();
|
|
30 if ($cpid) {
|
|
31 $running++;
|
|
32 #print "Launched $cpid. Running $running threads.\n";
|
|
33 } else {
|
|
34 stress();
|
|
35 exit 0;
|
|
36 }
|
|
37 } else {
|
|
38 wait();
|
|
39 $running--;
|
|
40 }
|
|
41 }
|
|
42
|
|
43 sub stress {
|
|
44 undef $memc;
|
|
45 $memc = new Cache::Memcached;
|
|
46 $memc->set_servers([$host]);
|
|
47
|
|
48 my ($t1, $t2);
|
|
49 my $start = sub { $t1 = time(); };
|
|
50 my $stop = sub {
|
|
51 my $op = shift;
|
|
52 $t2 = time();
|
|
53 my $td = sprintf("%0.3f", $t2 - $t1);
|
|
54 if ($td > 0.25) { print "Took $td seconds for: $op\n"; }
|
|
55 };
|
|
56
|
|
57 my $max = rand(50);
|
|
58 my $sets = 0;
|
|
59
|
|
60 for (my $i = 0; $i < $max; $i++) {
|
|
61 my $key = key($i);
|
|
62 my $set = $memc->set($key, $key);
|
|
63 $sets++ if $set;
|
|
64 }
|
|
65
|
|
66 for (1..int(rand(500))) {
|
|
67 my $rand = int(rand($max));
|
|
68 my $key = key($rand);
|
|
69 my $meth = int(rand(3));
|
|
70 my $exp = int(rand(3));
|
|
71 undef $exp unless $exp;
|
|
72 $start->();
|
|
73 if ($meth == 0) {
|
|
74 $memc->add($key, $key, $exp);
|
|
75 $stop->("add");
|
|
76 } elsif ($meth == 1) {
|
|
77 $memc->delete($key);
|
|
78 $stop->("delete");
|
|
79 } else {
|
|
80 $memc->set($key, $key, $exp);
|
|
81 $stop->("set");
|
|
82 }
|
|
83 $rand = int(rand($max));
|
|
84 $key = key($rand);
|
|
85 $start->();
|
|
86 my $v = $memc->get($key);
|
|
87 $stop->("get");
|
|
88 if ($v && $v ne $key) { die "Bogus: $v for key $rand\n"; }
|
|
89 }
|
|
90
|
|
91 $start->();
|
|
92 my $multi = $memc->get_multi(map { key(int(rand($max))) } (1..$max));
|
|
93 $stop->("get_multi");
|
|
94 }
|
|
95
|
|
96 sub key {
|
|
97 my $n = shift;
|
|
98 $_ = sprintf("%04d", $n);
|
|
99 if ($n % 2) { $_ .= "a"x20; }
|
|
100 $_;
|
|
101 }
|