marcuskammer/dev.metalisp.survey
1
0
Fork 0
Code Issues 9 Pull requests Projects Releases Packages Wiki Activity Actions

Persist new survey

Browse source
This commit is contained in:
Marcus Kammer 2024-05-29 23:01:23 +02:00
parent 10b6767f68
commit 5de2da8f8a
Signed by: marcuskammer
GPG key ID: C374817BE285268F
2 changed files with 15 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/main.lisp
View file

@ -30,8 +30,11 @@
(local-time:now) (local-time:now)
:format '((:hour 2) ":" (:min 2) ":" (:sec 2)))) :format '((:hour 2) ":" (:min 2) ":" (:sec 2))))
(defun make-db-path (&optional date-str) (defun make-db-path (date-str file-str)
(pathname (concatenate 'string date-str "_survey-db.lisp"))) (pathname (concatenate 'string date-str file-str)))
(defun make-surveys-db-path ()
(make-db-path (today) "-surveys-db.lisp"))
(defun load-response (db) (defun load-response (db)
(with-open-file (stream db (with-open-file (stream db
@ -67,9 +70,9 @@
(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 (make-db-path (today) "_submit-db.lisp")))
(response (reverse (push (list (now) post-params) stored-response)))) (response (reverse (push (list (now) post-params) stored-response))))
(store-response (make-db-path (today)) (reverse response)) (store-response (make-db-path (today) "_submit-db.lisp") response)
(format nil "~A" response))) (format nil "~A" response)))
(defun starts-with-subseq (subseq seq) (defun starts-with-subseq (subseq seq)
@ -96,5 +99,9 @@ The URI should start with \"/survey/\" followed by a numeric ID."
(define-easy-handler (create-survey :uri "/create-survey" (define-easy-handler (create-survey :uri "/create-survey"
:default-request-type :post) nil :default-request-type :post) nil
(let ((post-params (post-params* *request*)) (let ((post-params (post-parameters* *request*))
(uid (* (get-universal-time) (random 999)))))) (uid (* (get-universal-time) (random 999)))
(stored-surveys (load-response (make-surveys-db-path))))
(store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
(setf (content-type*) "text/plain")
(format nil "~A" post-params)))

3
src/pages.lisp
View file

@ -64,8 +64,9 @@
(:div :class "form-check" (:div :class "form-check"
(:input :class "form-check-input" (:input :class "form-check-input"
:type "checkbox" :type "checkbox"
:value "" :value "t"
:id (first el) :id (first el)
:name (first el)
(:label :class "form-check-label" (:label :class "form-check-label"
:for (first el) :for (first el)
(second el))))))) (second el)))))))