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

Refactor survey class

Browse source
This commit is contained in:
Marcus Kammer 2025-02-20 19:29:42 +01:00
parent 7bda4dd0fa
commit 209a6e1fed
Signed by: marcuskammer
GPG key ID: C374817BE285268F
3 changed files with 24 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
dev.metalisp.survey.asd
View file

@ -2,7 +2,7 @@
(defsystem "dev.metalisp.survey" (defsystem "dev.metalisp.survey"
:description "Create questionnaires and analyze the results." :description "Create questionnaires and analyze the results."
:version "0.5.29" :version "0.5.30"
:author "Marcus Kammer <marcus.kammer@mailbox.org>" :author "Marcus Kammer <marcus.kammer@mailbox.org>"
:source-control (:git "https://code.metalisp.dev/marcuskammer/dev.metalisp.survey.git") :source-control (:git "https://code.metalisp.dev/marcuskammer/dev.metalisp.survey.git")
:licence "MIT" :licence "MIT"

4
src/models/package.lisp
View file

@ -1,8 +1,8 @@
;;; -*- mode: lisp; coding: utf-8; -*- ;;; -*- mode: lisp; coding: utf-8; -*-
(defpackage :ml-survey/models (defpackage :ml-survey/models
(:use #:cl) (:use #:cl)
(:export #:survey-id (:export #:survey-uid
#:survey-id-p #:survey-uid-p
#:survey #:survey
#:survey-data-dir #:survey-data-dir
#:survey-data-dir-files #:survey-data-dir-files

32
src/models/survey.lisp
View file

@ -2,18 +2,28 @@
(in-package :ml-survey/models) (in-package :ml-survey/models)
(defclass survey () (defclass survey ()
((id :initarg :id :reader survey-id) ((uid :initarg :uid
(data-dir :initarg :data-dir :reader survey-data-dir) :reader survey-uid
(properties :initarg :properties :reader survey-properties))) :type integer
:documentation "Unique ID.")
(data-dir :initarg :data-dir
:reader survey-data-dir
:type pathname
:documentation "The directory where questionnaires are saved.")
(properties :initarg :properties
:reader survey-properties
:type list
:documentation "Properties as title and description."))
(:documentation "Represents a survey."))
(defmethod initialize-instance :after ((survey survey) &key) (defmethod initialize-instance :after ((survey survey) &key)
(with-slots (id data-dir properties) survey (with-slots (uid data-dir properties) survey
(when (not (integerp id)) (when (not (integerp uid))
(setf id (handler-case (parse-integer id) (error () nil)))) (setf uid (handler-case (parse-integer uid) (error () nil))))
(setf data-dir (uiop:merge-pathnames* (setf data-dir (uiop:merge-pathnames*
(format nil "~a/" id) (format nil "~a/" uid)
(ml-survey/fileops:ensure-surveys-dir))) (ml-survey/fileops:ensure-surveys-dir)))
(setf properties (first (rest (assoc id (ml-survey/fileops:surveys-db))))))) (setf properties (first (rest (assoc uid (ml-survey/fileops:surveys-db)))))))
(defgeneric survey-id-p (survey) (defgeneric survey-id-p (survey)
(:documentation "Check if the survey ID is present in the surveys database.")) (:documentation "Check if the survey ID is present in the surveys database."))
@ -30,7 +40,7 @@
(defgeneric survey-properties-description (survey) (defgeneric survey-properties-description (survey)
(:documentation "Get description property.")) (:documentation "Get description property."))
(defmethod survey-id-p ((survey survey)) (defmethod survey-uid-p ((survey survey))
(let ((ids (mapcar #'first (ml-survey/fileops:surveys-db)))) (let ((ids (mapcar #'first (ml-survey/fileops:surveys-db))))
(if (member (survey-id survey)) ids) t nil)) (if (member (survey-id survey)) ids) t nil))
@ -58,7 +68,7 @@ MAKE-FN: Function which is applied to the questionnaire data structure. Can be u
files))) files)))
(defun build-questionnaire-link (survey-id resource) (defun build-questionnaire-link (survey-id resource)
(format nil "/questionnaire/~a~a" survey-id resource)) (format nil "/questionnaire/~a~a" survey-uid resource))
(defmethod survey-html ((survey survey)) (defmethod survey-html ((survey survey))
(spinneret:with-html (spinneret:with-html
@ -67,6 +77,6 @@ MAKE-FN: Function which is applied to the questionnaire data structure. Can be u
for value = (cdr property) do for value = (cdr property) do
(:dt key) (:dt key)
(cond ((string= key "questionnaire") (cond ((string= key "questionnaire")
(:dd (:a :href (build-questionnaire-link (survey-id survey) value) (:dd (:a :href (build-questionnaire-link (survey-uid survey) value)
(format nil "Open Questionnaire ~a" value)))) (format nil "Open Questionnaire ~a" value))))
(t (:dd value))))))) (t (:dd value)))))))