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

Handle sus form for specific survey

Browse source
This commit is contained in:
Marcus Kammer 2024-05-31 20:59:49 +02:00
parent 213a05fa6b
commit d4b78a3ac4
Signed by: marcuskammer
GPG key ID: C374817BE285268F
1 changed files with 40 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
src/handlers.lisp
View file

@ -1,23 +1,16 @@
(in-package :ml-survey) (in-package :ml-survey)
(defun return-sus-form (lang) ;; (define-easy-handler (sus :uri "/sus") (lang)
"Based on LANG decide which sus form to show." ;; (setf *html-lang* lang)
(check-type lang string) ;; (return-sus-form lang))
(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 (sus :uri "/sus") (lang) ;; (define-easy-handler (submit :uri "/submit") nil
(setf *html-lang* lang) ;; (setf (content-type*) "text/plain")
(return-sus-form lang)) ;; (let* ((post-params (post-parameters* *request*))
;; (stored-response (load-response (make-db-path (today) "_submit-db.lisp")))
(define-easy-handler (submit :uri "/submit") nil ;; (response (reverse (push (list (now) post-params) stored-response))))
(setf (content-type*) "text/plain") ;; (store-response (make-db-path (today) "_submit-db.lisp") response)
(let* ((post-params (post-parameters* *request*)) ;; (format nil "~A" response)))
(stored-response (load-response (make-db-path (today) "_submit-db.lisp")))
(response (reverse (push (list (now) post-params) stored-response))))
(store-response (make-db-path (today) "_submit-db.lisp") response)
(format nil "~A" response)))
;; (defun starts-with-subseq (subseq seq) ;; (defun starts-with-subseq (subseq seq)
;; "Check if the sequence SEQ starts with the subsequence SUBSEQ." ;; "Check if the sequence SEQ starts with the subsequence SUBSEQ."
@ -33,12 +26,38 @@
;; (and (starts-with-subseq "/survey/" uri) ;; (and (starts-with-subseq "/survey/" uri)
;; (every #'digit-char-p id)))) ;; (every #'digit-char-p id))))
(defun string-empty-p (string) (= (length string) 0))
(defun split-uri (uri)
(remove-if #'string-empty-p (uiop:split-string uri :separator "/")))
(defun questionnaire-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)))))
(defun questionnaire-uri (request)
(questionnaire-uri-p (hunchentoot:request-uri request)))
(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))
(t (error "Unsupported language: ~A" lang))))
(define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang)
(setf *html-lang* lang)
(return-sus-form lang))
(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>'"
(let ((parts (uiop:split-string uri :separator "/"))) (let ((parts (split-uri uri)))
(and (= (length parts) 3) (and (= (length parts) 2)
(string= (second parts) "survey") (string= (first parts) "survey")
(every #'digit-char-p (third parts))))) (every #'digit-char-p (second parts)))))
(defun survey-uri (request) (defun survey-uri (request)
(let ((uri (hunchentoot:request-uri request))) (let ((uri (hunchentoot:request-uri request)))