#!/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