redis-server.pl

#!/usr/bin/perl

use strict;
use warnings;

use Protocol::Redis;
use AnyEvent;
use AnyEvent::Socket;

my %commands = (
    info => sub { {type => '$', data => "my_redis_server:0.0.1\x0d\x0a"} },
    ping => sub { {type => '+', data => 'PONG'} }
);

sub default {
    my $command = shift->{data}[0]{data};
    {   type => '-',
        data => "ERR unknown command '$command'"
    };
}

my $c = AnyEvent->condvar;
tcp_server undef, 5000, sub {
    my $fh = shift;
    my $redis = Protocol::Redis->new(api => 1);

    $redis->on_message(sub {
        my ($parser, $data) = @_;
        my $command = $commands{lc $data->{data}[0]{data}} || \&default;

        syswrite($fh, $parser->encode($command->($data)));
    });

    my $io;
    $io = AnyEvent->io(
        fh   => $fh,
        poll => 'r',
        cb   => sub {
            undef $io unless sysread($fh, my $chunk, 1024, 0);
            $redis->parse($chunk);
        }
    );
};

print "Redis server available at 0:5000\n";
$c->recv;