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*
#:start-server
#:stop-server
#:restart-server))
#:restart-server
#:today
#:now
#:generate-uuid
#:*survey-data-dir*))
(defpackage ml-survey/forms
(:use #:cl)

View file

@ -42,13 +42,38 @@
(defun return-sus-form (lang)
"Based on LANG decide which sus form to show."
(check-type lang string)
(cond ((string= lang "en") (ml-survey/forms:sus-form-en))
((string= lang "de") (ml-survey/forms:sus-form-de))
(cond ((string= lang "en") #'ml-survey/forms:sus-form-en)
((string= lang "de") #'ml-survey/forms:sus-form-de)
(t (error "Unsupported language: ~A" lang))))
(define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
(let ((survey-id (second (split-uri (hunchentoot:request-uri*)))))
(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)
"Check if the request URI matches the pattern '/survey/<numeric>'"
@ -72,7 +97,7 @@
(define-easy-handler (create-survey :uri "/create-survey") nil
(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))))
(store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys))
(ml-survey/views:create-survey uid)))

View file

@ -1,5 +1,10 @@
(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)
(let ((acceptor (make-instance 'hunchentoot:easy-acceptor
:address address

View file

@ -1,12 +1,12 @@
(in-package :ml-survey/forms)
(defun sus-form-en ()
(defun sus-form-en (survey-id)
(with-page (:title "SUS Form")
(ml-survey/partials:navbar-en)
(:section :class "container"
(:h2 "Usability Feedback Form")
(: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"
:class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5)
(multi-form
@ -104,13 +104,13 @@
(find-l10n "submit" *html-lang* *l10n*))))))
(defun sus-form-de ()
(defun sus-form-de (survey-id)
(with-page (:title "SUS Formular")
(ml-survey/partials:navbar-de)
(:section :class "container"
(:h2 "Usability Feedback Formular")
(: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"
:class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5)
(multi-form