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