Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

commands: ping/quit/get/set

  • Loading branch information...
commit 8d932a571430c0299263cdb97c3c62f003e35e91 1 parent de6f57a
@Cofyc authored
View
8 README.md
@@ -1,5 +1,11 @@
# Redis - Perl6 binding for Redis
-Port of Redis from Perl 5. (http://search.cpan.org/~melo/Redis-1.951/)
+Port of Redis from Perl 5.
Current status: in development.
+
+References
+==========
+
+1. http://redis.io/topics/protocol
+2. http://search.cpan.org/~melo/Redis-1.951/
View
116 lib/Redis.pm
@@ -6,6 +6,13 @@ use v6;
#
# =end Pod
+# Initiate callbacks
+my %command_callbacks = ();
+%command_callbacks{"PING"} = { $_ eq "PONG" };
+for "QUIT SET".split(" ") -> $c {
+ %command_callbacks{$c} = { $_ eq "OK" }
+}
+
class Redis;
has Str $.host = '127.0.0.1';
@@ -13,14 +20,17 @@ has Int $.port = 6379;
has Str $.sock; # if sock is defined, use sock
has Bool $.debug = False;
has Real $.timeout = 0.0; # 0 means unlimited
-has IO::Socket $.conn;
+has $.conn is rw;
+has %!command_callbacks = %command_callbacks;
method new(Str $server?, Bool :$debug?, Real :$timeout?) {
my %config = {}
if $server.defined {
- if $server ~~ m/^([\d+]+ %\.) ':' (\d+)$/ {
+ if $server ~~ m/^([\d+]+ %\.) [':' (\d+)]?$/ {
%config<host> = $0.Str;
- %config<port> = $1.Int;
+ if $1 {
+ %config<port> = $1.Str.Int;
+ }
} else {
%config<sock> = $server;
}
@@ -35,18 +45,102 @@ method new(Str $server?, Bool :$debug?, Real :$timeout?) {
}
method connect {
- my $conn;
if $.sock.defined {
- say "unsupported";
+ die "Sorry, connecting via unix sock is currently unsupported!";
} else {
- $conn = IO::Socket::INET.new(host => $.host, port => $.port);
+ $.conn = IO::Socket::INET.new(host => $.host, port => $.port, input-line-separator => "\r\n");
+ }
+}
+
+method !pack_command(*@args) {
+ my $cmd = '*' ~ @args.elems ~ "\r\n";
+ for @args -> $arg {
+ $cmd ~= '$';
+ $cmd ~= $arg.chars;
+ $cmd ~= "\r\n";
+ $cmd ~= $arg;
+ $cmd ~= "\r\n";
}
- $.conn = $conn;
+ return $cmd;
+}
+
+
+method !send_command(*@args) {
+ $.conn.send(self!pack_command(|@args));
+}
+
+method !read_response {
+ my $first-line = $.conn.get();
+ my ($flag, $response) = $first-line.substr(0, 1), $first-line.substr(1);
+ if $flag !eq any('+', '-', ':', '$', '*') {
+ die "Unknown nresponse from redis!\n";
+ }
+ if $flag eq '+' {
+ # single line reply
+ } elsif $flag eq '-' {
+ # on error
+ die $response;
+ } elsif $flag eq ':' {
+ # int value
+ $response = $response.Int;
+ } elsif $flag eq '$' {
+ # bulk response
+ my $length = $response.Int;
+ if $length eq -1 {
+ return False;
+ }
+ $response = $.conn.recv($length);
+ } elsif $flag eq '*' {
+ # multi-bulk response
+ die "unsupported";
+ }
+ return $response;
+}
+
+method !parse_response($response, $command) {
+ if %!command_callbacks.exists($command) {
+ return %!command_callbacks{$command}($response);
+ }
+ return $response;
+}
+
+# Ping the server.
+method ping {
+ self!send_command("PING");
+ return self!parse_response(self!read_response(), "PING");
}
-#method ping {
- #$.conn.send("PING\r\n");
- #print($.conn.get);
-#}
+# Ask the server to close the connection. The connection is closed as soon as all pending replies have been written to the client.
+method quit {
+ self!send_command("QUIT");
+ return self!parse_response(self!read_response(), "QUIT");
+}
+method set(Str $name, $value) {
+ self!send_command("SET", $name, $value);
+ return self!parse_response(self!read_response(), "SET");
+}
+
+method get(Str $name) {
+ self!send_command("GET", $name);
+ return self!parse_response(self!read_response(), "GET");
+}
+
+method mget {
+}
+
+method incr {
+}
+
+method decr {
+}
+
+method exists {
+}
+
+method del {
+}
+
+method type {
+}
# vim: ft=perl6
View
18 t/00-basic.t
@@ -3,23 +3,29 @@ use v6;
use Redis;
use Test;
-my @new_tasks = \() => {
+my @new_tasks =
+ \() => {
'host' => '127.0.0.1',
'port' => 6379,
'debug' => False,
'timeout' => 0.0,
- },
- \('192.168.0.1:6379', debug => True, timeout => 3) => {
+ }
+ , \('192.168.0.1') => {
+ 'host' => '192.168.0.1',
+ 'port' => 6379,
+ }
+ , \('192.168.0.1:6379', debug => True, timeout => 3) => {
'host' => '192.168.0.1',
'port' => 6379,
'debug' => True,
'timeout' => 3,
- },
- \('/path/to/redis.sock', debug => True, timeout => 3) => {
+ }
+ , \('/path/to/redis.sock', debug => True, timeout => 3) => {
'sock' => '/path/to/redis.sock',
'debug' => True,
'timeout' => 3,
- };
+ }
+ ;
plan [+] @new_tasks.map({ $_.value.elems });
View
9 t/01-connect.t
@@ -1,12 +1,14 @@
use v6;
+BEGIN { @*INC.push('t/') };
use Redis;
use Test;
+use Test::SpawnRedisServer;
plan 1;
{
- my $r = Redis.new;
+ my $r = Redis.new('192.168.0.1');
my $failed = 0;
try {
$r.connect;
@@ -17,4 +19,9 @@ plan 1;
ok $failed, 'trying to connect wrong server throws exception';
}
+{
+ my $r = Redis.new();
+ $r.connect;
+}
+
# vim: ft=perl6
View
14 t/02-commands.t
@@ -0,0 +1,14 @@
+use v6;
+
+BEGIN { @*INC.push('t/') };
+use Redis;
+use Test;
+use Test::SpawnRedisServer;
+
+my $r = Redis.new();
+$r.connect;
+
+is $r.ping, True;
+is $r.set("key", "value"), True;
+is $r.get("key"), "value";
+is $r.quit, True;
View
7 t/Test/SpawnRedisServer.pm
@@ -0,0 +1,7 @@
+module Test::SpawnRedisServer;
+
+sub SpawnRedis() is export {
+ # TODO automatically start redis server by unit test script
+}
+
+# vim: ft=perl6
View
5 t/redis.conf
@@ -0,0 +1,5 @@
+timeout 1
+appendonly no
+daemonize no
+port 6379
+bind 127.0.0.1
Please sign in to comment.
Something went wrong with that request. Please try again.