1 files changed, 95 insertions, 0 deletions
diff --git a/test/dumpfm/millstone.clj b/test/dumpfm/millstone.clj
new file mode 100644
index 0000000..e59bb61
--- /dev/null
+++ b/test/dumpfm/millstone.clj
@@ -0,0 +1,95 @@
+(ns dumpfm.millstone
+  (:use clojure.contrib.def
+	clojure.contrib.seq-utils
+	clojure-http.client))
+
+(def *spec*)
+(def *cookies*)
+
+(def printer (agent nil))
+
+(defn log [& args]
+  (send printer (fn [_] (apply println args))))
+
+(defmacro with-timing [e]
+  `(let [s# (System/nanoTime)
+         r# ~e
+         f# (System/nanoTime)]
+     [(float (/ (- f# s#) 1e6)) r#]))
+
+(defn do-base-request [server path method cookies params]
+  (let [method (.toUpperCase method)
+	url    (str server path)]
+    (if (= method "GET")
+      (request (add-query-params url params) method nil cookies)
+      (request url method nil cookies params))))
+
+(defnk do-setup-request! [path
+			  :params nil
+			  :method "GET"]
+  (let [res (do-base-request (:server *spec*) path method *cookies* params)]
+    (if (:cookies res)
+      (set! *cookies* (merge *cookies* (:cookies res))))
+    res))
+
+(defnk do-request! [path
+		    :params nil
+		    :method :GET]
+  (let [[time res] (with-timing
+		     (do-base-request (:server *spec*)
+				      path
+				      method
+				      *cookies*
+				      params))]
+    (log (format "%s - %sms [%s %s]" path time (:code res) (:msg res)))
+    (if (:cookies res)
+      (log "should set cookies" (:cookies res)))
+    res))
+
+(defn build-client! [spec client-id]
+  (binding [*cookies*   {}]
+    (if (:setup-func spec)
+      ((:setup-func spec)))
+    {:client-id client-id
+     :cookies   *cookies*}))
+
+(defn print-run-results [spec elapsed]
+  (log (format "\nFinished\n--------\n%s runs in %s s (%s r/s)\n%s clients"
+	       (:requests spec)
+	       (/ elapsed 1000)
+	       (/ (:requests spec) elapsed 1000)
+	       (:clients spec))))
+
+(defn build-func-list [routes]
+  (flatten (for [[n f] routes]
+	     (repeat n f))))
+
+(defn grind! [spec]
+  (binding [*spec* spec]
+    (let [clients (doall
+		   (for [id (range (:clients spec))]
+		     (build-client! spec id)))
+	  funcs     (build-func-list (:funcs spec))
+	  results   (atom [])
+	  counter   (atom (:requests spec))
+	  threads (doall
+		   (for [c clients]
+		     (Thread.
+		      (fn []
+			(log "starting thread" (:client-id c))
+			(binding [*spec* spec
+				  *cookies* (:cookies c)]
+			  (loop []
+			    (if (> (swap! counter dec) 0)
+			      (let [f (rand-elt funcs)]
+				(f)
+				(recur))))
+			  (log "finishing thread" (:client-id c)))))))]
+      (println "Finished setup")
+      (let [[elapsed _] (with-timing
+			  (do
+			    (doseq [t threads]
+			      (.start t))
+			    (doseq [t threads]
+			      (.join t))))]
+	(print-run-results spec elapsed)))))