init

wcmtools/memcached/test/stress-memcached.pl

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use lib '../api/perl';
+use MemCachedClient;
+use Time::HiRes qw(time);
+
+unless (@ARGV == 2) {
+    die "Usage: stress-memcached.pl ip:port threads\n";
+}
+
+my $host = shift;
+my $threads = shift;
+
+my $memc = new MemCachedClient;
+$memc->set_servers([$host]);
+
+unless ($memc->set("foo", "bar") &&
+        $memc->get("foo") eq "bar") {
+    die "memcached not running at $host ?\n";
+}
+$memc->disconnect_all();
+
+
+my $running = 0;
+while (1) {
+    if ($running < $threads) {
+        my $cpid = fork();
+        if ($cpid) {
+            $running++;
+            #print "Launched $cpid.  Running $running threads.\n";
+        } else {
+            stress();
+            exit 0;
+        }
+    } else {
+        wait();
+        $running--;
+    }
+}
+
+sub stress {
+    undef $memc;
+    $memc = new MemCachedClient;
+    $memc->set_servers([$host]);
+
+    my ($t1, $t2);
+    my $start = sub { $t1 = time(); };
+    my $stop = sub { 
+        my $op = shift;
+        $t2 = time(); 
+        my $td = sprintf("%0.3f", $t2 - $t1);
+        if ($td > 0.25) { print "Took $td seconds for: $op\n"; }
+    };
+
+    my $max = rand(50);
+    my $sets = 0;
+    
+    for (my $i = 0; $i < $max; $i++) {
+        my $key = key($i);
+        my $set = $memc->set($key, $key);
+        $sets++ if $set;
+    }
+
+    for (1..int(rand(500))) {
+        my $rand = int(rand($max));
+        my $key = key($rand);
+        my $meth = int(rand(3));
+        my $exp = int(rand(3));
+        undef $exp unless $exp;
+        $start->();
+        if ($meth == 0) {
+            $memc->add($key, $key, $exp);
+            $stop->("add");
+        } elsif ($meth == 1) {
+            $memc->delete($key);
+            $stop->("delete");
+        } else {
+            $memc->set($key, $key, $exp);
+            $stop->("set");
+        }
+        $rand = int(rand($max));
+        $key = key($rand);
+        $start->();
+        my $v = $memc->get($key);
+        $stop->("get");
+        if ($v && $v ne $key) { die "Bogus: $v for key $rand\n"; }
+    }
+
+    $start->();
+    my $multi = $memc->get_multi(map { key(int(rand($max))) } (1..$max));
+    $stop->("get_multi");
+}
+
+sub key {
+    my $n = shift; 
+    $_ = sprintf("%04d", $n);
+    if ($n % 2) { $_ .= "a"x20; }
+    $_;
+}