From fd85ecfd83473e43b0a55e567bc9f127b7c4daf3 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 29 Nov 2009 10:24:58 +0100 Subject: Move the source files around a bit. --- src/logikorr.clj | 155 ----------------------------------------------- src/logikorr/servlet.clj | 155 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 155 insertions(+), 155 deletions(-) delete mode 100644 src/logikorr.clj create mode 100644 src/logikorr/servlet.clj (limited to 'src') diff --git a/src/logikorr.clj b/src/logikorr.clj deleted file mode 100644 index 89af417..0000000 --- a/src/logikorr.clj +++ /dev/null @@ -1,155 +0,0 @@ -(ns logikorr - (:gen-class :extends javax.servlet.http.HttpServlet) - (:use compojure.http compojure.html) - (:require [appengine-clj.datastore :as ds] - [org.danlarkin.json :as json]) - (:import [com.google.appengine.api.datastore DatastoreServiceFactory Entity Query Query$FilterOperator Query$SortDirection KeyFactory EntityNotFoundException Key] - [com.google.appengine.api.users UserServiceFactory])) - -(defmacro with-ds-transaction [& body] - `(call-with-ds-transaction (fn [] ~@body))) - -(defn call-with-ds-transaction [thunk] - (let [ds (DatastoreServiceFactory/getDatastoreService) - success (atom false) - transaction (.beginTransaction ds) - return-value (atom nil)] - (try (do - (swap! return-value (fn [_] (thunk))) - (.commit transaction) - (swap! success (fn [_] true))) - (finally - (when-not @success - (.rollback transaction)))) - @return-value)) - -(defn ds-update - "Update the corresponding entity from the supplied map in the data store." - [map] - (let [datastore (DatastoreServiceFactory/getDatastoreService), - entity (.get datastore #^Key (:key map))] - (doseq [[key value] (dissoc map :kind :key)] - (.setProperty entity (name key) value)) - (.put datastore entity))) - -(def *static-directory* "/Users/mulk/Dropbox/Projekte/LogiCLJ/war") - -(defn current-revision [] - (or (first (ds/find-all (doto (Query. "revision") - (.addSort "number" Query$SortDirection/DESCENDING)))) - (ds/create {:kind "revision" :number 0}))) - -(defn find-students [] - (ds/find-all (doto (Query. "student" (:key (current-revision)))))) - -(defn position [coll thing] - (loop [i 0, - coll2 coll] - (if (= (first coll2) thing) - i - (if-let [coll3 (next coll2)] - (recur (+ i 1) coll3) - nil)))) - -(defn split-name [name] - (let [n (position name \,)] - (if n - [(apply str (drop (+ n 2) name)) (apply str (take n name))] - [name ""]))) - -(defn find-student-by-name [name] - (let [[first-name last-name] (split-name name)] - (first (ds/find-all (doto (Query. "student" (:key (current-revision))) - (.addFilter "first-name" Query$FilterOperator/EQUAL first-name) - (.addFilter "last-name" Query$FilterOperator/EQUAL last-name)))))) - -(defn find-student-by-id [id] - (ds/get (KeyFactory/stringToKey id))) - -(defn index [request] - (let [students (find-students)] - (html - [:html - [:head - [:title "Logik I: Korrekturergebnisse"] - [:script {:type "text/javascript" :src "js/prototype.js"}] - [:script {:type "text/javascript" :src "js/scriptaculous.js"}] - [:link {:type "text/css" :rel "stylesheet" :href "style.css"}] - [:script {:type "text/javascript" :src "http://yui.yahooapis.com/3.0.0/build/yui/yui-min.js"}] - [:script {:type "text/javascript" :src "logikorr.js"}] - [:script {:type "text/javascript" :src "logikorr-completion-data.js"}]] - [:body - [:h1 "Logik I: Korrekturergebnisse"] - [:h2 "Neue Ergebnisse"] - [:form [:button#make-revision {:type "button"} "Aktuelle Version sichern"] - [:div#new-version-label {:style "display: inline; color: #070"}]] - [:table#ergebnisse] - [:h2 "Bestehende Ergebnisse"] - [:table - [:tr - [:th "ID"] [:th "Punkte"] [:th "Nachname"] [:th "Vorname"]] - (map - (fn [student] - (let [{id :key score :score - last-name :last-name first-name :first-name} - student] - [:tr - [:td (str id)] - [:td (str score)] - [:td last-name] - [:td first-name]])) - students)]]]))) - -(defn unsplit-name [first last] - (if last - (str last ", " first) - first)) - -(defn compute-completion-data-js [] - (str "autocompleteList = " - (json/encode-to-str (map (fn [x] - (unsplit-name (:first-name x) (:last-name x))) - (find-students))) - ";")) - -(defn find-student-json [name] - (let [student (find-student-by-name name)] - (json/encode-to-str {:id (KeyFactory/keyToString (:key student)) - :score (seq (:score student)) - :first-name (:first-name student) - :last-name (:last-name student)}))) - -(defn update-student-score [id score-number new-score-value] - (with-ds-transaction - (let [student (find-student-by-id id) - score (:score student) - num (Integer. score-number)] - (ds-update (assoc student - :score (concat (take num score) - [(binding [*read-eval* false] - (read-string new-score-value))] - (drop (+ 1 num) score))))) - "\"OK\"")) - -(defn make-new-revision [] - (with-ds-transaction - (let [current (current-revision) - students (find-students) - new (ds/create {:kind "revision" - :number (inc (:number current))})] - (doseq [student students] - (ds/create (assoc (dissoc student :key) :kind "student") (:key new))) - (str (:number new))))) - -(defroutes logikorr - (GET "/" index) - (GET "/favicon.ico" (do nil)) - (GET "/logikorr-completion-data.js" (compute-completion-data-js)) - (GET "/find-student" (find-student-json (:name params))) - (GET "/update-student-score" (update-student-score (:id params) (:score-number params) (:score params))) - (GET "/make-new-revision" (make-new-revision)) - (GET "/*" - (or (serve-file *static-directory* (params :*)) :next)) - (ANY "/*" (page-not-found))) - -(defservice logikorr) diff --git a/src/logikorr/servlet.clj b/src/logikorr/servlet.clj new file mode 100644 index 0000000..89af417 --- /dev/null +++ b/src/logikorr/servlet.clj @@ -0,0 +1,155 @@ +(ns logikorr + (:gen-class :extends javax.servlet.http.HttpServlet) + (:use compojure.http compojure.html) + (:require [appengine-clj.datastore :as ds] + [org.danlarkin.json :as json]) + (:import [com.google.appengine.api.datastore DatastoreServiceFactory Entity Query Query$FilterOperator Query$SortDirection KeyFactory EntityNotFoundException Key] + [com.google.appengine.api.users UserServiceFactory])) + +(defmacro with-ds-transaction [& body] + `(call-with-ds-transaction (fn [] ~@body))) + +(defn call-with-ds-transaction [thunk] + (let [ds (DatastoreServiceFactory/getDatastoreService) + success (atom false) + transaction (.beginTransaction ds) + return-value (atom nil)] + (try (do + (swap! return-value (fn [_] (thunk))) + (.commit transaction) + (swap! success (fn [_] true))) + (finally + (when-not @success + (.rollback transaction)))) + @return-value)) + +(defn ds-update + "Update the corresponding entity from the supplied map in the data store." + [map] + (let [datastore (DatastoreServiceFactory/getDatastoreService), + entity (.get datastore #^Key (:key map))] + (doseq [[key value] (dissoc map :kind :key)] + (.setProperty entity (name key) value)) + (.put datastore entity))) + +(def *static-directory* "/Users/mulk/Dropbox/Projekte/LogiCLJ/war") + +(defn current-revision [] + (or (first (ds/find-all (doto (Query. "revision") + (.addSort "number" Query$SortDirection/DESCENDING)))) + (ds/create {:kind "revision" :number 0}))) + +(defn find-students [] + (ds/find-all (doto (Query. "student" (:key (current-revision)))))) + +(defn position [coll thing] + (loop [i 0, + coll2 coll] + (if (= (first coll2) thing) + i + (if-let [coll3 (next coll2)] + (recur (+ i 1) coll3) + nil)))) + +(defn split-name [name] + (let [n (position name \,)] + (if n + [(apply str (drop (+ n 2) name)) (apply str (take n name))] + [name ""]))) + +(defn find-student-by-name [name] + (let [[first-name last-name] (split-name name)] + (first (ds/find-all (doto (Query. "student" (:key (current-revision))) + (.addFilter "first-name" Query$FilterOperator/EQUAL first-name) + (.addFilter "last-name" Query$FilterOperator/EQUAL last-name)))))) + +(defn find-student-by-id [id] + (ds/get (KeyFactory/stringToKey id))) + +(defn index [request] + (let [students (find-students)] + (html + [:html + [:head + [:title "Logik I: Korrekturergebnisse"] + [:script {:type "text/javascript" :src "js/prototype.js"}] + [:script {:type "text/javascript" :src "js/scriptaculous.js"}] + [:link {:type "text/css" :rel "stylesheet" :href "style.css"}] + [:script {:type "text/javascript" :src "http://yui.yahooapis.com/3.0.0/build/yui/yui-min.js"}] + [:script {:type "text/javascript" :src "logikorr.js"}] + [:script {:type "text/javascript" :src "logikorr-completion-data.js"}]] + [:body + [:h1 "Logik I: Korrekturergebnisse"] + [:h2 "Neue Ergebnisse"] + [:form [:button#make-revision {:type "button"} "Aktuelle Version sichern"] + [:div#new-version-label {:style "display: inline; color: #070"}]] + [:table#ergebnisse] + [:h2 "Bestehende Ergebnisse"] + [:table + [:tr + [:th "ID"] [:th "Punkte"] [:th "Nachname"] [:th "Vorname"]] + (map + (fn [student] + (let [{id :key score :score + last-name :last-name first-name :first-name} + student] + [:tr + [:td (str id)] + [:td (str score)] + [:td last-name] + [:td first-name]])) + students)]]]))) + +(defn unsplit-name [first last] + (if last + (str last ", " first) + first)) + +(defn compute-completion-data-js [] + (str "autocompleteList = " + (json/encode-to-str (map (fn [x] + (unsplit-name (:first-name x) (:last-name x))) + (find-students))) + ";")) + +(defn find-student-json [name] + (let [student (find-student-by-name name)] + (json/encode-to-str {:id (KeyFactory/keyToString (:key student)) + :score (seq (:score student)) + :first-name (:first-name student) + :last-name (:last-name student)}))) + +(defn update-student-score [id score-number new-score-value] + (with-ds-transaction + (let [student (find-student-by-id id) + score (:score student) + num (Integer. score-number)] + (ds-update (assoc student + :score (concat (take num score) + [(binding [*read-eval* false] + (read-string new-score-value))] + (drop (+ 1 num) score))))) + "\"OK\"")) + +(defn make-new-revision [] + (with-ds-transaction + (let [current (current-revision) + students (find-students) + new (ds/create {:kind "revision" + :number (inc (:number current))})] + (doseq [student students] + (ds/create (assoc (dissoc student :key) :kind "student") (:key new))) + (str (:number new))))) + +(defroutes logikorr + (GET "/" index) + (GET "/favicon.ico" (do nil)) + (GET "/logikorr-completion-data.js" (compute-completion-data-js)) + (GET "/find-student" (find-student-json (:name params))) + (GET "/update-student-score" (update-student-score (:id params) (:score-number params) (:score params))) + (GET "/make-new-revision" (make-new-revision)) + (GET "/*" + (or (serve-file *static-directory* (params :*)) :next)) + (ANY "/*" (page-not-found))) + +(defservice logikorr) -- cgit v1.2.3