public
Created

Redis Binding Benchmark

  • Download Gist
redis_benchmark.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
#!/usr/bin/env perl
use strict;
use warnings;
use feature ':5.10';
use Redis;
use YAML::XS ();
use YAML ();
use JSON::XS ();
use IO::Socket::INET;
use Data::Dumper;
use Benchmark ':all';
 
my $redis = Redis->new;
 
my %structure = (
foo => 'bar',
bar => 42,
baz => [ 1,2,3,4 ],
another => { foo => 42, string => "\x{2022} utf8 string"}
);
 
my $json = JSON::XS::encode_json \%structure;
 
my $socket = IO::Socket::INET->new( PeerAddr => '127.0.0.1:6379', Proto => 'tcp' );
 
sub set_string { $redis->set('user:wki' => 'foo bar') }
sub get_string { $redis->get('user:wki') }
sub set_yaml_xs { $redis->set('session:12345_yaml', YAML::XS::Dump \%structure) }
sub get_yaml_xs { YAML::XS::Load $redis->get('session:12345_yaml') }
sub set_json_xs { $redis->set('session:12345_json', JSON::XS::encode_json \%structure) }
sub get_json_xs { JSON::XS::decode_json $redis->get('session:12345_json') }
 
sub pure_native { native_redis_command(setex => 'session:12345_native', 3600, $json) }
sub set_native_json_xs { native_redis_command(setex => 'session:12345_native', 3600, JSON::XS::encode_json \%structure) }
sub get_native_json_xs { JSON::XS::decode_json native_redis_command(get => 'session:12345_native') }
 
sub native_redis_command {
# theoretically needed but slows down a bit. At least on Unix-Systems the default \n is OK
# local $/ = "\r\n";
syswrite $socket,
join("\r\n",
# first line is:
# * <nr_of_lines>
'*' . scalar(@_),
# every content-line is split into 2:
# $ <nr_of_bytes_in_following_line>
# payload
(map { ('$' . length, $_) } @_),
# needed to have a trailing CR-LF
''
);
 
my $line = <$socket>;
if (substr($line,0,1) eq '$') {
# one result -- a known nr of bytes
my $buffer;
read $socket, $buffer, substr($line,1)+2;
return $buffer;
} elsif (substr($line,0,1) eq '-') {
# error
die 'Redis Error: ' . substr($line,1,-2);
} elsif (substr($line,0,1) eq '+') {
# status
return substr($line,1,-2);
} elsif (substr($line,0,1) eq ':') {
# integer
return substr($line,1,-2);
} elsif (substr($line,0,1) eq '*') {
# bulk reply
die 'bulk reply not yet done';
} else {
die 'unknown reply: ' . substr($line,0,-2)
}
}
 
# ensure we have data saved to allow get...() to occur before set...() during benchmark
set_string;
set_yaml_xs;
set_json_xs;
set_native_json_xs;
 
my $results = timethese(10_000, {
set_string => \&set_string,
get_string => \&get_string,
set_yaml_xs => \&set_yaml_xs,
get_yaml_xs => \&get_yaml_xs,
set_json_xs => \&set_json_xs,
get_json_xs => \&get_json_xs,
pure_native => \&pure_native,
set_native => \&set_native_json_xs,
get_native => \&get_native_json_xs,
});
 
cmpthese($results);

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.