1#!/usr/bin/perl
2#
3
4use strict;
5use lib '../../api/perl/lib';
6use Cache::Memcached;
7use Time::HiRes qw(time);
8
9unless (@ARGV == 2) {
10    die "Usage: stress-memcached.pl ip:port threads\n";
11}
12
13my $host = shift;
14my $threads = shift;
15
16my $memc = new Cache::Memcached;
17$memc->set_servers([$host]);
18
19unless ($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
26my $running = 0;
27while (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
43sub 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
96sub key {
97    my $n = shift;
98    $_ = sprintf("%04d", $n);
99    if ($n % 2) { $_ .= "a"x20; }
100    $_;
101}
102