Browse Source

Revamp http-kit, all tests implemented

Zane Kansil 10 years ago
parent
commit
de47d489ff

+ 6 - 3
frameworks/Clojure/http-kit/benchmark_config.json

@@ -3,9 +3,12 @@
   "tests": [{
   "tests": [{
     "default": {
     "default": {
       "setup_file": "setup",
       "setup_file": "setup",
-      "json_url": "/http-kit/json",
-      "db_url": "/http-kit/db",
-      "query_url": "/http-kit/db/",
+      "json_url": "/json",
+      "db_url": "/db",
+      "query_url": "/queries/",
+      "fortune_url": "/fortunes",
+      "update_url": "/updates/",
+      "plaintext_url": "/plaintext",
       "port": 8080,
       "port": 8080,
       "approach": "Realistic",
       "approach": "Realistic",
       "classification": "Platform",
       "classification": "Platform",

+ 10 - 2
frameworks/Clojure/http-kit/hello/project.clj

@@ -6,9 +6,17 @@
                  [ring/ring-json "0.2.0"]
                  [ring/ring-json "0.2.0"]
                  [org.clojure/tools.cli "0.2.1"]
                  [org.clojure/tools.cli "0.2.1"]
                  [http-kit/dbcp "0.1.0"]
                  [http-kit/dbcp "0.1.0"]
-                 [http-kit "2.0.1"]
+                 [http-kit "2.1.18"]
                  [log4j "1.2.15" :exclusions [javax.mail/mail javax.jms/jms com.sun.jdmk/jmxtools com.sun.jmx/jmxri]]
                  [log4j "1.2.15" :exclusions [javax.mail/mail javax.jms/jms com.sun.jdmk/jmxtools com.sun.jmx/jmxri]]
-                 [mysql/mysql-connector-java "5.1.6"]]
+                 ; [ch.qos.logback/logback-classic "1.1.2" :exclusions [org.slf4j/slf4j-api]]
+                 ; [org.slf4j/jul-to-slf4j "1.7.7"]
+                 ; [org.slf4j/jcl-over-slf4j "1.7.7"]
+                 ; [org.slf4j/log4j-over-slf4j "1.7.7"]
+                 [org.clojure/data.json "0.2.5"]
+                 [org.clojure/java.jdbc "0.3.6"]
+                 [korma "0.4.0"]
+                 [mysql/mysql-connector-java "5.1.6"]
+                 [hiccup "1.0.4"]]
   :main hello.handler
   :main hello.handler
   :aot [hello.handler]
   :aot [hello.handler]
   :uberjar-name "http-kit-standalone.jar"
   :uberjar-name "http-kit-standalone.jar"

+ 182 - 47
frameworks/Clojure/http-kit/hello/src/hello/handler.clj

@@ -1,72 +1,207 @@
 (ns hello.handler
 (ns hello.handler
   (:gen-class)
   (:gen-class)
+  (:import com.mchange.v2.c3p0.ComboPooledDataSource)
   (:use compojure.core
   (:use compojure.core
         ring.middleware.json
         ring.middleware.json
         org.httpkit.server
         org.httpkit.server
         [clojure.tools.cli :only [cli]]
         [clojure.tools.cli :only [cli]]
-        ring.util.response)
+        korma.db
+        korma.core
+        hiccup.core
+        hiccup.util
+        hiccup.page)
   (:require [compojure.handler :as handler]
   (:require [compojure.handler :as handler]
-            [org.httpkit.dbcp :as db]
-            [compojure.route :as route]))
-
-;;; convert to int
-(defn to-int [s] (cond
-                  (string? s) (Integer/parseInt s)
-                  (instance? Integer s) s
-                  (instance? Long s) (.intValue ^Long s)
-                  :else 0))
-
-;; Query a random World record from the database
-(defn get-world []
-  (let [id (inc (rand-int 9999))] ; Num between 1 and 10,000
-    ; Set a naming strategy to preserve column name case
-    (clojure.java.jdbc/with-naming-strategy {:keyword identity}
-      (db/query "select * from world where id = ?" id))))
-
-;; Run the specified number of queries, return the results
-(defn run-queries [queries]
-   (flatten ; Make it a list of maps
-    (take
-     queries ; Number of queries to run
-     (repeatedly get-world))))
-
-(defn get-query-count [queries]
-  "Parse provided string value of query count, clamping values to between 1 and 500."
-  (let [q (try (Integer/parseInt queries)
+            [compojure.route :as route]
+            [ring.util.response :as ring-resp]
+            [clojure.data.json :as json]
+            [clojure.java.jdbc :as jdbc]))
+
+
+(defn parse-port [s] 
+  "Convert stringy port number int. Defaults to 8080."
+  (cond
+    (string? s) (Integer/parseInt s)
+    (instance? Integer s) s
+    (instance? Long s) (.intValue ^Long s)
+    :else 8080))
+
+
+;; MySQL connection
+(defdb mysql-db
+  (mysql {
+    :classname "com.mysql.jdbc.Driver"
+    :subprotocol "mysql"
+    :subname "//127.0.0.1:3306/hello_world"
+    :user "benchmarkdbuser"
+    :password "benchmarkdbpass"
+    ;;OPTIONAL KEYS
+    :delimiters "" ;; remove delimiters
+    :maximum-pool-size 256}))
+
+
+;; Set up entity World and the database representation
+(defentity world
+  (pk :id)
+  (table :world)
+  (entity-fields :id :randomNumber) ;; Default fields for select
+  (database mysql-db))
+
+
+(defn sanitize-queries-param
+  "Sanitizes the `queries` parameter. Caps the value between 1 and 500.
+  Invalid (stringy) values become 1"
+  [queries]
+  (let [n (try (Integer/parseInt queries)
                (catch Exception e 1))] ; default to 1 on parse failure
                (catch Exception e 1))] ; default to 1 on parse failure
-    (if (> q 500)
-      500 ; clamp to 500 max
-      (if (< q 1)
-        1 ; clamp to 1 min
-        q)))) ; otherwise use provided value
+    (cond
+      (< n 1) 1
+      (> n 500) 500
+      :else n)))
+
+
+(defn random-world
+  "Query a random World record from the database"
+  []
+  (let [id (inc (rand-int 9999))] ; Num between 1 and 10,000
+    (select world
+            (where {:id id }))))
+
+
+(defn run-queries
+  "Run query repeatedly -- Always returns an array"
+  [queries]
+  (flatten (take queries (repeatedly random-world))))
+
+; Set up entity Fortune and the database representation
+(defentity fortune
+  (pk :id)
+  (table :fortune)
+  (entity-fields :id :message)
+  (database mysql-db))
+
+
+(defn get-all-fortunes
+  "Query all Fortune records from the database."
+  []
+  (select fortune
+          (fields :id :message)))
+
+
+(defn get-fortunes
+  "Fetch the full list of Fortunes from the database, sort them by the fortune
+  message text, and then return the results."
+  []
+  (sort-by #(:message %)
+    (conj
+      (get-all-fortunes)
+      { :id 0 :message "Additional fortune added at request time." })))
+
+
+(defn fortunes-hiccup
+  "Render the given fortunes to simple HTML using Hiccup."
+  [fortunes]
+  (html5
+   [:head
+    [:title "Fortunes"]]
+   [:body
+    [:table
+     [:tr
+      [:th "id"]
+      [:th "message"]]
+     (for [x fortunes]
+       [:tr
+        [:td (:id x)]
+        [:td (escape-html (:message x))]])
+     ]]))
+
+
+(defn update-and-persist
+  "Changes the :randomNumber of a number of world entities.
+  Persists the changes to sql then returns the updated entities"
+  [queries]
+  (let [results (-> queries
+                    (sanitize-queries-param)
+                    (run-queries))]
+    (for [w results]
+      (update-in w [:randomNumber (inc (rand-int 9999))]
+        (update world
+                (set-fields {:randomNumber (:randomNumber w)})
+                (where {:id [:id w]}))))
+    results))
+
+
+(def json-serialization
+  "Test 1: JSON serialization"
+  (ring-resp/response {:message "Hello, World!"}))
+
+
+(def single-query-test
+  "Test 2: Single database query"
+  (ring-resp/response (first (run-queries 1))))
+
+
+(defn multiple-queries-test
+  "Test 3: Multiple database queries"
+  [queries]
+  (-> queries
+      (sanitize-queries-param)
+      (run-queries)
+      (ring-resp/response)
+      (ring-resp/content-type "application/json")))
+
+
+(def fortune-test
+  "Test 4: Fortunes"
+  (->
+    (get-fortunes)
+    (fortunes-hiccup)
+    (ring-resp/response)
+    (ring-resp/content-type "text/html")))
+
+
+(defn db-updates
+  "Test 5: Database updates"
+  [queries]
+  (-> queries
+      (update-and-persist)
+      (ring-resp/response)))
+
+
+(def plaintext
+  "Test 6: Plaintext"
+  (->
+    (ring-resp/response "Hello, World!")
+    (ring-resp/content-type "text/plain")))
+
 
 
 ;; Define route handlers
 ;; Define route handlers
 (defroutes app-routes
 (defroutes app-routes
-  (GET "/http-kit/" [] "Hello, World!")
-  (GET "/http-kit/json" [] (response {:message "Hello, World!"}))
-  (GET "/http-kit/db" []
-       (response (first (run-queries 1))))
-  (GET "/http-kit/db/:queries" [queries]
-       (response (run-queries (get-query-count queries))))
+  (GET "/"                 [] "Hello, World!")
+  (GET "/json"             [] json-serialization)
+  (GET "/db"               [] single-query-test)
+  (GET "/queries/:queries" [queries] (multiple-queries-test queries))
+  (GET "/fortunes"         [] fortune-test)
+  (GET "/updates/:queries" [queries] (db-updates queries))
+  (GET "/plaintext"        [] plaintext)
   (route/not-found "Not Found"))
   (route/not-found "Not Found"))
 
 
 
 
-(defn start-server [{:keys [port db-host]}]
-  (db/use-database! (str "jdbc:mysql://" db-host "/hello_world?jdbcCompliantTruncation=false&elideSetAutoCommits=true&useLocalSessionState=true&cachePrepStmts=true&cacheCallableStmts=true&alwaysSendSetIsolation=false&prepStmtCacheSize=4096&cacheServerConfiguration=true&prepStmtCacheSqlLimit=2048&zeroDateTimeBehavior=convertToNull&traceProtocol=false&useUnbufferedInput=false&useReadAheadInput=false&maintainTimeStats=false&useServerPrepStmts&cacheRSMetadata=true")
-                    "benchmarkdbuser"
-                    "benchmarkdbpass")
+(defn start-server [{:keys [port]}]
   ;; Format responses as JSON
   ;; Format responses as JSON
   (let [handler (wrap-json-response app-routes)
   (let [handler (wrap-json-response app-routes)
         cpu (.availableProcessors (Runtime/getRuntime))]
         cpu (.availableProcessors (Runtime/getRuntime))]
     ;; double worker threads should increase database access performance
     ;; double worker threads should increase database access performance
-    (run-server handler {:port port :thread (* 2 cpu)})
+    (run-server handler {:port port
+                         :thread (* 2 cpu)})
     (println (str "http-kit server listens at :" port))))
     (println (str "http-kit server listens at :" port))))
 
 
+
 (defn -main [& args]
 (defn -main [& args]
   (let [[options _ banner]
   (let [[options _ banner]
         (cli args
         (cli args
-             ["-p" "--port" "Port to listen" :default 8080 :parse-fn to-int]
-             ["--db-host" "MySQL database host" :default "localhost"]
+             ["-p" "--port" "Port to listen" :default 8080 :parse-fn parse-port]
              ["--[no-]help" "Print this help"])]
              ["--[no-]help" "Print this help"])]
-    (when (:help options) (println banner) (System/exit 0))
+    (when (:help options)
+          (println banner)
+          (System/exit 0))
     (start-server options)))
     (start-server options)))

+ 5 - 1
frameworks/Clojure/http-kit/setup.sh

@@ -2,6 +2,10 @@
 source $IROOT/java7.installed
 source $IROOT/java7.installed
 source $IROOT/lein.installed
 source $IROOT/lein.installed
 
 
+
+# Update db host in the source file
+sed -i 's|:subname "//.*:3306|:subname "//'"${DBHOST}"':3306|g' hello/src/hello/handler.clj
+
 cd hello
 cd hello
 lein clean
 lein clean
 lein deps
 lein deps
@@ -10,4 +14,4 @@ rm -rf target
 lein uberjar
 lein uberjar
 # -server is much faster
 # -server is much faster
 # 'lein run' passes '-client -XX:+TieredCompilation -XX:TieredStopAtLevel=1' which make it starts fast, but runs slow
 # 'lein run' passes '-client -XX:+TieredCompilation -XX:TieredStopAtLevel=1' which make it starts fast, but runs slow
-java -server -jar target/http-kit-standalone.jar --db-host ${DBHOST} &
+java -server -jar target/http-kit-standalone.jar  &