"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/stress-memcached.pl" (29 Aug 2009, 2229 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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 }