Skip to content

Instantly share code, notes, and snippets.

@wki
Created January 29, 2012 08:53
Show Gist options
  • Save wki/1697936 to your computer and use it in GitHub Desktop.
Save wki/1697936 to your computer and use it in GitHub Desktop.
Redis Binding Benchmark
#!/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);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment