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

Call a function to build the questionnaire link

Browse source
This commit is contained in:
Marcus Kammer 2024-06-08 17:49:08 +02:00
parent 8becb3d8aa
commit ec139b644c
Signed by: marcuskammer
GPG key ID: C374817BE285268F
1 changed files with 10 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/handlers/survey.lisp
View file

@ -61,6 +61,9 @@ Returns a list of integers."
(defmethod survey-data-dir-p ((survey survey))
(uiop:directory-exists-p (survey-data-dir survey)))
(defun build-questionnaire-link (survey-id resource)
(format nil "/survey/~a/~a" survey-id resource))
(defmethod survey-html ((survey survey))
(spinneret:with-html
(:table :class "table"
@ -73,18 +76,15 @@ Returns a list of integers."
for key = (car property)
for value = (cdr property) do
(:tr (:td key)
(:td (if (string= key "questionnaire")
(:a :href (concatenate 'string "/survey/" (survey-id survey) value)
value)
value))))))))
(cond ((string= key "questionnaire")
(:td (:a :href (build-questionnaire-link (survey-id survey) value))))
(t (:td value)))))))))
(defun survey-uri-p (uri)
(let* ((parts (split-uri uri))
(s (make-instance 'survey :id (second parts))))
(and (= (length parts) 2)
(string= (first parts) "survey")
(every #'digit-char-p (survey-id s))
(survey-id-p s))))
(let ((parts (split-uri uri)))
(and (= (length parts) 2)
(string= (first parts) "survey")
(every #'digit-char-p (second parts)))))
(defun survey-uri (request)
(survey-uri-p (request-uri request)))