summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--logikorr.asd11
-rw-r--r--logikorr.lisp273
-rwxr-xr-xrun.sh11
-rw-r--r--src/logikorr.clj128
-rw-r--r--src/run.clj49
-rw-r--r--war/WEB-INF/appengine-web.xml7
-rw-r--r--war/WEB-INF/web.xml15
-rw-r--r--war/js/builder.js (renamed from js/builder.js)0
-rw-r--r--war/js/controls.js (renamed from js/controls.js)0
-rw-r--r--war/js/dragdrop.js (renamed from js/dragdrop.js)0
-rw-r--r--war/js/effects.js (renamed from js/effects.js)0
-rw-r--r--war/js/prototype.js (renamed from js/prototype.js)0
-rw-r--r--war/js/scriptaculous.js (renamed from js/scriptaculous.js)0
-rw-r--r--war/js/slider.js (renamed from js/slider.js)0
-rw-r--r--war/js/sound.js (renamed from js/sound.js)0
-rw-r--r--war/js/unittest.js (renamed from js/unittest.js)0
-rw-r--r--war/logikorr.js (renamed from logikorr.js)0
-rw-r--r--war/style.css27
18 files changed, 226 insertions, 295 deletions
diff --git a/logikorr.asd b/logikorr.asd
deleted file mode 100644
index 565b1f2..0000000
--- a/logikorr.asd
+++ /dev/null
@@ -1,11 +0,0 @@
-;;; Copyright 2009, Matthias Andreas Benkard.
-
-(defsystem logikorr
- :name "logikorr"
- :version "0.0.1"
- :maintainer ""
- :author "Matthias Benkard <code@matthias.benkard.de>"
- :licence ""
- :description "Ein einfaches Bewertungsaufnahmesystem"
- :depends-on (:cl-who :hunchentoot :cl-json)
- :components ((:file "logikorr")))
diff --git a/logikorr.lisp b/logikorr.lisp
deleted file mode 100644
index 013ef59..0000000
--- a/logikorr.lisp
+++ /dev/null
@@ -1,273 +0,0 @@
-;;; Copyright 2009, Matthias Andreas Benkard.
-
-(defpackage :logikorr-ht
- (:use #:hunchentoot #:common-lisp #:json #:cl-who))
-
-(in-package #:logikorr-ht)
-
-(defstruct student
- (id -1 :type integer)
- (score #() :type vector)
- (last-name "" :type (or string null))
- (first-name "" :type (or string null)))
-
-(defparameter *directory* (asdf:component-pathname (asdf:find-system '#:logikorr)))
-(defparameter *in-locked-context-p* nil)
-
-(defvar *students* nil)
-(defvar *database* nil)
-(defvar *database-directory* (merge-pathnames #p"data/" *directory*))
-(defvar *lock* (merge-pathnames #p".mulk-db-lock" *database-directory*))
-
-(defvar *password-file* (merge-pathnames #p"password.txt" *directory*))
-(defvar *password*
- (with-open-file (in *password-file* :direction :input)
- (read-line in)))
-
-(setq *hunchentoot-default-external-format*
- (flexi-streams:make-external-format :utf-8))
-
-(defun find-and-initialise-database ()
- (let* ((files (directory (merge-pathnames #p"*.txt" *database-directory*)))
- (sorted-files (sort files #'>
- :key (lambda (x)
- (parse-integer (pathname-name x))))))
- (setq *database* (first sorted-files))))
-
-(defun make-new-revision ()
- (find-and-initialise-database)
- (let* ((name (pathname-name *database*))
- (number (parse-integer name))
- (new-path (merge-pathnames (make-pathname :name (format nil "~D" (1+ number)))
- *database*)))
- (find-students)
- (write-database-to-file new-path)
- (setq *database* new-path)
- (1+ number)))
-
-(defmacro with-authentication (() &body body)
- `(call-with-authentication (lambda () ,@body)))
-
-(defun call-with-authentication (thunk)
- (multiple-value-bind (name password)
- (authorization)
- (if (and (string= name "logik") (string= password *password*))
- (funcall thunk)
- (progn
- (require-authorization "Logik-Ergebniseingabe")))))
-
-(defmacro with-data-lock (() &body body)
- `(call-with-data-lock (lambda () ,@body)))
-
-(defun call-with-data-lock (thunk)
- (cond (*in-locked-context-p*
- (funcall thunk))
- (t
- (let (lock)
- (unwind-protect
- (progn
- (loop until (setq lock (open *lock* :direction :output :if-exists nil :if-does-not-exist :create)))
- (let ((*in-locked-context-p* t)) (funcall thunk)))
- (progn (ignore-errors (delete-file *lock*))
- (ignore-errors (close lock))))))))
-
-
-(defun find-students ()
- (find-and-initialise-database)
- (with-data-lock ()
- (setq
- *students*
- (with-open-file (in *database* :external-format :utf-8)
- (loop for line = (read-line in nil nil nil)
- with id = 0
- while line
- unless (equal (remove #\Space line) "")
- collect (let* ((name line)
- (score-line (read-line in t))
- (score (read-from-string score-line))
- (comma (position #\, name))
- (last-name (if comma (subseq name 0 comma) nil))
- (first-name (if comma (subseq name (+ comma 2)) name)))
- (make-student :id id
- :score (make-array (list (length score))
- :initial-contents score
- :adjustable t
- :fill-pointer t)
- :last-name last-name
- :first-name first-name))
- and do (incf id))))))
-
-(define-easy-handler (show-main-page :uri "/") ()
- (with-authentication ()
- (let ((students (find-students)))
- (ignore-errors (setf (header-out :content-type) "text/html; charset=UTF-8"))
- (with-html-output-to-string (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 :type "button" :id "make-revision"
- (esc "Aktuelle Version sichern"))
- (:div :id "new-version-label" :style "display: inline; color: #070"))
- (:table :id "ergebnisse")
- (:h2 "Bestehende Ergebnisse")
- (:table
- (:tr
- (:th "ID") (:th "Punkte") (:th "Nachname") (:th "Vorname"))
- (dolist (student students)
- (with-slots (id score last-name first-name) student
- (htm (:tr (:td (str id))
- (:td (str score))
- (:td (esc last-name))
- (:td (esc first-name)))))))))))))
-
-
-(define-easy-handler (logikorr.js :uri "/logikorr.js") ()
- (handle-static-file (relpath "logikorr.js")))
-
-(define-easy-handler (logikorr-completion-data.js :uri "/logikorr-completion-data.js") ()
- (with-authentication ()
- (ignore-errors (setf (header-out :content-type) "text/javascript; charset=UTF-8"))
- (format nil "~%autocompleteList = ~A"
- (json:encode-json-to-string (mapcar (lambda (x) (unsplit-name (student-first-name x) (student-last-name x)))
- (find-students))))))
-
-
-(define-easy-handler (style.css :uri "/style.css") ()
- (setf (header-out :content-type) "text/css; charset=UTF-8")
- "body {
- z-index: 0;
-}
-
-div.autocomplete {
- position:absolute;
- width:350px;
- background-color:white;
- border:1px solid #888;
- margin:0;
- padding:0;
- z-index: 100;
-}
-div.autocomplete ul {
- list-style-type:none;
- margin:0;
- padding:0;
-}
-div.autocomplete ul li.selected { background-color: #ffb;}
-div.autocomplete ul li {
- list-style-type:none;
- display:block;
- margin:0;
- padding:2px;
- height:32px;
- cursor:pointer;
-}")
-
-(defun relpath (path)
- (merge-pathnames path *directory*))
-
-(define-easy-handler (s1.js :uri "/js/builder.js") ()
- (handle-static-file (relpath "js/builder.js")))
-
-(define-easy-handler (s2.js :uri "/js/scriptaculous.js") ()
- (handle-static-file (relpath "js/scriptaculous.js")))
-
-(define-easy-handler (s3.js :uri "/js/controls.js") ()
- (handle-static-file (relpath "js/controls.js")))
-
-(define-easy-handler (s4.js :uri "/js/dragdrop.js") ()
- (handle-static-file (relpath "js/dragdrop.js")))
-
-(define-easy-handler (s5.js :uri "/js/effects.js") ()
- (handle-static-file (relpath "js/effects.js")))
-
-(define-easy-handler (s6.js :uri "/js/prototype.js") ()
- (handle-static-file (relpath "js/prototype.js")))
-
-(define-easy-handler (scriptaculous.js :uri "/js/scriptaculous.js") ()
- (handle-static-file (relpath "js/scriptaculous.js")))
-
-(define-easy-handler (s8.js :uri "/js/slider.js") ()
- (handle-static-file (relpath "js/slider.js")))
-
-(define-easy-handler (s9.js :uri "/js/sound.js") ()
- (handle-static-file (relpath "js/sound.js")))
-
-(define-easy-handler (s10.js :uri "/js/unittest.js") ()
- (handle-static-file (relpath "js/unittest.js")))
-
-(defun unsplit-name (first last)
- (if last
- (format nil "~A, ~A" last first)
- first))
-
-(defun find-student-by-name (name)
- (dolist (student (find-students))
- (when (string= name (unsplit-name (student-first-name student)
- (student-last-name student)))
- (return-from find-student-by-name student))))
-
-(defun find-student-by-id (id)
- (find id (find-students) :key #'student-id))
-
-(define-easy-handler (find-student :uri "/find-student") (name)
- (with-authentication ()
- (let ((student (find-student-by-name name)))
- (setf (header-out :content-type) "text/json; charset=UTF-8")
- (with-slots (id first-name last-name score) student
- (with-output-to-string (*standard-output*)
- (json:encode-json-plist
- (list :id id
- :first-name first-name
- :last-name last-name
- :score score)))))))
-
-(define-easy-handler (update-student-score :uri "/update-student-score")
- (id score-number score)
- (with-authentication ()
- (with-data-lock ()
- (let ((student (find-student-by-id (parse-integer id)))
- (index (parse-integer score-number)))
- (loop while (<= (length (student-score student)) index)
- do (vector-push-extend 0 (student-score student)))
- (setf (elt (student-score student) index)
- (let ((*read-eval* nil))
- (let ((score (read-from-string score)))
- (check-type score number)
- score))))
- (write-database)))
- "\"OK\"")
-
-(define-easy-handler (create-new-revision :uri "/make-new-revision")
- ()
- (with-authentication ()
- (format nil "~D" (make-new-revision))))
-
-(defun write-database ()
- (find-and-initialise-database)
- (write-database-to-file *database*))
-
-(defun write-database-to-file (file)
- (with-data-lock ()
- (unless *students*
- (return-from write-database-to-file))
- (with-open-file (out file :external-format :utf-8 :direction :output :if-exists :new-version #+(or) :supersede)
- (dolist (student *students*)
- (if (student-last-name student)
- (format out "~&~A, ~A" (student-last-name student) (student-first-name student))
- (format out "~&~A" (student-first-name student)))
- (format out "~&(~{~3S~^ ~} )" (coerce (student-score student) 'list))
- (format out "~%~%")))))
-
-(defun start-logikorr ()
- (start (make-instance 'acceptor :port 8080)))
diff --git a/run.sh b/run.sh
deleted file mode 100755
index 032c07d..0000000
--- a/run.sh
+++ /dev/null
@@ -1,11 +0,0 @@
-#! /bin/bash
-
-DIR=`dirname "$0"`
-sbcl <<EOF
- (require :asdf)
- (pushnew "$DIR/" asdf:*central-registry*)
- (require :logikorr)
- (in-package logikorr-ht)
- (start-logikorr)
-EOF
-
diff --git a/src/logikorr.clj b/src/logikorr.clj
new file mode 100644
index 0000000..d9dfbc6
--- /dev/null
+++ b/src/logikorr.clj
@@ -0,0 +1,128 @@
+(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]))
+
+(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]
+ (let [student (find-student-by-id id)
+ score (:score student)
+ num (Integer. score-number)]
+ (ds-update (assoc student
+ :score (concat (take num score)
+ [(Float. new-score-value)]
+ (drop (+ 1 num) score)))))
+ "\"OK\"")
+
+(defn create-new-revision [])
+
+(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 "/create-new-revision" (create-new-revision))
+ (GET "/*"
+ (or (serve-file *static-directory* (params :*)) :next))
+ (ANY "/*" (page-not-found)))
+
+(defservice logikorr)
diff --git a/src/run.clj b/src/run.clj
new file mode 100644
index 0000000..2bc6c8e
--- /dev/null
+++ b/src/run.clj
@@ -0,0 +1,49 @@
+;;; From: http://www.hackers-with-attitude.com/2009/08/intertactive-programming-with-clojure.html
+;;; Copyright Robin Brandt, freiheit.com.
+
+(ns logikorr-jetty
+ (:use logikorr)
+ (:use compojure.server.jetty compojure.http compojure.control))
+
+(defmacro with-app-engine
+ "testing macro to create an environment for a thread"
+ ([body]
+ `(with-app-engine env-proxy ~body))
+ ([proxy body]
+ `(last (doall [(com.google.apphosting.api.ApiProxy/setEnvironmentForCurrentThread ~proxy)
+ ~body]))))
+
+(defn login-aware-proxy
+ "returns a proxy for the google apps environment that works locally"
+ [request]
+ (let [email (:email (:session request))]
+ (proxy [com.google.apphosting.api.ApiProxy$Environment] []
+ (isLoggedIn [] (boolean email))
+ (getAuthDomain [] "")
+ (getRequestNamespace [] "")
+ (getDefaultNamespace [] "")
+ (getAttributes [] (java.util.HashMap.))
+ (getEmail [] (or email ""))
+ (isAdmin [] true)
+ (getAppId [] "local"))))
+
+(defn environment-decorator
+ "decorates the given application with a local version of the app engine environment"
+ [application]
+ (fn [request]
+ (with-app-engine (login-aware-proxy request)
+ (application request))))
+
+(defn init-app-engine
+ "Initialize the app engine services."
+ ([]
+ (init-app-engine "/tmp"))
+ ([dir]
+ (com.google.apphosting.api.ApiProxy/setDelegate
+ (proxy [com.google.appengine.tools.development.ApiProxyLocalImpl] [(java.io.File. dir)]))))
+
+;; make sure every thread has the environment set up
+
+(defn start-logikorr []
+ (init-app-engine)
+ (run-server {:port 8080} "/*" (servlet (environment-decorator logikorr))))
diff --git a/war/WEB-INF/appengine-web.xml b/war/WEB-INF/appengine-web.xml
new file mode 100644
index 0000000..ae1829e
--- /dev/null
+++ b/war/WEB-INF/appengine-web.xml
@@ -0,0 +1,7 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<appengine-web-app xmlns="http://appengine.google.com/ns/1.0">
+ <application>[application ID]</application>
+ <version>1</version>
+ <static-files />
+ <resource-files />
+</appengine-web-app>
diff --git a/war/WEB-INF/web.xml b/war/WEB-INF/web.xml
new file mode 100644
index 0000000..72f29be
--- /dev/null
+++ b/war/WEB-INF/web.xml
@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<web-app xmlns="http://java.sun.com/xml/ns/javaee"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xsi:schemaLocation="http://java.sun.com/xml/ns/javaee/web-app_2_5.xsd"
+ version="2.5">
+ <display-name>Logik-Übungspunkteverwaltung</display-name>
+ <servlet>
+ <servlet-name>logikorr</servlet-name>
+ <servlet-class>logikorr.servlet</servlet-class>
+ </servlet>
+ <servlet-mapping>
+ <servlet-name>logikorr</servlet-name>
+ <url-pattern>/*</url-pattern>
+ </servlet-mapping>
+</web-app>
diff --git a/js/builder.js b/war/js/builder.js
index f1f42b9..f1f42b9 100644
--- a/js/builder.js
+++ b/war/js/builder.js
diff --git a/js/controls.js b/war/js/controls.js
index 7392fb6..7392fb6 100644
--- a/js/controls.js
+++ b/war/js/controls.js
diff --git a/js/dragdrop.js b/war/js/dragdrop.js
index 15c6dbc..15c6dbc 100644
--- a/js/dragdrop.js
+++ b/war/js/dragdrop.js
diff --git a/js/effects.js b/war/js/effects.js
index 066ee59..066ee59 100644
--- a/js/effects.js
+++ b/war/js/effects.js
diff --git a/js/prototype.js b/war/js/prototype.js
index 845ab7f..845ab7f 100644
--- a/js/prototype.js
+++ b/war/js/prototype.js
diff --git a/js/scriptaculous.js b/war/js/scriptaculous.js
index 6bf437a..6bf437a 100644
--- a/js/scriptaculous.js
+++ b/war/js/scriptaculous.js
diff --git a/js/slider.js b/war/js/slider.js
index eb83055..eb83055 100644
--- a/js/slider.js
+++ b/war/js/slider.js
diff --git a/js/sound.js b/war/js/sound.js
index a286eb9..a286eb9 100644
--- a/js/sound.js
+++ b/war/js/sound.js
diff --git a/js/unittest.js b/war/js/unittest.js
index 33a0c71..33a0c71 100644
--- a/js/unittest.js
+++ b/war/js/unittest.js
diff --git a/logikorr.js b/war/logikorr.js
index 8ed6706..8ed6706 100644
--- a/logikorr.js
+++ b/war/logikorr.js
diff --git a/war/style.css b/war/style.css
new file mode 100644
index 0000000..95c4c5e
--- /dev/null
+++ b/war/style.css
@@ -0,0 +1,27 @@
+body {
+ z-index: 0;
+}
+
+div.autocomplete {
+ position:absolute;
+ width:350px;
+ background-color:white;
+ border:1px solid #888;
+ margin:0;
+ padding:0;
+ z-index: 100;
+}
+div.autocomplete ul {
+ list-style-type:none;
+ margin:0;
+ padding:0;
+}
+div.autocomplete ul li.selected { background-color: #ffb;}
+div.autocomplete ul li {
+ list-style-type:none;
+ display:block;
+ margin:0;
+ padding:2px;
+ height:32px;
+ cursor:pointer;
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 12:43:39 +0000