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

Replace survey functions

Browse source
This commit is contained in:
Marcus Kammer 2024-06-02 21:07:47 +02:00
parent 0fa55fa629
commit 66054cddbe
Signed by: marcuskammer
GPG key ID: C374817BE285268F
2 changed files with 5 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/handlers/questionnaire-submit.lisp
View file

@ -2,10 +2,11 @@
(defun questionnaire-submit-uri-p (uri) (defun questionnaire-submit-uri-p (uri)
"Check if the request URI matches the pattern '/survey/<numeric>/submit'" "Check if the request URI matches the pattern '/survey/<numeric>/submit'"
(let ((parts (split-uri uri))) (let ((parts (split-uri uri))
(survey (make-survey uri)))
(and (= (length parts) 3) (and (= (length parts) 3)
(string= (first parts) "survey") (string= (first parts) "survey")
(and (survey-id-p (parse-integer (second parts))) (and (funcall survey 'id)
(every #'digit-char-p (second parts))) (every #'digit-char-p (second parts)))
(search "submit" (third parts))))) (search "submit" (third parts)))))
@ -21,6 +22,6 @@
(define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) nil (define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) nil
(let ((post-params (post-parameters* *request*)) (let ((post-params (post-parameters* *request*))
(id (survey-id (request-uri*)))) (survey (make-survey (request-uri*))))
(store-response (ensure-data-file-exist id) post-params) (store-response (ensure-data-file-exist (funcall survey 'id)) post-params)
(ml-survey/views:questionnaire-submit))) (ml-survey/views:questionnaire-submit)))

16
src/handlers/survey.lisp
View file

@ -1,10 +1,5 @@
(in-package :ml-survey/handlers) (in-package :ml-survey/handlers)
(defun survey-id-p (id)
(check-type id integer)
(let ((ids (mapcar #'car (load-response (make-surveys-db-path)))))
(if (member id ids) t nil)))
(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>'"
(check-type uri string) (check-type uri string)
@ -18,17 +13,6 @@
(let ((uri (request-uri request))) (let ((uri (request-uri request)))
(survey-uri-p uri))) (survey-uri-p uri)))
(defun survey-id (uri)
(check-type uri string)
(let ((id (second (split-uri uri))))
(unless (survey-id-p (parse-integer id))
(error "Wrong survey id"))
id))
(defun survey-properties (id)
(check-type id integer)
(first (rest (assoc id (load-response (make-surveys-db-path))))))
(defun make-survey (uri) (defun make-survey (uri)
(labels ((survey-fn (action) (labels ((survey-fn (action)
(case action (case action