Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

finish keys/strings/hashes commands

  • Loading branch information...
commit 352e5daf996473cec009e838386e299039df9f6f 1 parent 8d932a5
@Cofyc authored
Showing with 518 additions and 34 deletions.
  1. +1 −0  .gitignore
  2. +10 −1 README.md
  3. +4 −3 TODO
  4. +314 −26 lib/Redis.pm
  5. +189 −4 t/02-commands.t
View
1  .gitignore
@@ -0,0 +1 @@
+/.DS_Store
View
11 README.md
@@ -2,7 +2,16 @@
Port of Redis from Perl 5.
-Current status: in development.
+Synopsis
+========
+
+ # create a Redis object
+ my $redis = Redis.new("192.168.1.12:6379");
+ # connect to server
+ $redis.connect();
+ # execute commands...
+ $redis.set("key", "value");
+ say $redis.get("key");
References
==========
View
7 TODO
@@ -1,4 +1,5 @@
Commands
-========
- * quit
- * ping
+ - sort
+
+* complete method signatures
+* support debug & timeout options
View
340 lib/Redis.pm
@@ -1,17 +1,46 @@
use v6;
# =begin Pod
+#
# =head1 Redis
-# Perl6 binding for Redis.
+#
+# C<Redis> is a Perl6 binding for Redis database.
+#
+# =head1 Synopsis
+#
+# my $redis = Redis.new("192.168.1.12:6379");
+# $redis.connect();
+# $redis.set("key", "value");
+# say $redis.get("key");
#
# =end Pod
# Initiate callbacks
+my &status_code_reply_cb = { $_ eq "OK" };
+my &integer_reply_cb = { $_.Bool };
+my &string_to_float_cb = { $_.Real };
my %command_callbacks = ();
%command_callbacks{"PING"} = { $_ eq "PONG" };
-for "QUIT SET".split(" ") -> $c {
- %command_callbacks{$c} = { $_ eq "OK" }
+for "QUIT SET MSET PSETEX SETEX MIGRATE RENAME RENAMENX RESTORE HMSET".split(" ") -> $c {
+ %command_callbacks{$c} = &status_code_reply_cb;
}
+for "EXISTS SETNX EXPIRE EXPIREAT MOVE PERSIST PEXPIRE PEXPIREAT HSET HEXISTS HSETNX".split(" ") -> $c {
+ %command_callbacks{$c} = &integer_reply_cb;
+}
+for "INCRBYFLOAT HINCRBYFLOAT".split(" ") -> $c {
+ %command_callbacks{$c} = &string_to_float_cb;
+}
+%command_callbacks{"HGETALL"} = {
+ # TODO so ugly...
+ my %h = ();
+ my $l = $_;
+ for $_.pairs {
+ if .key % 2 eq 0 {
+ %h{.value} = $l[.key + 1];
+ }
+ }
+ return %h;
+ };
class Redis;
@@ -69,14 +98,24 @@ method !send_command(*@args) {
$.conn.send(self!pack_command(|@args));
}
+method !exec_command(*@args) {
+ if @args.elems <= 0 {
+ die "Invalid command.";
+ }
+ my Str $cmd = @args[0];
+ self!send_command(|@args);
+ return self!parse_response(self!read_response(), $cmd);
+}
+
+# call get on Socket::IO, don't use recv, cuz they are use different buffer.
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";
+ die "Unknown response from redis!\n";
}
if $flag eq '+' {
- # single line reply
+ # single line reply, pass
} elsif $flag eq '-' {
# on error
die $response;
@@ -87,12 +126,22 @@ method !read_response {
# bulk response
my $length = $response.Int;
if $length eq -1 {
- return False;
+ return Nil;
+ }
+ $response = $.conn.get();
+ if $response.chars !eq $length {
+ die "Invalid response.";
}
- $response = $.conn.recv($length);
} elsif $flag eq '*' {
# multi-bulk response
- die "unsupported";
+ my $length = $response.Int;
+ if $length eq -1 {
+ return Nil;
+ }
+ $response = [];
+ for 1..$length {
+ $response.push(self!read_response());
+ }
}
return $response;
}
@@ -105,42 +154,281 @@ method !parse_response($response, $command) {
}
# Ping the server.
-method ping {
- self!send_command("PING");
- return self!parse_response(self!read_response(), "PING");
+method ping returns Bool {
+ return self!exec_command("PING");
}
# 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 quit returns Bool {
+ return self!exec_command("QUIT");
+}
+
+###### Commands/Keys #######
+
+method del(*@keys) returns Int {
+ return self!exec_command("DEL", |@keys);
+}
+
+method dump(Str $key) returns Str {
+ return self!exec_command("DUMP", $key);
+}
+
+method exists(Str $key) returns Bool {
+ return self!exec_command("EXISTS", $key);
+}
+
+method expire(Str $key, Int $seconds) returns Bool {
+ return self!exec_command("EXPIRE", $key, $seconds);
+}
+
+method expireat(Str $key, Int $timestamp) returns Bool {
+ return self!exec_command("EXPIREAT", $key, $timestamp);
+}
+
+method ttl(Str $key) returns Int {
+ return self!exec_command("TTL", $key);
+}
+
+method keys(Str $pattern) returns Array {
+ return self!exec_command("KEYS", $pattern);
}
-method set(Str $name, $value) {
- self!send_command("SET", $name, $value);
- return self!parse_response(self!read_response(), "SET");
+method migrate(Str $host, Int $port, Str $key, Str $destination-db, Int $timeout) returns Bool {
+ return self!exec_command("MIGRATE", $host, $port, $key, $destination-db, $timeout);
}
-method get(Str $name) {
- self!send_command("GET", $name);
- return self!parse_response(self!read_response(), "GET");
+method move(Str $key, Str $db) returns Bool {
+ return self!exec_command("MOVE", $key, $db);
}
-method mget {
+method object(Str $subcommand, *@arguments) {
+ return self!exec_command("OBJECT", $subcommand, |@arguments);
}
-method incr {
+method persist(Str $key) returns Bool {
+ return self!exec_command("PERSIST", $key);
}
-method decr {
+method pexpire(Str $key, Int $milliseconds) returns Bool {
+ return self!exec_command("PEXPIRE", $key, $milliseconds);
}
-method exists {
+method pexpireat(Str $key, Int $milliseconds-timestamp) returns Bool {
+ return self!exec_command("PEXPIREAT", $key, $milliseconds-timestamp);
}
-method del {
+method pttl(Str $key) returns Int {
+ return self!exec_command("TTL", $key);
}
-method type {
+method randomkey() {
+ return self!exec_command("RANDOMKEY");
}
+
+method rename(Str $key, Str $newkey) returns Bool {
+ return self!exec_command("RENAME", $key, $newkey);
+}
+
+method renamenx(Str $key, Str $newkey) returns Bool {
+ return self!exec_command("RENAMENX", $key, $newkey);
+}
+
+method restore(Str $key, Int $milliseconds, Str $serialized-value) returns Bool {
+ return self!exec_command("RESTORE", $key, $milliseconds, $serialized-value);
+}
+
+method sort(Str $key, Str :$by?,
+ Int :$offset?, Int :$count?,
+ :@get?,
+ Bool :$desc = False,
+ Bool :$alpha = False,
+ Str :$store?
+ ) returns Array {
+ if ($offset.defined and !$count.defined) or (!$offset.defined and $count.defined) {
+ die "`offset` and `count` must both be specified.";
+ }
+ say $desc;
+ # TODO
+ return []
+}
+
+# Returns the string representation of the type of the value stored at key. The
+# different types that can be returned are: none, string, list, set, zset and hash.
+method type(Str $key) {
+ return self!exec_command("TYPE", $key);
+}
+
+###### ! Commands/Keys #######
+
+###### Commands/Strings ######
+
+method append(Str $key, $value) returns Int {
+ return self!exec_command("APPEND", $key, $value);
+}
+
+method bitcount(Str $key, Int $start?, Int $end?) returns Int {
+ my @args = [$key];
+ if $start.defined and $end.defined {
+ @args.push($start);
+ @args.push($end);
+ } elsif $start.defined or $end.defined {
+ die "Both start and end must be specified.";
+ }
+ return self!exec_command("BITCOUNT", |@args);
+}
+
+method bitop(Str $op, Str $key, *@keys) {
+ return self!exec_command("BITOP", $op, $key, |@keys);
+}
+
+method get(Str $key) {
+ return self!exec_command("GET", $key);
+}
+
+method set(Str $key, $value) returns Bool {
+ return self!exec_command("SET", $key, $value);
+}
+
+method setbit(Str $key, Int $offset, $value) returns Int {
+ return self!exec_command("SETBIT", $key, $offset, $value);
+}
+
+method setex(Str $key, Int $seconds, $value) {
+ return self!exec_command("SETEX", $key, $seconds, $value);
+}
+
+method setnx(Str $key, $value) returns Bool {
+ return self!exec_command("SETNX", $key, $value);
+}
+
+method setrange(Str $key, Int $offset, $value) returns Int {
+ return self!exec_command("SETRANGE", $key, $offset, $value);
+}
+
+method strlen(Str $key) returns Int {
+ return self!exec_command("STRLEN", $key);
+}
+
+method getbit(Str $key, Int $offset) returns Int {
+ return self!exec_command("GETBIT", $key, $offset);
+}
+
+method getrange(Str $key, Int $start, Int $end) returns Str {
+ return self!exec_command("GETRANGE", $key, $start, $end);
+}
+
+method getset(Str $key, $value) {
+ return self!exec_command("GETSET", $key, $value);
+}
+
+method incrbyfloat(Str $key, Real $increment) returns Real {
+ return self!exec_command("INCRBYFLOAT", $key, $increment);
+}
+
+method mget(*@keys) {
+ return self!exec_command("MGET", |@keys);
+}
+
+# Sets the given keys to their respective values.
+# Arguments can be named or positional parameters.
+method mset(*@args, *%named) {
+ for %named {
+ @args.push(.key);
+ @args.push(.value);
+ }
+ return self!exec_command("MSET", |@args);
+}
+
+method msetnx(*@args, *%named) {
+ for %named {
+ @args.push(.key);
+ @args.push(.value);
+ }
+ return self!exec_command("MSETNX", |@args);
+}
+
+method psetex(Str $key, Int $milliseconds, $value) {
+ return self!exec_command("PSETEX", $key, $milliseconds, $value);
+}
+
+method incr(Str $key) {
+ return self!exec_command("INCR", $key);
+}
+
+method incrby(Str $key, Int $increment) {
+ return self!exec_command("INCRBY", $key, $increment);
+}
+
+method decr(Str $key) {
+ return self!exec_command("DECR", $key);
+}
+
+method decrby(Str $key, Int $increment) {
+ return self!exec_command("DECRBY", $key, $increment);
+}
+
+###### ! Commands/Strings ######
+
+###### Commands/Hashes ######
+#
+# field can be integer/string
+
+method hdel(Str $key, *@fields) returns Int {
+ return self!exec_command("HDEL", $key, |@fields);
+}
+
+method hexists(Str $key, $field) returns Bool {
+ return self!exec_command("HEXISTS", $key, $field);
+}
+
+method hget(Str $key, $field) returns Any {
+ return self!exec_command("HGET", $key, $field);
+}
+
+method hgetall(Str $key) returns Hash {
+ return self!exec_command("HGETALL", $key);
+}
+
+method hincrby(Str $key, $field, Int $increment) returns Int {
+ return self!exec_command("HINCRBY", $key, $field, $increment);
+}
+
+method hincrbyfloat(Str $key, $field, Real $increment) returns Real {
+ return self!exec_command("HINCRBYFLOAT", $key, $field, $increment);
+}
+
+method hkeys(Str $key) returns Array {
+ return self!exec_command("HKEYS", $key);
+}
+
+method hlen(Str $key) returns Int {
+ return self!exec_command("HLEN", $key);
+}
+
+method hmget(Str $key, *@fields) returns Array {
+ return self!exec_command("HMGET", $key, |@fields);
+}
+
+method hmset(Str $key, *@args, *%named) returns Bool {
+ for %named {
+ @args.push(.key);
+ @args.push(.value);
+ }
+ return self!exec_command("HMSET", $key, |@args);
+}
+
+method hset(Str $key, $field, $value) returns Bool {
+ return self!exec_command("HSET", $key, $field, $value);
+}
+
+method hsetnx(Str $key, $field, $value) returns Bool {
+ return self!exec_command("HSETNX", $key, $field, $value);
+}
+
+method hvals(Str $key) returns Array {
+ return self!exec_command("HVALS", $key);
+}
+
+###### ! Commands/Hashes ######
+
# vim: ft=perl6
View
193 t/02-commands.t
@@ -8,7 +8,192 @@ 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;
+###### Commands/Strings #######
+
+# append
+$r.del("key");
+is_deeply $r.append("key", "Hello"), 5;
+is_deeply $r.append("key", " World"), 11;
+
+# bitcount
+$r.set("key", "foobar");
+is_deeply $r.bitcount("key"), 26;
+is_deeply $r.bitcount("key", 0, 0), 4;
+is_deeply $r.bitcount("key", 1, 1), 6;
+
+# bitop
+$r.set("key1", "foobar");
+$r.set("key2", "abcdefg");
+is_deeply $r.bitop("AND", "dest", "key1", "key2"), 7;
+
+# incr & decr & decrby & incrby
+$r.set("key2", 100);
+is_deeply $r.incr("key2"), 101;
+is_deeply $r.decr("key2"), 100;
+is_deeply $r.decrby("key2", 2), 98;
+is_deeply $r.incrby("key2", 3), 101;
+
+# getbit
+is_deeply $r.getbit("key2", 2), 1;
+
+# getrange
+$r.set("mykey", "This is a string");
+is_deeply $r.getrange("mykey", 0, 3), "This";
+
+# getset
+$r.del("mycounter");
+is_deeply $r.incr("mycounter"), 1;
+is_deeply $r.getset("mycounter", 0), "1";
+is_deeply $r.get("mycounter"), "0";
+
+# incrbyfloat
+$r.set("mykey", 10.50);
+is_deeply $r.incrbyfloat("mykey", 0.1), 10.6;
+$r.set("mykey", 5.0e3);
+is_deeply $r.incrbyfloat("mykey", 2.0e2), 5200;
+
+# set & get
+is_deeply $r.set("key", "value"), True;
+is_deeply $r.get("key"), "value";
+is_deeply $r.get("does_not_exists"), Nil;
+is_deeply $r.set("key2", 100), True;
+is_deeply $r.get("key2"), "100";
+
+# mget
+$r.del("key", "key2");
+is_deeply $r.mset("key", "value", key2 => "value2"), True;
+is_deeply $r.mget("key", "key2"), ["value", "value2"];
+is_deeply $r.msetnx("key", "value", key2 => "value2"), 0;
+
+# psetex
+is_deeply $r.psetex("key", 100, "value"), True;
+is_deeply $r.get("key"), "value";
+sleep(0.1);
+is_deeply $r.get("key"), Nil;
+
+# setbit
+$r.del("mykey");
+is_deeply $r.setbit("mykey", 7, 1), 0;
+is_deeply $r.setbit("mykey", 7, 0), 1;
+
+# setex
+is_deeply $r.setex("key", 1, "value"), True;
+
+# setnx
+is_deeply $r.setnx("key", "value"), False;
+
+# setrange
+is_deeply $r.setrange("key", 2, "123"), 5;
+is_deeply $r.get("key"), "va123";
+
+# strlen
+is_deeply $r.strlen("key"), 5;
+
+###### ! Commands/Strings #######
+
+###### Commands/Keys ######
+
+# del
+is_deeply $r.del("key", "key2", "does_not_exists"), 2;
+
+# dump & restore
+$r.set("key", "value");
+my $serialized = $r.dump("key");
+$r.del("newkey");
+is_deeply $r.restore("newkey", 100, $serialized), True;
+is_deeply $r.get("newkey"), "value";
+
+# exists
+$r.set("key", "value");
+is_deeply $r.exists("key"), True;
+is_deeply $r.exists("does_not_exists"), False;
+
+# expire & persist & pexpire & expireat & pexpireat & pttl & ttl
+is_deeply $r.expire("key", 100), True;
+ok $r.ttl("key") <= 100;
+ok $r.persist("key");
+is_deeply $r.ttl("key"), -1;
+is_deeply $r.pexpire("key", 100000), True;
+is_deeply $r.expireat("key", 100), True;
+is_deeply $r.ttl("key"), -1;
+is_deeply $r.pexpireat("key", 1), False;
+is_deeply $r.pttl("key"), -1;
+
+# keys
+$r.set("pattern1", 1);
+$r.set("pattern2", 2);
+is_deeply $r.keys("pattern*"), ["pattern1", "pattern2"];
+
+# migrate TODO
+
+# move TODO
+
+# object
+$r.set("key", "value");
+is_deeply $r.object("refcount", "key"), 1;
+
+# randomkey
+is_deeply $r.randomkey().WHAT.gist, "Str()";
+
+# rename
+is_deeply $r.rename("key", "newkey"), True;
+
+# renamenx
+{
+ my $failed = 1;
+ try {
+ $r.renamenx("does_not_exists", "newkey");
+ CATCH {
+ default { $failed = 1 }
+ }
+ }
+ ok $failed;
+}
+
+# sort TODO
+#say $r.sort("key", :desc);
+
+
+# type
+$r.set("key", "value");
+is_deeply $r.type("key"), "string";
+is_deeply $r.type("does_not_exists"), "none";
+
+###### ! Commands/Keys ######
+
+###### Commands/Hashes ######
+
+# hset & hget & hmset & hmget & hsetnx
+$r.hdel("hash", "field1");
+is_deeply $r.hset("hash", "field1", 1), True;
+is_deeply $r.hsetnx("hash", "field1", 1), False;
+is_deeply $r.hget("hash", "field1"), "1";
+is_deeply $r.hmset("hash", "key", "value", key2 => "value2"), True;
+is_deeply $r.hmget("hash", "key", "key2"), ["value", "value2"];
+
+# hdel & hexists
+is_deeply $r.hdel("hash", "field1", "key"), 2;
+is_deeply $r.hexists("hash", "field1"), False;
+
+# hgetall
+$r.hset("hash", "count", 1);
+is_deeply $r.hgetall("hash"), {key2 => "value2", count => "1"};
+
+# hincrby & hincrbyfloat
+is_deeply $r.hincrby("hash", "count", 10), 11;
+is_deeply $r.hincrbyfloat("hash", "count", 10.1), 21.1;
+
+# hkeys & hlen & hvals
+is_deeply $r.hkeys("hash"), ["key2", "count"];
+is_deeply $r.hlen("hash"), 2;
+is_deeply $r.hvals("hash"), ["value2", "21.1"];
+
+###### ! Commands/Hashes ######
+
+
+###### Commands/Connection #######
+
+is_deeply $r.ping, True;
+is_deeply $r.quit, True;
+
+###### ! Commands/Connection #######
Please sign in to comment.
Something went wrong with that request. Please try again.