1#! /usr/bin/perl 2# 3# Copyright (C) 2007-2008 Tomash Brechko. All rights reserved. 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the same terms as Perl itself, either Perl version 5.8.8 7# or, at your option, any later version of Perl 5 you may have 8# available. 9# 10use warnings; 11use strict; 12 13 14# NOTE: at least on Linux (kernel 2.6.18.2) there is a certain 15# artifact that affects wallclock time (but not CPU time) of some 16# benchmarks: when send/receive rate changes dramatically, the system 17# doesn't adopt to it right away. Instead, for some time a lot of 18# small-range ACK packets are being sent, and this increases the 19# latency. Because of this '*_multi (%h)', which comes first, has 20# bigger wallclock time than '*_multi (@h)', which comes next. I 21# tried pre-warming the connection, but this doesn't help in all 22# cases. Seems like 'noreply' mode is also affected, and maybe 23# 'nowait'. 24 25 26use constant default_iteration_count => 1_000; 27use constant key_count => 100; 28use constant NOWAIT => 1; 29use constant NOREPLY => 1; 30 31my $value = 'x' x 40; 32 33 34use FindBin; 35 36@ARGV >= 1 37 or die("Usage: $FindBin::Script HOST:PORT... [COUNT] [\"compare\"]\n" 38 . "\n" 39 . "HOST:PORT... - list of memcached server addresses.\n" 40 . "COUNT - number of iterations (default " 41 . default_iteration_count . ").\n" 42 . " (each iteration will process " 43 . key_count . " keys).\n" 44 . "\"compare\" - literal string to enable comparison with\n" 45 . " Cache::Memcached.\n"); 46 47my $compare = ($ARGV[$#ARGV] =~ /^compare$/); 48pop @ARGV if $compare; 49 50my $count = ($ARGV[$#ARGV] =~ /^\d+$/ ? pop @ARGV : default_iteration_count); 51my $max_keys = $count * key_count / 2; 52 53my @addrs = @ARGV; 54 55use Cache::Memcached::Fast; 56use Benchmark qw(:hireswallclock timethese cmpthese timeit timesum timestr); 57 58my $old; 59my $old_method = qr/^(?:add|set|replace|incr|decr|delete|get)$/; 60my $old_method_multi = qr/^get$/; 61if ($compare) { 62 require Cache::Memcached; 63 64 $old = new Cache::Memcached { 65 servers => [@addrs], 66 namespace => "Cache::Memcached::bench/$$/", 67 connect_timeout => 5, 68 select_timeout => 5, 69 }; 70 $old->enable_compress(0); 71} 72 73 74my $new = new Cache::Memcached::Fast { 75 servers => [@addrs], 76 namespace => "Cache::Memcached::bench/$$/", 77 ketama_points => 150, 78 nowait => NOWAIT, 79 connect_timeout => 5, 80 io_timeout => 5, 81}; 82 83my $version = $new->server_versions; 84if (keys %$version != @addrs) { 85 my @servers = map { 86 if (ref($_) eq 'HASH') { 87 $_->{address}; 88 } elsif (ref($_) eq 'ARRAY') { 89 $_->[0]; 90 } else { 91 $_; 92 } 93 } @addrs; 94 warn "No server is running at " 95 . join(', ', grep { not exists $version->{$_} } 96 @servers) 97 . "\n"; 98 exit 1; 99} 100 101my $min_version = 2 ** 31; 102while (my ($s, $v) = each %$version) { 103 if ($v =~ /(\d+)\.(\d+)\.(\d+)/) { 104 my $n = $1 * 10000 + $2 * 100 + $3; 105 $min_version = $n if $n < $min_version; 106 } else { 107 warn "Can't parse version of $s: $v"; 108 exit 1; 109 } 110} 111 112my $noreply = NOREPLY && $min_version >= 10205; 113 114@addrs = map { +{ address => $_, noreply => $noreply } } @addrs; 115 116my $new_noreply = new Cache::Memcached::Fast { 117 servers => [@addrs], 118 namespace => "Cache::Memcached::bench/$$/", 119 ketama_points => 150, 120 connect_timeout => 5, 121 io_timeout => 5, 122}; 123 124 125sub get_key { 126 int(rand($max_keys)); 127} 128 129 130sub merge_hash { 131 my ($h1, $h2) = @_; 132 133 while (my ($k, $v) = each %$h2) { 134 $h1->{$k} = $v; 135 } 136} 137 138 139sub bench_finalize { 140 my ($title, $code, $finalize) = @_; 141 142 print "Benchmark: timing $count iterations of $title...\n"; 143 my $b1 = timeit($count, $code); 144 145 # We call nowait_push here. Otherwise the time of gathering 146 # the results would be added to the following commands. 147 my $b2 = timeit(1, $finalize); 148 149 my $res = timesum($b1, $b2); 150 print "$title: ", timestr($res, 'auto'), "\n"; 151 152 return { $title => $res }; 153} 154 155 156sub run { 157 my ($method, $value, $cas) = @_; 158 159 my $params = sub { 160 my @params; 161 push @params, $_[0] . '-' . get_key(); 162 push @params, 0 if $cas; 163 push @params, $value if defined $value; 164 return @params; 165 }; 166 167 my $params_multi = sub { 168 my @res; 169 for (my $i = 0; $i < key_count; ++$i) { 170 my @params; 171 push @params, $_[0] . '-' . get_key(); 172 if ($cas or defined $value) { 173 push @params, 0 if $cas; 174 push @params, $value if defined $value; 175 push @res, \@params; 176 } else { 177 push @res, @params; 178 } 179 } 180 return @res; 181 }; 182 183 my @test = ( 184 "$method" => sub { my $res = $new->$method(&$params('p$')) 185 foreach (1..key_count) }, 186 ); 187 188 push @test, ( 189 "old $method" => sub { my $res = $old->$method(&$params('o$')) 190 foreach (1..key_count) }, 191 ) if defined $old and $method =~ /$old_method/o; 192 193 my $bench = timethese($count, {@test}); 194 195 if (defined $value and $noreply) { 196 # We call get('no-such-key') here. Otherwise the time of 197 # sending the requests might be added to the following 198 # commands. 199 my $res = bench_finalize("$method noreply", 200 sub { $new_noreply->$method(&$params('pr')) 201 foreach (1..key_count) }, 202 sub { $new_noreply->get('no-such-key') }); 203 204 merge_hash($bench, $res); 205 206 if (defined $old and $method =~ /$old_method/o) { 207 $res = bench_finalize("old $method noreply", 208 sub { $old->$method(&$params('or')) 209 foreach (1..key_count) }, 210 sub { $old->get('no-such-key') }); 211 212 merge_hash($bench, $res); 213 } 214 } 215 216 if (defined $value and NOWAIT) { 217 # We call nowait_push here. Otherwise the time of gathering 218 # the results would be added to the following commands. 219 my $res = bench_finalize("$method nowait", 220 sub { $new->$method(&$params('pw')) 221 foreach (1..key_count) }, 222 sub { $new->nowait_push }); 223 merge_hash($bench, $res); 224 } 225 226 my $method_multi = "${method}_multi"; 227 @test = ( 228 "$method_multi" . (defined $value ? ' (%h)' : '') 229 => sub { my $res = $new->$method_multi(&$params_multi('m%')) }, 230 ); 231 232 # We use the same 'm%' prefix here as for the new module because 233 # old module doesn't have set_multi, and we want to retrieve 234 # something. 235 push @test, ( 236 "old $method_multi" 237 => sub { my $res = $old->$method_multi(&$params_multi('m%')) }, 238 ) if defined $old and $method =~ /$old_method_multi/o; 239 240 push @test, ( 241 "$method_multi (\@a)" 242 => sub { my @res = $new->$method_multi(&$params_multi('m@')) }, 243 ) if defined $value; 244 245 merge_hash($bench, timethese($count, {@test})); 246 247 if (defined $value and $noreply) { 248 # We call get('no-such-key') here. Otherwise the time of 249 # sending the requests might be added to the following 250 # commands. 251 my $res = bench_finalize("$method_multi noreply", 252 sub { $new_noreply-> 253 $method_multi(&$params_multi('mr')) }, 254 sub { $new_noreply->get('no-such-key') }); 255 256 merge_hash($bench, $res); 257 } 258 259 if (defined $value and NOWAIT) { 260 # We call nowait_push here. Otherwise the time of gathering 261 # the results would be added to the following commands. 262 my $res = bench_finalize("$method_multi nowait", 263 sub { 264 $new->$method_multi(&$params_multi('mw')) 265 }, 266 sub { $new->nowait_push }); 267 268 merge_hash($bench, $res); 269 } 270 271 cmpthese($bench); 272} 273 274 275my @methods = ( 276 [add => \&run, $value], 277 [set => \&run, $value], 278 [append => \&run, $value], 279 [prepend => \&run, $value], 280 [replace => \&run, $value], 281 [cas => \&run, $value, 'CAS'], 282 [get => \&run], 283 [gets => \&run], 284 [incr => \&run, 1], 285 [decr => \&run, 1], 286 [delete => \&run, 0], 287); 288 289 290print "Servers: @{[ keys %$version ]}\n"; 291print "Iteration count: $count\n"; 292print 'Keys per iteration: ', key_count, "\n"; 293print 'Value size: ', length($value), " bytes\n"; 294 295srand(1); 296foreach my $args (@methods) { 297 my $sub = splice(@$args, 1, 1); 298 &$sub(@$args); 299} 300 301 302# Benchmark latency issues. 303if ($noreply) { 304 cmpthese(timethese($count, { 305 "set noreply followed by get" 306 => sub { 307 foreach (1..key_count) { 308 $new_noreply->set('snfbg', $value); 309 my $res = $new_noreply->get('snfbg'); 310 } 311 } 312 })); 313} 314