Save the response of a survey specific questionnaire to a separat file

This commit is contained in:
Marcus Kammer 2024-06-01 16:18:25 +02:00
parent b15beac0b6
commit 8f65efb80a
Signed by: marcuskammer
GPG key ID: C374817BE285268F
4 changed files with 44 additions and 10 deletions

View file

@ -17,7 +17,11 @@
#:*app* #:*app*
#:start-server #:start-server
#:stop-server #:stop-server
#:restart-server)) #:restart-server
#:today
#:now
#:generate-uuid
#:*survey-data-dir*))
(defpackage ml-survey/forms (defpackage ml-survey/forms
(:use #:cl) (:use #:cl)

View file

@ -42,13 +42,38 @@
(defun return-sus-form (lang) (defun return-sus-form (lang)
"Based on LANG decide which sus form to show." "Based on LANG decide which sus form to show."
(check-type lang string) (check-type lang string)
(cond ((string= lang "en") (ml-survey/forms:sus-form-en)) (cond ((string= lang "en") #'ml-survey/forms:sus-form-en)
((string= lang "de") (ml-survey/forms:sus-form-de)) ((string= lang "de") #'ml-survey/forms:sus-form-de)
(t (error "Unsupported language: ~A" lang)))) (t (error "Unsupported language: ~A" lang))))
(define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang) (define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
(let ((survey-id (second (split-uri (hunchentoot:request-uri*)))))
(setf *html-lang* lang) (setf *html-lang* lang)
(return-sus-form lang)) (funcall (return-sus-form lang) survey-id)))
(defun questionnaire-submit-uri-p (uri)
"Check if the request URI matches the pattern '/survey/<numeric>'"
(let ((parts (split-uri uri)))
(and (= (length parts) 3)
(string= (first parts) "survey")
(every #'digit-char-p (second parts))
(search "submit" (third parts)))))
(defun questionnaire-submit-uri (request)
(questionnaire-submit-uri-p (hunchentoot:request-uri request)))
(defun ensure-data-file-exist (id &optional lang)
(ensure-directories-exist (format nil "~a~a/~a-~a.lisp"
*survey-data-dir*
id
(generate-uuid)
lang)))
(define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) (lang)
(let ((post-params (post-parameters* *request*))
(id (second (split-uri (hunchentoot:request-uri*)))))
(store-response (ensure-data-file-exist id lang) post-params)
"thank you"))
(defun survey-uri-p (uri) (defun survey-uri-p (uri)
"Check if the request URI matches the pattern '/survey/<numeric>'" "Check if the request URI matches the pattern '/survey/<numeric>'"
@ -72,7 +97,7 @@
(define-easy-handler (create-survey :uri "/create-survey") nil (define-easy-handler (create-survey :uri "/create-survey") nil
(let ((post-params (post-parameters* *request*)) (let ((post-params (post-parameters* *request*))
(uid (* (get-universal-time) (random 999))) (uid (ml-survey:generate-uuid))
(stored-surveys (load-response (make-surveys-db-path)))) (stored-surveys (load-response (make-surveys-db-path))))
(store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys)) (store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
(ml-survey/views:create-survey uid))) (ml-survey/views:create-survey uid)))

View file

@ -1,5 +1,10 @@
(in-package :ml-survey) (in-package :ml-survey)
(defvar *survey-data-dir*
(ensure-directories-exist (format nil
"~adata/survey/"
(uiop:getcwd))))
(defun create-server (name port &key address document-root) (defun create-server (name port &key address document-root)
(let ((acceptor (make-instance 'hunchentoot:easy-acceptor (let ((acceptor (make-instance 'hunchentoot:easy-acceptor
:address address :address address

View file

@ -1,12 +1,12 @@
(in-package :ml-survey/forms) (in-package :ml-survey/forms)
(defun sus-form-en () (defun sus-form-en (survey-id)
(with-page (:title "SUS Form") (with-page (:title "SUS Form")
(ml-survey/partials:navbar-en) (ml-survey/partials:navbar-en)
(:section :class "container" (:section :class "container"
(:h2 "Usability Feedback Form") (:h2 "Usability Feedback Form")
(:p "Please fill out the following forms and press the submit button.") (:p "Please fill out the following forms and press the submit button.")
(:form :action "/submit" (:form :action (format nil "/survey/~a/submit?lang=en" survey-id)
:method "post" :method "post"
:class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5) :class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5)
(multi-form (multi-form
@ -104,13 +104,13 @@
(find-l10n "submit" *html-lang* *l10n*)))))) (find-l10n "submit" *html-lang* *l10n*))))))
(defun sus-form-de () (defun sus-form-de (survey-id)
(with-page (:title "SUS Formular") (with-page (:title "SUS Formular")
(ml-survey/partials:navbar-de) (ml-survey/partials:navbar-de)
(:section :class "container" (:section :class "container"
(:h2 "Usability Feedback Formular") (:h2 "Usability Feedback Formular")
(:p "Bitte füllen Sie die folgende Formular aus und klicken Sie auf die Schaltfläche 'Senden'.") (:p "Bitte füllen Sie die folgende Formular aus und klicken Sie auf die Schaltfläche 'Senden'.")
(:form :action "/submit" (:form :action (format nil "/survey/~a/submit?lang=de" survey-id)
:method "post" :method "post"
:class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5) :class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5)
(multi-form (multi-form