Refactor main code

This commit is contained in:
Marcus Kammer 2024-05-25 20:28:39 +02:00
parent 17a9b8ab4d
commit ea21182e9e
Signed by: marcuskammer
GPG key ID: C374817BE285268F

View file

@ -1,14 +1,21 @@
(in-package :dev.metalisp.survey) (in-package :dev.metalisp.survey)
(defvar *company-logo* "company_logo.png") (defun create-server (name port &optional document-root)
(let ((acceptor (make-instance 'hunchentoot:easy-acceptor
:name name
:document-root document-root
:port port)))
acceptor))
(defun handle-acceptor (acceptor) (defun start-server (acceptor)
(lambda (action) (hunchentoot:start acceptor))
(case action
(start (hunchentoot:start acceptor)) (defun stop-server (acceptor)
(stop (hunchentoot:stop acceptor)) (hunchentoot:stop acceptor))
(restart (progn (hunchentoot:stop acceptor)
(hunchentoot:start acceptor)))))) (defun restart-server (acceptor)
(hunchentoot:stop acceptor)
(hunchentoot:start acceptor))
(defun today () (defun today ()
"Return today's date formatted as ISO-8601." "Return today's date formatted as ISO-8601."
@ -22,18 +29,15 @@
(local-time:now) (local-time:now)
:format '((:hour 2) ":" (:min 2) ":" (:sec 2)))) :format '((:hour 2) ":" (:min 2) ":" (:sec 2))))
(defvar *db* (pathname (concatenate 'string (today) "_survey-db.cl"))) (defun make-db-path (&optional date-str)
(pathname (concatenate 'string date-str "_survey-db.cl")))
(defvar *app* (handle-acceptor (make-instance 'easy-acceptor
:document-root (uiop:getcwd)
:port 8080)))
(defun load-response (db) (defun load-response (db)
(with-open-file (stream db (with-open-file (stream db
:direction :input :direction :input
:if-does-not-exist :create) :if-does-not-exist :create)
(if (= (file-length stream) 0) (if (= (file-length stream) 0)
'() (list)
(read stream)))) (read stream))))
(defun store-response (db responses) (defun store-response (db responses)
@ -42,18 +46,18 @@
:if-exists :supersede) :if-exists :supersede)
(prin1 responses stream))) (prin1 responses stream)))
(define-easy-handler (sus :uri "/") (lang) (defun return-sus-form (lang)
(setf *html-lang* lang)
(cond ((string= lang "en") (cond ((string= lang "en")
(sus-form-en)))) (sus-form-en))))
(define-easy-handler (index :uri "/") (lang)
(setf *html-lang* lang)
(return-sus-form lang))
(define-easy-handler (submit :uri "/submit") nil (define-easy-handler (submit :uri "/submit") nil
(setf (content-type*) "text/plain") (setf (content-type*) "text/plain")
(let* ((post-params (post-parameters* *request*))
(let ((post-params (post-parameters* *request*)) (stored-response (load-response (make-db-path (today))))
(stored-response (load-response *db*))) (response (reverse (push (list (now) post-params) stored-response))))
(store-response (make-db-path (today)) (reverse response))
(let ((response stored-response)) (format nil "~A" response)))
(push (list (now) post-params) response)
(store-response *db* (reverse response))
(format nil "~A" response))))