Clojure library thanks to Ragnar Dahlén

client-libraries/README

@@ -31,4 +31,8 @@ Lua lib source code:
 http://github.com/nrk/redis-lua/tree/master
 git://github.com/nrk/redis-lua.git
 
+Clojure lib source code:
+http://github.com/ragnard/redis-clojure/
+git://github.com/ragnard/redis-clojure.git
+
 For all the rest check the Redis tarball or Git repository.

client-libraries/clojure/.gitignore

@@ -0,0 +1,5 @@
+classes
+\#*
+.\#*
+*.jar
+build.properties

client-libraries/clojure/LICENSE

@@ -0,0 +1,22 @@
+Copyright (c) 2009 Ragnar Dahlén (r.dahlen@gmail.com)
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.

client-libraries/clojure/README.markdown

@@ -0,0 +1,49 @@
+# redis-clojure
+
+A Clojure client library for the
+[Redis](http://code.google.com/p/redis) key value storage system.
+
+## Dependencies
+
+To use redis-clojure, you'll need:
+
+* The [Clojure](http://clojure.org) programming language
+* The [Clojure-Contrib](http://code.google.com/p/clojure-contrib) library (for running the tests)
+
+## Building 
+
+To build redis-clojure:
+
+    ant -Dclojure.jar=/path/to/clojure.jar
+
+This will build `redis-clojure.jar`.
+
+## Running tests
+
+To run tests:
+
+    ant -Dclojure.jar=/path/to/clojure.jar -Dclojure-contrib.jar=/path/to/clojure-contrib.jar test
+
+*Note* you need to have `redis-server` running first.
+
+## Using
+
+To use redis-clojure in your application, simply make sure either
+`redis-clojure.jar` or the contents of the `src/` directory is on your
+classpath.
+
+This can be accomplished like so:
+
+    (add-classpath "file:///path/to/redis-clojure.jar")
+
+## Examples
+
+Check the `examples/` directory.
+
+*Note* you need to have `redis-server` running first.
+
+## Todo
+
+* Work on performance
+* Maybe implement pipelining
+

client-libraries/clojure/benchmarks/clojure.clj

@@ -0,0 +1,175 @@
+
+
+(add-classpath "file:///Users/ragge/Projects/clojure/redis-clojure/redis-clojure.jar")
+
+(ns benchmarks.clojure
+  (:use clojure.contrib.pprint)
+  (:require redis))
+
+(defstruct benchmark-options
+  :host
+  :port
+  :db
+  :clients
+  :requests
+  :key-size
+  :keyspace-size
+  :data-size)
+
+
+(defstruct client
+  :id
+  :request-times
+  :requests-performed
+  :requests-per-second)
+
+(defstruct result
+  :options
+  :clients
+  :total-time
+  :requests)
+
+
+
+(defmacro defbenchmark [name & body]
+  (let [benchmark-name (symbol (str name "-benchmark"))]
+    `(def ~(with-meta benchmark-name {:benchmark true})
+          (fn ~benchmark-name
+            [client# options# result#]
+            (redis/with-server
+             {:host (options# :host)
+              :port (options# :port)
+              :db   (options# :db)}
+             (let [requests# (:requests options#)
+                   requests-done# (:requests result#)]
+               (loop [requests-performed# 0 request-times# []]
+                 (if (>= @requests-done# requests#)
+                   (assoc client#
+                     :request-times request-times#
+                     :requests-performed requests-performed#)
+                   (do
+                     (let [start# (System/nanoTime)]
+                       ~@body
+                       (let [end# (System/nanoTime)
+                             elapsed# (/ (float (- end# start#)) 1000000.0)]
+                         (dosync
+                          (commute requests-done# inc))
+                         (recur (inc requests-performed#)
+                                (conj request-times# elapsed#)))))))))))))
+
+(defbenchmark ping
+  (redis/ping))
+
+(defbenchmark get
+  (redis/get (str "key-" (rand-int 1000))))
+
+(defbenchmark set
+  (redis/set (str "key-" (rand-int 1000)) "blahojga!"))
+
+(defbenchmark exists-set-and-get
+  (let [key (str "key-" (rand-int 100))]
+    (redis/exists key)
+    (redis/set    key "blahongaa!")
+    (redis/get    key)))
+
+
+(def *default-options* (struct-map benchmark-options
+                         :host "127.0.0.1"
+                         :port 6379
+                         :db 15
+                         :clients 4
+                         :requests 10000))
+
+(defn create-clients [options]
+  (for [id (range (:clients options))]
+    (agent (struct client id))))
+
+(defn create-result [options clients]
+  (let [result (struct result options clients 0 (ref 0))]
+    result))
+
+
+(defn requests-by-ms [clients]
+  (let [all-times (apply concat (map #(:request-times (deref %)) clients))
+        all-times-in-ms (map #(int (/ % 1)) all-times)]
+    (sort
+     (reduce
+      (fn [m time]
+        (if (m time)
+          (assoc m time (inc (m time)))
+          (assoc m time 1)))
+      {} all-times-in-ms))))
+
+(defn report-request-times [clients requests]
+  (let [requests-dist (map #(let [perc (* 100 (/ (last %) requests))]
+                             (conj % perc)) (requests-by-ms clients))]
+    (dorun
+     (map #(println (format "%.2f%% < %d ms" (float (last %)) (inc (first %))))
+          requests-dist))))
+
+(defn report-client-rps [client]
+  (let [{:keys [id requests-performed request-times]} @client]
+    (when (< 0 requests-performed)
+      (let [total-time (apply + request-times)
+            requests-per-second (/ (float requests-performed)
+                                   total-time)]
+        (println total-time)
+        (println (format "Client %d: %f rps" id (float requests-per-second)))))))
+
+(defn report-result [result]
+  (let [{:keys [clients options]} result
+        name (:name result)
+        time (:total-time result)
+        time-in-seconds (/ time 1000)
+        requests (deref (:requests result)) 
+        requests-per-second (/ requests time-in-seconds)
+        ]
+    (do
+      (println (format "====== %s =====\n" name))
+      (println (format "   %d requests completed in %f seconds\n" requests time-in-seconds))
+      (println (format "   %d parallel clients\n" (:clients options)))
+      ;(report-request-times clients requests)
+      ;(dorun (map report-client-rps clients))
+      (println (format "%f requests per second\n\n" requests-per-second))
+      )
+    )
+  )
+
+
+
+(defn run-benchmark [fn options]
+  (let [clients (create-clients options)
+        result (create-result options clients)
+        start (System/nanoTime)]
+    (dorun
+     (map #(send-off % fn options result) clients))
+    (apply await clients)
+    (let [elapsed (/ (double (- (System/nanoTime) start)) 1000000.0)]
+      (dorun
+       (map #(when (agent-errors %)
+               (pprint (agent-errors %))) clients))
+      (assoc result
+        :name (str fn)
+        :options options
+        :clients clients
+        :total-time elapsed))))
+
+(defn find-all-benchmarks [ns]
+  (filter #(:benchmark (meta %))
+          (vals (ns-map ns))))
+
+(defn run-and-report [fn options]
+  (let [result (run-benchmark fn options)]
+    (report-result result)))
+
+(defn run-all-benchmarks [ns]
+  (let [benchmarks (find-all-benchmarks ns)]
+    (dorun
+     (map #(run-and-report % *default-options*) benchmarks))))
+
+
+;(run-all-benchmarks)
+
+;(report-result (run-benchmark ping-benchmark *default-options*))
+;(run-benchmark get-benchmark *default-options*)
+

client-libraries/clojure/benchmarks/ruby.clj

@@ -0,0 +1,26 @@
+(ns benchmarks.ruby
+  (:require redis))
+
+
+(dotimes [n 2]
+  (redis/with-server 
+   {}
+   (redis/set "foo" "The first line we sent to the server is some text")
+   (time 
+    (dotimes [i 20000]
+      (let [key (str "key" i)]
+        (redis/set key "The first line we sent to the server is some text")
+        (redis/get "foo"))))))
+
+
+;(redis/with-server 
+; {}
+; (redis/set "foo" "The first line we sent to the server is some text")
+; (time 
+;  (dotimes [i 20000]
+;    (let [key (str "push_trim" i)]
+;      (redis/lpush key i)
+;      (redis/ltrim key 0 30)))))
+
+
+

client-libraries/clojure/build.xml

@@ -0,0 +1,90 @@
+<project name="redis" default="jar">
+  <description>
+    Redis client library for Clojure.
+  </description>
+ 
+  <property file="build.properties"/>
+
+  <property name="dist.dir" location="dist"/>
+  <property name="build.dir" location="classes"/>
+  <property name="lib.dir" location="lib"/>
+  <property name="source.dir" location="src"/>
+
+  <property name="redis-clojure.jar" location="redis-clojure.jar"/>
+
+  <target name="clean" description="Remove generated files">
+    <delete file="redis-clojure.jar"/>
+    <delete dir="${build.dir}"/>
+  </target>
+ 
+  <target name="init" depends="clean">
+    <tstamp/>
+    <mkdir dir="${build.dir}"/>
+  </target>
+ 
+  <target name="compile" depends="init" description="Compile sources">
+    <java classname="clojure.lang.Compile"> 
+      <classpath>
+        <path location="${build.dir}"/>
+        <path location="${source.dir}"/>
+        <path location="${clojure.jar}"/>
+        <path location="${clojure-contrib.jar}"/>
+      </classpath>
+      <sysproperty key="clojure.compile.path" value="${build.dir}"/>
+      <arg value="redis" />
+    </java>
+  </target>
+ 
+  <target name="jar" description="Create jar file" depends="compile">
+    <jar jarfile="${redis-clojure.jar}">
+      <path location="LICENSE"/>
+      <fileset dir="${source.dir}" includes="**/*.clj"/>
+      <!--<fileset dir="${build.dir}" includes="**/*.class"/>-->
+      <manifest>
+        <attribute name="Built-By" value="${user.name}"/>
+      </manifest>
+    </jar>
+  </target>
+
+  <target name="test" description="Run tests">
+    <java classname="clojure.main">
+      <classpath>
+        <path location="${source.dir}"/>
+        <path location="${clojure.jar}"/>
+        <path location="${clojure-contrib.jar}"/>
+      </classpath>
+      <arg value="-e" />
+      <arg value="(require 'redis.tests 'redis.tests.internal) (clojure.contrib.test-is/run-tests 'redis.tests 'redis.tests.internal)" />
+    </java>
+  </target>
+
+  <target name="bm" depends="benchmark"/>
+
+  <target name="benchmark" description="Run benchmark">
+    <java classname="clojure.main">
+      <classpath>
+        <path location="${basedir}"/>
+        <path location="${source.dir}"/>
+        <path location="${clojure.jar}"/>
+        <path location="${clojure-contrib.jar}"/>
+      </classpath>
+      <arg value="-e" />
+      <arg value="(require 'benchmarks.clojure) (benchmarks.clojure/run-all-benchmarks 'benchmarks.clojure)" />
+    </java>
+  </target>
+
+  <target name="benchmark-ruby" description="Run benchmark equivalent to the benchmarks of the Ruby library">
+    <java classname="clojure.main">
+      <classpath>
+        <path location="${basedir}"/>
+        <path location="${source.dir}"/>
+        <!--<path location="${redis-clojure.jar}"/>-->
+        <path location="${clojure.jar}"/>
+        <path location="${clojure-contrib.jar}"/>
+      </classpath>
+      <arg value="-e" />
+      <arg value="(require 'benchmarks.ruby)" />
+    </java>
+  </target>
+
+</project>

client-libraries/clojure/examples/demo.clj

@@ -0,0 +1,33 @@
+;; 
+;; Simple demo of redis-clojure functionality
+;;
+;; Make sure redis-clojure.jar or the contents of the src/ directory
+;; is on the classpath.
+;;
+;; Either:
+;;   (add-classpath "file:///path/to/redis-clojure.jar"
+;; or:
+;;   (add-classpath "file:///path/to/redis/src-dir/")
+;;
+
+(add-classpath "file:///Users/ragge/Projects/clojure/redis-clojure/redis-clojure.jar")
+
+(ns demo
+  (:require redis))
+
+
+(redis/with-server
+  {:host "127.0.0.1" :port 6379 :db 0}
+  (do
+    (println "Sending ping")
+    (println "Reply:" (redis/ping))
+    (println "Server info:")
+    (let [info (redis/info)]
+      (dorun
+       (map (fn [entry]
+              (println (str "- "(first entry) ": " (last entry)))) info)))
+    (println "Setting key 'foo' to 'bar'")
+    (println "Reply:" (redis/set "foo" "bar"))
+    (println "Getting value of key 'foo'")
+    (println "Reply:" (redis/get "foo"))))
+

client-libraries/clojure/src/redis.clj

@@ -0,0 +1,127 @@
+;(add-classpath "file:///Users/ragge/Projects/clojure/redis-clojure/src/")
+
+(set! *warn-on-reflection* true)
+
+(ns redis
+  (:refer-clojure :exclude [get set type keys sort])
+  (:use redis.internal))
+
+(defmacro with-server
+  "Evaluates body in the context of a new connection to a Redis server
+  then closes the connection.
+
+  server-spec is a map with any of the following keys:
+    :host     hostname (default \"127.0.0.1\")
+    :port     port (default 6379)
+    :db       database to use (default 0)"
+  [server-spec & body]
+  `(with-server* ~server-spec (fn []
+                                (do
+                                  (redis/select (:db *server*))
+                                  ~@body))))
+
+
+;;
+;; Reply conversion functions
+;;
+(defn int-to-bool
+  "Convert integer reply to a boolean value"
+  [int]
+  (= 1 int))
+
+(defn string-to-keyword
+  "Convert a string reply to a keyword"
+  [string]
+  (keyword string))
+
+(defn string-to-seq
+  "Convert a space separated string to a sequence of words"
+  [#^String string]
+  (if (empty? string)
+    nil
+    (re-seq #"\S+" string)))
+
+(defn string-to-map
+  "Convert strings with format 'key:value\r\n'+ to a map with {key
+  value} pairs"
+  [#^String string]
+  (let [lines (.split string "(\\r\\n|:)")]
+    (apply hash-map lines)))
+
+(defn int-to-date
+  "Return a Date representation of a UNIX timestamp"
+  [int]
+  (new java.util.Date (long int)))
+
+(defn seq-to-set
+  [sequence]
+  (clojure.core/set sequence))
+
+;;
+;; Commands
+;;
+(defcommands
+  ;; Connection handling
+  (auth        [] :inline)
+  (quit        [password] :inline)
+  (ping        [] :inline)
+  ;; String commands
+  (set         [key value] :bulk)
+  (get         [key] :inline)
+  (getset      [key value] :bulk)
+  (setnx       [key value] :bulk int-to-bool)
+  (incr        [key] :inline)
+  (incrby      [key integer] :inline)
+  (decr        [key] :inline)
+  (decrby      [key integer] :inline)
+  (exists      [key] :inline int-to-bool)
+  (mget        [key & keys] :inline)
+  (del         [key] :inline int-to-bool)
+  ;; Key space commands
+  (type        [key] :inline string-to-keyword)
+  (keys        [pattern] :inline string-to-seq)
+  (randomkey   [] :inline)
+  (rename      [oldkey newkey] :inline)
+  (renamenx    [oldkey newkey] :inline int-to-bool)
+  (dbsize      [] :inline)
+  (expire      [key seconds] :inline int-to-bool)
+  (ttl         [key] :inline)
+  ;; List commands
+  (rpush       [key value] :bulk)
+  (lpush       [key value] :bulk)
+  (llen        [key] :inline)
+  (lrange      [key start end] :inline)
+  (ltrim       [key start end] :inline)
+  (lindex      [key index] :inline)
+  (lset        [key index value] :bulk)
+  (lrem        [key count value] :bulk)
+  (lpop        [key] :inline)
+  (rpop        [key] :inline)
+  ;; Set commands
+  (sadd        [key member] :bulk int-to-bool)
+  (srem        [key member] :bulk int-to-bool)
+  (smove       [srckey destkey member] :bulk int-to-bool)
+  (scard       [key] :inline)
+  (sismember   [key member] :bulk int-to-bool)
+  (sinter      [key & keys] :inline seq-to-set)
+  (sinterstore [destkey key & keys] :inline)
+  (sunion      [key & keys] :inline seq-to-set)
+  (sunionstore [destkey key & keys] :inline)
+  (sdiff       [key & keys] :inline seq-to-set)
+  (sdiffstore  [destkey key & keys] :inline)
+  (smembers    [key] :inline seq-to-set)
+  ;; Multiple database handling commands
+  (select      [index] :inline)
+  (move        [key dbindex] :inline)
+  (flushdb     [] :inline)
+  (flushall    [] :inline)
+  ;; Sorting
+  (sort        [key & options] :sort)
+  ;; Persistence
+  (save        [] :inline)
+  (bgsave      [] :inline)
+  (lastsave    [] :inline int-to-date)
+  (shutdown    [] :inline)
+  (info        [] :inline string-to-map)
+  ;;(monitor     [] :inline))
+)

client-libraries/clojure/src/redis/internal.clj

@@ -0,0 +1,263 @@
+(ns redis.internal
+  (:import [java.io InputStream 
+                    OutputStream
+                    Reader
+                    InputStreamReader
+                    BufferedReader]
+           [java.net Socket]))
+
+
+
+(def *cr* 0x0d)
+(def *lf* 0x0a)
+(defn- cr? [c] (= c *cr*))
+(defn- lf? [c] (= c *lf*))
+
+(defn- uppercase [#^String s] (.toUpperCase s))
+(defn- trim [#^String s] (.trim s))
+(defn- parse-int [#^String s] (Integer/parseInt s))
+(defn- char-array [len] (make-array Character/TYPE len))
+
+(def *default-host* "127.0.0.1")
+(def *default-port* 6379)
+(def *default-db* 0)
+(def *default-timeout* 5) 
+
+
+(defstruct server :host :port :db :timeout :socket)
+
+(def *server* (struct-map server
+                :host     *default-host*
+                :port     *default-port*
+                :db       *default-db*
+                :timeout  *default-timeout* ;; not yet used
+                :socket   nil))
+
+(defn connect-to-server
+  "Create a Socket connected to server"
+  [server]
+  (let [{:keys [host port timeout]} server
+        socket (Socket. #^String host #^Integer port)]
+    (doto socket
+      (.setTcpNoDelay true))))
+
+(defn with-server*
+  [server-spec func]
+  (let [server (merge *server* server-spec)]
+    (with-open [#^Socket socket (connect-to-server server)]
+      (binding [*server* (assoc server :socket socket)]
+        (func)))))
+
+(defn socket* []
+  (or (:socket *server*)
+      (throw (Exception. "Not connected to a Redis server"))))
+
+(defn send-command
+  "Send a command string to server"
+  [#^String cmd]
+  (let [out (.getOutputStream (#^Socket socket*))
+        bytes (.getBytes cmd)]
+    (.write out bytes)))
+
+
+(defn read-crlf
+  "Read a CR+LF combination from Reader"
+  [#^Reader reader]
+  (let [cr (.read reader)
+        lf (.read reader)]
+    (when-not
+        (and (cr? cr)
+             (lf? lf))
+      (throw (Exception. "Error reading CR/LF")))
+    nil))
+
+(defn read-line-crlf
+  "Read from reader until exactly a CR+LF combination is
+  found. Returns the line read without trailing CR+LF.
+
+  This is used instead of Reader.readLine() method since it tries to
+  read either a CR, a LF or a CR+LF, which we don't want in this
+  case."
+  [#^Reader reader]
+  (loop [line []
+         c (.read reader)]
+    (when (< c 0)
+      (throw (Exception. "Error reading line: EOF reached before CR/LF sequence")))
+    (if (cr? c)
+      (let [next (.read reader)]
+        (if (lf? next)
+          (apply str line)
+          (throw (Exception. "Error reading line: Missing LF"))))
+      (recur (conj line (char c))
+             (.read reader)))))
+
+;;
+;; Reply dispatching
+;;
+
+
+
+(defn reply-type
+  ([#^BufferedReader reader]
+     (let [type (char (.read reader))]
+       type)))
+
+(defmulti parse-reply reply-type :default :unknown)
+
+(defn read-reply
+  ([]
+     (let [input-stream (.getInputStream (#^Socket socket*))
+           reader (BufferedReader. (InputStreamReader. input-stream))]
+       (read-reply reader)))
+  ([#^BufferedReader reader]
+     (parse-reply reader)))
+
+(defmethod parse-reply :unknown
+  [#^BufferedReader reader]
+  (throw (Exception. (str "Unknown reply type:"))))
+
+(defmethod parse-reply \-
+  [#^BufferedReader reader]
+  (let [error (read-line-crlf reader)]
+    (throw (Exception. (str "Server error: " error)))))
+
+(defmethod parse-reply \+
+  [#^BufferedReader reader]
+  (read-line-crlf reader))
+
+(defmethod parse-reply \$
+  [#^BufferedReader reader]
+  (let [line (read-line-crlf reader)
+        length (parse-int line)]
+    (if (< length 0)
+      nil
+      (let [#^chars cbuf (char-array length)
+            nread (.read reader cbuf 0 length)]
+        (if (not= nread length)
+          (throw (Exception. "Could not read correct number of bytes"))
+          (do
+            (read-crlf reader) ;; CRLF
+            (String. cbuf)))))))
+
+(defmethod parse-reply \*
+  [#^BufferedReader reader]
+  (let [line (read-line-crlf reader)
+        count (parse-int line)]
+    (if (< count 0)
+      nil
+      (loop [i count
+             replies []]
+        (if (zero? i)
+          replies
+          (recur (dec i) (conj replies (read-reply reader))))))))
+
+(defmethod parse-reply \:
+  [#^BufferedReader reader]
+  (let [line (trim (read-line-crlf reader))
+        int (parse-int line)]
+    int))
+
+
+
+(defn str-join
+  "Join elements in sequence with separator"
+  [separator sequence]
+  (apply str (interpose separator sequence)))
+
+
+(defn inline-command
+  "Create a string for an inline command"
+  [name & args]
+  (let [cmd (str-join " " (conj args name))]
+    (str cmd "\r\n")))
+
+(defn bulk-command
+  "Create a string for an bulk command"
+  [name & args]
+  (let [data (str (last args))
+        data-length (count (str data))
+        args* (concat (butlast args) [data-length])
+        cmd (apply inline-command name args*)]
+    (str cmd data "\r\n")))
+
+
+(defn- sort-command-args-to-string
+  [args]
+  (loop [arg-strings []
+         args args]
+    (if (empty? args)
+      (str-join " " arg-strings)
+      (let [type (first args)
+            args (rest args)]
+        (condp = type
+          :by (let [pattern (first args)]
+                (recur (conj arg-strings "BY" pattern)
+                       (rest args)))
+          :limit (let [start (first args)
+                       end (second args)]
+                   (recur (conj arg-strings "LIMIT" start end)
+                          (drop 2 args)))
+          :get (let [pattern (first args)]
+                 (recur (conj arg-strings "GET" pattern)
+                        (rest args)))
+          :alpha (recur (conj arg-strings "ALPHA") args)
+          :asc  (recur (conj arg-strings "ASC") args)
+          :desc (recur (conj arg-strings "DESC") args)
+          (throw (Exception. (str "Error parsing SORT arguments: Unknown argument: " type))))))))
+
+(defn sort-command
+  [name & args]
+  (when-not (= name "SORT")
+    (throw (Exception. "Sort command name must be 'SORT'")))
+  (let [key (first args)
+        arg-string (sort-command-args-to-string (rest args))
+        cmd (str "SORT " key)]
+    (if (empty? arg-string)
+      (str cmd "\r\n")
+      (str cmd " " arg-string "\r\n"))))
+
+
+(def command-fns {:inline 'inline-command
+                  :bulk   'bulk-command
+                  :sort   'sort-command})
+
+
+(defn parse-params
+  "Return a restructuring of params, which is of form:
+     [arg* (& more)?]
+  into
+     [(arg1 arg2 ..) more]"
+  [params]
+  (let [[args rest] (split-with #(not= % '&) params)]
+    [args (last rest)]))
+
+(defmacro defcommand
+  "Define a function for Redis command name with parameters
+  params. Type is one of :inline or :bulk, which determines how the
+  command string is constructued."
+  ([name params type] `(defcommand ~name ~params ~type (fn [reply#] reply#)))
+  ([name params type reply-fn] `(~name ~params ~type ~reply-fn)
+     (do
+       (let [command (uppercase (str name))
+             command-fn (type command-fns)
+             [command-params
+              command-params-rest] (parse-params params)]
+         `(defn ~name
+            ~params
+            (let [request# (apply ~command-fn
+                                  ~command
+                                  ~@command-params
+                                  ~command-params-rest)]
+              (send-command request#)
+              (~reply-fn (read-reply)))))
+       
+       )))
+
+
+(defmacro defcommands
+  [& command-defs]
+  `(do ~@(map (fn [command-def]
+              `(defcommand ~@command-def)) command-defs)))
+
+
+

client-libraries/clojure/src/redis/tests.clj

@@ -0,0 +1,387 @@
+(ns redis.tests
+  (:refer-clojure :exclude [get set keys type sort])
+  (:require redis)
+  (:use [clojure.contrib.test-is]))
+
+
+(defn server-fixture [f]
+  (redis/with-server
+   {:host "127.0.0.1"
+    :port 6379
+    :db 15}
+   ;; String value
+   (redis/set "foo" "bar")
+   ;; List with three items
+   (redis/rpush "list" "one")
+   (redis/rpush "list" "two")
+   (redis/rpush "list" "three")
+   ;; Set with three members
+   (redis/sadd "set" "one")
+   (redis/sadd "set" "two")
+   (redis/sadd "set" "three")
+   (f)
+   (redis/flushdb)))
+                     
+(use-fixtures :each server-fixture)
+
+(deftest ping
+  (is (= "PONG" (redis/ping))))
+
+(deftest set
+  (redis/set "bar" "foo")
+  (is (= "foo" (redis/get "bar")))
+  (redis/set "foo" "baz")
+  (is (= "baz" (redis/get "foo"))))
+
+(deftest get
+  (is (= nil (redis/get "bar")))
+  (is (= "bar" (redis/get "foo"))))
+
+(deftest getset
+  (is (= nil   (redis/getset "bar" "foo")))
+  (is (= "foo" (redis/get "bar")))
+  (is (= "bar" (redis/getset "foo" "baz")))
+  (is (= "baz" (redis/get "foo"))))
+
+(deftest mget
+  (is (= [nil] (redis/mget "bar")))
+  (redis/set "bar" "baz")
+  (redis/set "baz" "buz")
+  (is (= ["bar"] (redis/mget "foo")))
+  (is (= ["bar" "baz"] (redis/mget "foo" "bar")))
+  (is (= ["bar" "baz" "buz"] (redis/mget "foo" "bar" "baz")))
+  (is (= ["bar" nil "buz"] (redis/mget "foo" "bra" "baz")))
+  )
+
+(deftest setnx
+  (is (= true (redis/setnx "bar" "foo")))
+  (is (= "foo" (redis/get "bar")))
+  (is (= false (redis/setnx "foo" "baz")))
+  (is (= "bar" (redis/get "foo"))))
+
+(deftest incr
+  (is (= 1 (redis/incr "nonexistent")))
+  (is (= 1 (redis/incr "foo")))
+  (is (= 2 (redis/incr "foo"))))
+
+(deftest incrby
+  (is (= 42 (redis/incrby "nonexistent" 42)))
+  (is (= 0 (redis/incrby "foo" 0)))
+  (is (= 5 (redis/incrby "foo" 5))))
+
+(deftest decr
+  (is (= -1 (redis/decr "nonexistent")))
+  (is (= -1 (redis/decr "foo")))
+  (is (= -2 (redis/decr "foo"))))
+
+(deftest decrby
+  (is (= -42 (redis/decrby "nonexistent" 42)))
+  (is (= 0 (redis/decrby "foo" 0)))
+  (is (= -5 (redis/decrby "foo" 5))))
+
+(deftest exists
+  (is (= true (redis/exists "foo")))
+  (is (= false (redis/exists "nonexistent"))))
+
+(deftest del
+  (is (= false (redis/del "nonexistent")))
+  (is (= true (redis/del "foo")))
+  (is (= nil  (redis/get "foo"))))
+
+(deftest type
+  (is (= :none (redis/type "nonexistent")))
+  (is (= :string (redis/type "foo")))
+  (is (= :list (redis/type "list")))
+  (is (= :set (redis/type "set"))))
+
+(deftest keys
+  (is (= nil (redis/keys "a*")))
+  (is (= ["foo"] (redis/keys "f*")))
+  (is (= ["foo"] (redis/keys "f?o")))
+  (redis/set "fuu" "baz")
+  (is (= #{"foo" "fuu"} (clojure.core/set (redis/keys "f*")))))
+
+(deftest randomkey
+  (redis/flushdb)
+  (redis/set "foo" "bar")
+  (is (= "foo" (redis/randomkey)))
+  (redis/flushdb)
+  (is (= "" (redis/randomkey))))
+
+(deftest rename
+  (is (thrown? Exception (redis/rename "foo" "foo")))
+  (is (thrown? Exception (redis/rename "nonexistent" "foo")))
+  (redis/rename "foo" "bar")
+  (is (= "bar" (redis/get "bar")))
+  (is (= nil (redis/get "foo")))
+  (redis/set "foo" "bar")
+  (redis/set "bar" "baz")
+  (redis/rename "foo" "bar")
+  (is (= "bar" (redis/get "bar")))
+  (is (= nil (redis/get "foo")))
+  )
+
+(deftest renamenx
+  (is (thrown? Exception (redis/renamenx "foo" "foo")))
+  (is (thrown? Exception (redis/renamenx "nonexistent" "foo")))
+  (is (= true (redis/renamenx "foo" "bar")))
+  (is (= "bar" (redis/get "bar")))
+  (is (= nil (redis/get "foo")))
+  (redis/set "foo" "bar")
+  (redis/set "bar" "baz")
+  (is (= false (redis/renamenx "foo" "bar")))
+  )
+
+(deftest dbsize
+  (let [size-before (redis/dbsize)]
+    (redis/set "anewkey" "value")
+    (let [size-after (redis/dbsize)]
+      (is (= size-after
+             (+ 1 size-before))))))
+
+(deftest expire
+  (is (= true (redis/expire "foo" 1)))
+  (Thread/sleep 2000)
+  (is (= false (redis/exists "foo")))
+  (redis/set "foo" "bar")
+  (is (= true (redis/expire "foo" 20)))
+  (is (= false (redis/expire "foo" 10)))
+  (is (= false (redis/expire "nonexistent" 42)))
+  )
+
+(deftest ttl
+  (is (= -1 (redis/ttl "nonexistent")))
+  (is (= -1 (redis/ttl "foo")))
+  (redis/expire "foo" 42)
+  (is (< 40 (redis/ttl "foo"))))
+
+
+;;
+;; List commands
+;;
+(deftest rpush
+  (is (thrown? Exception (redis/rpush "foo")))
+  (redis/rpush "newlist" "one")
+  (is (= 1 (redis/llen "newlist")))
+  (is (= "one" (redis/lindex "newlist" 0)))
+  (redis/del "newlist")
+  (redis/rpush "list" "item")
+  (is (= "item" (redis/rpop "list"))))
+
+(deftest lpush
+  (is (thrown? Exception (redis/lpush "foo")))
+  (redis/lpush "newlist" "item")
+  (is (= 1 (redis/llen "newlist")))
+  (is (= "item" (redis/lindex "newlist" 0)))
+  (redis/lpush "list" "item")
+  (is (= "item" (redis/lpop "list"))))
+
+(deftest llen
+  (is (thrown? Exception (redis/llen "foo")))
+  (is (= 0 (redis/llen "newlist")))
+  (is (= 3 (redis/llen "list"))))
+
+(deftest lrange
+  (is (thrown? Exception (redis/lrange "foo" 0 1)))
+  (is (= nil (redis/lrange "newlist" 0 42)))
+  (is (= ["one"] (redis/lrange "list" 0 0)))
+  (is (= ["three"] (redis/lrange "list" -1 -1)))
+  (is (= ["one" "two"] (redis/lrange "list" 0 1)))
+  (is (= ["one" "two" "three"] (redis/lrange "list" 0 2)))
+  (is (= ["one" "two" "three"] (redis/lrange "list" 0 42)))
+  (is (= [] (redis/lrange "list" 42 0)))
+)
+
+;; TBD
+(deftest ltrim
+  (is (thrown? Exception (redis/ltrim "foo" 0 0))))
+
+(deftest lindex
+  (is (thrown? Exception (redis/lindex "foo" 0)))
+  (is (= nil (redis/lindex "list" 42)))
+  (is (= nil (redis/lindex "list" -4)))
+  (is (= "one" (redis/lindex "list" 0)))
+  (is (= "three" (redis/lindex "list" 2)))
+  (is (= "three" (redis/lindex "list" -1))))
+
+(deftest lset
+  (is (thrown? Exception (redis/lset "foo" 0 "bar")))
+  (is (thrown? Exception (redis/lset "list" 42 "value")))
+  (redis/lset "list" 0 "test")
+  (is (= "test" (redis/lindex "list" 0)))
+  (redis/lset "list" 2 "test2")
+  (is (= "test2" (redis/lindex "list" 2)))
+  (redis/lset "list" -1 "test3")
+  (is (= "test3" (redis/lindex "list" 2))))
+
+
+;; TBD
+(deftest lrem
+  (is (thrown? Exception (redis/lrem "foo" 0 "bar")))
+  (is (= 0 (redis/lrem "list" 0 ""))))
+
+
+(deftest lpop
+  (is (thrown? Exception (redis/lpop "foo")))
+  (is (= "one" (redis/lpop "list"))))
+
+(deftest rpop
+  (is (thrown? Exception (redis/rpop "foo")))
+  (is (= "three" (redis/rpop "list"))))
+
+;;
+;; Set commands
+;;
+(deftest sadd
+  (is (thrown? Exception (redis/sadd "foo" "bar")))
+  (is (= true (redis/sadd "newset" "member")))
+  (is (= true (redis/sismember "newset" "member")))
+  (is (= false (redis/sadd "set" "two")))
+  (is (= true (redis/sadd "set" "four")))
+  (is (= true (redis/sismember "set" "four"))))
+
+(deftest srem
+  (is (thrown? Exception (redis/srem "foo" "bar")))
+  (is (thrown? Exception (redis/srem "newset" "member")))
+  (is (= true (redis/srem "set" "two")))
+  (is (= false (redis/sismember "set" "two")))
+  (is (= false (redis/srem "set" "blahonga"))))
+
+(deftest smove
+  (is (thrown? Exception (redis/smove "foo" "set" "one")))
+  (is (thrown? Exception (redis/smove "set" "foo" "one")))
+  (redis/sadd "set1" "two")
+  (is (= false (redis/smove "set" "set1" "four")))
+  (is (= #{"two"} (redis/smembers "set1")))
+  (is (= true (redis/smove "set" "set1" "one")))
+  (is (= #{"one" "two"} (redis/smembers "set1"))))
+
+(deftest scard
+  (is (thrown? Exception (redis/scard "foo")))
+  (is (= 3 (redis/scard "set"))))
+
+(deftest sismember
+  (is (thrown? Exception (redis/sismember "foo" "bar")))
+  (is (= false (redis/sismember "set" "blahonga")))
+  (is (= true (redis/sismember "set" "two"))))
+
+(deftest sinter
+  (is (thrown? Exception (redis/sinter "foo" "set")))
+  (is (= #{} (redis/sinter "nonexistent")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (is (= #{"one" "two" "three"} (redis/sinter "set")))
+  (is (= #{"one"} (redis/sinter "set" "set1")))
+  (is (= #{} (redis/sinter "set" "set1" "nonexistent"))))
+
+(deftest sinterstore
+  (redis/sinterstore "foo" "set")
+  (is (= #{"one" "two" "three"} (redis/smembers "foo")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (redis/sinterstore "newset" "set" "set1")
+  (is (= #{"one"} (redis/smembers "newset"))))
+
+(deftest sunion
+  (is (thrown? Exception (redis/sunion "foo" "set")))
+  (is (= #{} (redis/sunion "nonexistent")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (is (= #{"one" "two" "three"} (redis/sunion "set")))
+  (is (= #{"one" "two" "three" "four"} (redis/sunion "set" "set1")))
+  (is (= #{"one" "two" "three" "four"} (redis/sunion "set" "set1" "nonexistent"))))
+
+(deftest sunionstore
+  (redis/sunionstore "foo" "set")
+  (is (= #{"one" "two" "three"} (redis/smembers "foo")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (redis/sunionstore "newset" "set" "set1")
+  (is (= #{"one" "two" "three" "four"} (redis/smembers "newset"))))
+
+(deftest sdiff
+  (is (thrown? Exception (redis/sdiff "foo" "set")))
+  (is (= #{} (redis/sdiff "nonexistent")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (is (= #{"one" "two" "three"} (redis/sdiff "set")))
+  (is (= #{"two" "three"} (redis/sdiff "set" "set1")))
+  (is (= #{"two" "three"} (redis/sdiff "set" "set1" "nonexistent"))))
+
+(deftest sdiffstore
+  (redis/sdiffstore "foo" "set")
+  (is (= #{"one" "two" "three"} (redis/smembers "foo")))
+  (redis/sadd "set1" "one")
+  (redis/sadd "set1" "four")
+  (redis/sdiffstore "newset" "set" "set1")
+  (is (= #{"two" "three"} (redis/smembers "newset"))))
+
+(deftest smembers
+  (is (thrown? Exception (redis/smembers "foo")))
+  (is (= #{"one" "two" "three"} (redis/smembers "set"))))
+
+
+;;
+;; Sorting
+;;
+(deftest sort
+  (redis/lpush "ids" 1)
+  (redis/lpush "ids" 4)
+  (redis/lpush "ids" 2)
+  (redis/lpush "ids" 3)
+  (redis/set "object_1" "one")
+  (redis/set "object_2" "two")
+  (redis/set "object_3" "three")
+  (redis/set "object_4" "four")
+  (redis/set "name_1" "Derek")
+  (redis/set "name_2" "Charlie")
+  (redis/set "name_3" "Bob")
+  (redis/set "name_4" "Alice")
+
+  (is (= ["one" "two" "three"]
+         (redis/sort "list")))
+  (is (= ["one" "three" "two"]
+         (redis/sort "list" :alpha)))
+  (is (= ["1" "2" "3" "4"]
+         (redis/sort "ids")))
+  (is (= ["1" "2" "3" "4"]
+         (redis/sort "ids" :asc)))
+  (is (= ["4" "3" "2" "1"]
+         (redis/sort "ids" :desc)))
+  (is (= ["1" "2"]
+         (redis/sort "ids" :asc :limit 0 2)))
+  (is (= ["4" "3"]
+         (redis/sort "ids" :desc :limit 0 2)))
+  (is (= ["4" "3" "2" "1"]
+         (redis/sort "ids" :by "name_*" :alpha)))
+  (is (= ["one" "two" "three" "four"]
+         (redis/sort "ids" :get "object_*")))
+  (is (= ["one" "two"]
+         (redis/sort "ids" :by "name_*" :alpha :limit 0 2 :desc :get "object_*"))))
+
+
+
+;;
+;; Multiple database handling commands
+;;
+(deftest select
+  (redis/select 0)
+  (is (= nil (redis/get "akeythat_probably_doesnotexsistindb0"))))
+
+(deftest flushdb
+  (redis/flushdb)
+  (is (= 0 (redis/dbsize))))
+
+;;
+;; Persistence commands
+;;
+(deftest save
+  (redis/save))
+
+(deftest bgsave
+  (redis/bgsave))
+
+(deftest lastsave
+  (let [ages-ago (new java.util.Date (long 1))]
+    (is (.before ages-ago (redis/lastsave)))))
+

client-libraries/clojure/src/redis/tests/internal.clj

@@ -0,0 +1,156 @@
+(ns redis.tests.internal
+  (:require [redis.internal :as redis])
+  (:use [clojure.contrib.test-is])
+  (:import [java.io StringReader BufferedReader]))
+
+
+
+
+
+
+
+;;
+;; Helpers
+;;
+
+(defn- wrap-in-reader
+  [#^String s]
+  (let [reader (BufferedReader. (StringReader. s))]
+    reader))
+
+(defn- read-reply
+  [#^String s]
+  (redis/read-reply (wrap-in-reader s)))
+
+
+;;
+;; Command generation
+;;
+(deftest inline-command
+  (is (= "FOO\r\n"
+         (redis/inline-command "FOO")))
+  (is (= "FOO bar\r\n"
+         (redis/inline-command "FOO" "bar")))
+  (is (= "FOO bar baz\r\n"
+         (redis/inline-command "FOO" "bar" "baz"))))
+
+(deftest bulk-command
+  (is (= "FOO 3\r\nbar\r\n"
+         (redis/bulk-command "FOO" "bar")))
+  (is (= "SET foo 3\r\nbar\r\n"
+         (redis/bulk-command "SET" "foo" "bar")))
+  (is (= "SET foo bar 3\r\nbaz\r\n"
+         (redis/bulk-command "SET" "foo" "bar" "baz"))))
+
+(deftest sort-command
+  (is (= "SORT key\r\n"
+         (redis/sort-command "SORT" "key")))
+  (is (= "SORT key BY pattern\r\n"
+         (redis/sort-command "SORT" "key" :by "pattern")))
+  (is (= "SORT key LIMIT 0 10\r\n"
+         (redis/sort-command "SORT" "key" :limit 0 10)))
+  (is (= "SORT key ASC\r\n"
+         (redis/sort-command "SORT" "key" :asc)))
+  (is (= "SORT key DESC\r\n"
+         (redis/sort-command "SORT" "key" :desc)))
+  (is (= "SORT key ALPHA\r\n"
+         (redis/sort-command "SORT" "key" :alpha)))
+  (is (= "SORT key GET object_* GET object2_*\r\n"
+         (redis/sort-command "SORT" "key" :get "object_*" :get "object2_*")))
+  (is (= "SORT key BY weight_* LIMIT 0 10 GET object_* ALPHA DESC\r\n"
+         (redis/sort-command "SORT" "key"
+                             :by "weight_*"
+                             :limit 0 10
+                             :get "object_*"
+                             :alpha
+                             :desc))))
+
+
+;;
+;; Reply parsing
+;;
+(deftest read-crlf
+  (is (thrown? Exception
+               (redis/read-crlf (wrap-in-reader "\n"))))
+  (is (thrown? Exception
+               (redis/read-crlf (wrap-in-reader ""))))
+  (is (thrown? Exception
+               (redis/read-crlf (wrap-in-reader "\r1"))))
+  (is (= nil
+         (redis/read-crlf (wrap-in-reader "\r\n")))))
+
+;; (deftest read-newline-crlf
+;;   (is (thrown? Exception
+;;                (redis/read-line-crlf (wrap-in-reader "")))))
+
+;;
+;; Reply parsing
+;;
+(deftest reply
+  (is (thrown? Exception
+               (read-reply "")))
+  (is (thrown? Exception
+               (read-reply "\r\n"))))
+
+
+(deftest error-reply
+  (is (thrown?
+         Exception 
+         (read-reply "-\r\n")))
+  (is (thrown-with-msg?
+         Exception #".*Test"
+         (read-reply "-Test\r\n"))))
+
+(deftest simple-reply
+  (is (thrown? Exception
+               (read-reply "+")))
+  (is (= ""
+         (read-reply "+\r\n")))
+  (is (= "foobar"
+         (read-reply "+foobar\r\n"))))
+
+(deftest integer-reply
+  (is (thrown? Exception
+               (read-reply ":\r\n")))
+  (is (= 0
+         (read-reply ":0\r\n")))
+  (is (= 42
+         (read-reply ":42\r\n")))
+  (is (= 42
+         (read-reply ":  42  \r\n")))
+  (is (= 429348754
+         (read-reply ":429348754\r\n"))))
+
+(deftest bulk-reply
+  (is (thrown? Exception
+               (read-reply "$\r\n")))
+  (is (thrown? Exception
+               (read-reply "$2\r\n1\r\n")))
+  (is (thrown? Exception
+               (read-reply "$3\r\n1\r\n")))
+  (is (= nil
+         (read-reply "$-1\r\n")))
+  (is (= "foobar"
+         (read-reply "$6\r\nfoobar\r\n")))
+  (is (= "foo\r\nbar"
+         (read-reply "$8\r\nfoo\r\nbar\r\n"))))
+
+(deftest multi-bulk-reply
+  (is (thrown? Exception
+               (read-reply "*1\r\n")))
+  (is (thrown? Exception
+               (read-reply "*4\r\n:0\r\n:0\r\n:0\r\n")))
+  (is (= nil
+         (read-reply "*-1\r\n")))
+  (is (= [1]
+         (read-reply "*1\r\n:1\r\n")))
+  (is (= ["foo" "bar"]
+         (read-reply "*2\r\n+foo\r\n+bar\r\n")))
+  (is (= [1 "foo" "foo\r\nbar"]
+         (read-reply "*3\r\n:1\r\n+foo\r\n$8\r\nfoo\r\nbar\r\n"))))
+
+
+
+
+
+

redis.c

@@ -2892,8 +2892,8 @@ static void ltrimCommand(redisClient *c) {
                 ln = listLast(list);
                 listDelNode(list,ln);
             }
-            addReply(c,shared.ok);
             server.dirty++;
+            addReply(c,shared.ok);
         }
     }
 }