1use strict; 2use Benchmark qw(cmpthese); 3use Cache::Memcached; 4use Cache::Memcached::Fast; 5use Cache::Memcached::libmemcached; 6use Memcached::libmemcached qw(MEMCACHED_BEHAVIOR_BINARY_PROTOCOL); 7use Getopt::Long; 8 9my $no_block = 0; 10my $server = ''; 11my %modes = ( 12 simple_get => 1, 13 simple_get_multi => 0, 14 serialize_get => 0, 15 simple_set => 0, 16); 17 18if (! GetOptions( 19 "no_block!" => \$no_block, 20 "server=s" => \$server, 21 "simple-get!" => \$modes{simple_get}, 22 "simple-get_multi!" => \$modes{simple_get_multi}, 23 "serialize-get!" => \$modes{serialize_get}, 24 "compress-get!" => \$modes{compress_get}, 25 "simple-set!" => \$modes{simple_set}, 26 "serialize-set!" => \$modes{serialize_set}, 27 "compress-set!" => \$modes{compress_set}, 28)) { 29 exit 1; 30} 31$server ||= $ENV{MEMCACHED_SERVER} || '127.0.0.1:11211'; 32 33print "Module Information:\n"; 34foreach my $module qw(Cache::Memcached Cache::Memcached::Fast Cache::Memcached::libmemcached Memcached::libmemcached) { 35 no strict 'refs'; 36 print " + $module => " . ${ "${module}::VERSION" }, "\n"; 37} 38 39print "\n"; 40print "Library Information:\n"; 41print " + libmemcached => @{[ Memcached::libmemcached::memcached_lib_version() ]}\n"; 42 43print "\n"; 44print "Server Information:\n"; 45{ 46 my $memd = Cache::Memcached::Fast->new({servers => [$server]}); 47 my $versions = $memd->server_versions; 48 while (my ($server, $version) = each %$versions) { 49 print " + $server => $version\n"; 50 } 51} 52 53print "\n"; 54print "Options:\n"; 55print " + Memcached server: $server\n"; 56 57{ 58 my $memd = Cache::Memcached->new({ servers => [ $server ] }); 59 my $h = $memd->stats('misc'); 60 print " + Memcached server version: ", $h->{hosts}{$server}->{misc}->{version}, "\n"; 61} 62 63print " + Include no block mode (where applicable)? :", $no_block ? "YES" : "NO", "\n"; 64 65my %args = ( 66 servers => [ $server ], 67 compress_threshold => 1_000, 68); 69 70my $data; 71 72print "\n"; 73print "Prepping clients...\n"; 74my %clients = ( 75 perl_memcached => Cache::Memcached->new(\%args), 76 memcached_fast => Cache::Memcached::Fast->new(\%args), 77 libmemcached => Cache::Memcached::libmemcached->new(\%args), 78 libmemcached_binary => Cache::Memcached::libmemcached->new({ %args, binary_protocol => 1 }), 79 memcached_plain => do { 80 my $memd = Memcached::libmemcached->new(); 81 if ($server =~ /^([^:]+):([^:]+)$/) { 82 $memd->memcached_server_add($1, $2); 83 } else { 84 $memd->memcached_server_add_unix_socket($server); 85 } 86 $memd; 87 }, 88 memcached_plain_binary => do { 89 my $memd = Memcached::libmemcached->new(); 90 if ($server =~ /^([^:]+):([^:]+)$/) { 91 $memd->memcached_server_add($1, $2); 92 } else { 93 $memd->memcached_server_add_unix_socket($server); 94 } 95 $memd->memcached_behavior_set( MEMCACHED_BEHAVIOR_BINARY_PROTOCOL, 1 ); 96 $memd; 97 } 98); 99 100# Include non-blocking client modes 101if ($no_block) { 102 $clients{libmemcached_no_block} = Cache::Memcached::libmemcached->new({ 103 %args, no_block => 1 104 }); 105} 106 107print "\n"; 108 109if ($modes{simple_get}) { 110 print qq|==== Benchmark "Simple get() (scalar)" ====\n|; 111 $data = '0123456789' x 10; 112 $clients{perl_memcached}->set( 'foo', $data ); 113# $clients{memcached_plain}->memcached_set( 'foo', $data ); 114 cmpthese(50_000, +{ 115 map { 116 my $client = $clients{$_}; 117 ($_ => sub { 118 my $value = ref $client eq 'Memcached::libmemcached' ? 119 $client->memcached_get('foo') : 120 $client->get('foo'); 121 if ($value ne $data) { 122 die "$client did not return proper value (wanted '$data', got '$value')" 123 } 124 }) 125 } keys %clients 126 }); 127} 128 129if ($modes{simple_get_multi}) { 130 print qq|==== Benchmark "Simple get_multi() (scalar)" ====\n|; 131 132 my @keys = ('a'..'z'); 133 for (@keys) { 134 $clients{perl_memcached}->set($_, $_); 135 } 136 cmpthese(50_000, +{ 137 map { 138 my $client = $clients{$_}; 139 $_ => sub { $client->get_multi(@keys) } 140 } keys %clients 141 }); 142} 143 144if ($modes{serialize_get}) { 145 print qq|==== Benchmark "Serialization with get()" ====\n|; 146 $data = { foo => [ qw(1 2 3) ] }; 147 $clients{perl_memcached}->set( 'foo', $data ); 148 cmpthese(50_000, { 149 map { 150 my $client = $clients{$_}; 151 $_ => sub { 152 my $h = $client->get('foo'); 153 ref($h) eq 'HASH' or die "$client did not return a hash"; 154 ref($h->{foo}) eq 'ARRAY' or die "$client did not return an array in hash"; 155 } 156 } keys %clients 157 }); 158} 159 160if ($modes{compress_get}) { 161 print qq|==== Benchmark "Simple get() (w/compression)" ====\n|; 162 $data = '0123456789' x 500; 163 $clients{perl_memcached}->set( 'foo', $data ); 164 cmpthese(50_000, { 165 map { 166 my $client = $clients{$_}; 167 $_ => sub { 168 my $h = $client->get('foo'); 169 length($h) == 5000 or die "$client did not return 5000 bytes"; 170 } 171 } keys %clients 172 }); 173} 174 175if ($modes{simple_set}) { 176 print qq|==== Benchmark "Simple set() (scalar)" ====\n|; 177 $data = '0123456789' x 10; 178 cmpthese(50_000, { 179 map { 180 my $client = $clients{$_}; 181 $_ => sub { 182 $client->set('foo', $data); 183 } 184 } keys %clients 185 }); 186} 187 188if ($modes{serialize_set}) { 189 print qq|==== Benchmark "Simple set() (w/seriale)" ====\n|; 190 $data = { foo => [ qw( 1 2 3 ) ] }; 191 cmpthese(50_000, { 192 map { 193 my $client = $clients{$_}; 194 $_ => sub { 195 $client->set('foo', $data); 196 } 197 } keys %clients 198 }); 199} 200 201if ($modes{compress_set}) { 202 print qq|==== Benchmark "Simple set() (w/compress)" ====\n|; 203 $data = '0123456789' x 500; 204 cmpthese(50_000, { 205 map { 206 my $client = $clients{$_}; 207 $_ => sub { 208 $client->set('foo', $data); 209 } 210 } keys %clients 211 }); 212} 213 214__END__ 215 216{ 217 print qq|==== Benchmark "Simple set() (w/serialize)" ====\n|; 218 $data = { foo => [ qw(1 2 3) ] }; 219 cmpthese(100_000, { 220 perl_memcahed => sub { 221 $memd->set( 'foo', $data ); 222 }, 223 memcached_fast => sub { 224 $memd_fast->set( 'foo', $data ); 225 }, 226 libmemcached => sub { 227 $libmemd->set( 'foo', $data ); 228 }, 229# libmemcached_no_block => sub { 230# $libmemd_no_block->set( 'foo', $data ); 231# }, 232 }); 233} 234 235{ 236 print qq|==== Benchmark "Simple set() (w/compress)" ====\n|; 237 $data = '0123456789' x 500; 238 cmpthese(100_000, { 239 perl_memcahed => sub { 240 $memd->set( 'foo', $data ); 241 }, 242 memcached_fast => sub { 243 $memd_fast->set( 'foo', $data ); 244 }, 245 libmemcached => sub { 246 $libmemd->set( 'foo', $data ); 247 }, 248# libmemcached_no_block => sub { 249# $libmemd_no_block->set( 'foo', $data ); 250# }, 251 }); 252} 253 254 255 256