diff --git a/dev.metalisp.survey.asd b/dev.metalisp.survey.asd index 5268fd2..c122729 100644 --- a/dev.metalisp.survey.asd +++ b/dev.metalisp.survey.asd @@ -2,7 +2,7 @@ (defsystem "dev.metalisp.survey" :description "Create questionnaires and analyze the results." - :version "0.5.37" + :version "0.5.38" :author "Marcus Kammer " :source-control (:git "https://code.metalisp.dev/marcuskammer/dev.metalisp.survey.git") :licence "MIT" diff --git a/src/create/handler.lisp b/src/create/handler.lisp index 602a658..32d242e 100644 --- a/src/create/handler.lisp +++ b/src/create/handler.lisp @@ -6,13 +6,13 @@ (defun process-post (request) (let* ((post-params (hunchentoot:post-parameters* request)) - (uid (ml-survey/app:generate-uuid)) + (new-survey (make-survey :properties post-params)) (surveys-db-file (ml-survey/fileops:make-surveys-db-file)) (stored-surveys (ml-survey/fileops:read-from-file surveys-db-file)) - (new-value (list uid post-params))) + (new-entry (survey-to-plist new-survey))) (ml-survey/fileops:write-to-file surveys-db-file - (push new-value stored-surveys)) - (view uid))) + (push new-entry stored-surveys)) + (view (survey-uid new-survey)))) (defun process-request (request) (ecase (hunchentoot:request-method*) diff --git a/src/fileops.lisp b/src/fileops.lisp index 767ef22..1641bf0 100644 --- a/src/fileops.lisp +++ b/src/fileops.lisp @@ -101,6 +101,7 @@ within the data directory." (defun write-to-file (db responses) (check-type db (or string pathname)) (check-type responses list) + (ensure-directories-exist db) (with-open-file (stream db :direction :output :if-exists :supersede) diff --git a/src/models/package.lisp b/src/models/package.lisp index 18310d8..225777f 100644 --- a/src/models/package.lisp +++ b/src/models/package.lisp @@ -2,6 +2,9 @@ (defpackage :ml-survey/models (:use #:cl) (:export #:object-to-plist + #:make-survey + #:survey-to-plist + #:plist-to-survey #:survey-uid #:survey-uid-p #:survey @@ -13,10 +16,10 @@ #:survey-properties-description #:survey-html #:survey-questionnaires + #:filter-surveys-by-uid #:questionnaire #:questionnaire-uid #:questionnaire-name - #:questionnaire-type #:questionnaire-lang #:questionnaire-timestamp-created #:questionnaire-post-params diff --git a/src/models/questionnaire.lisp b/src/models/questionnaire.lisp index fbfbe8a..a4f9d28 100644 --- a/src/models/questionnaire.lisp +++ b/src/models/questionnaire.lisp @@ -5,40 +5,47 @@ (defclass questionnaire () ((uid :initarg :uid :reader questionnaire-uid + :type integer + :initform (ml-survey/app:generate-uuid) :documentation "Unique identifier for this questionnaire instance (auto-generated).") (name :initarg :name :reader questionnaire-name + :type string + :initform "sus" :documentation "The display name of the questionnaire.") - (type :initarg :type - :reader questionnaire-type - :documentation "The questionnaire type. (e.g. likert, mixed)") (lang :initarg :lang :reader questionnaire-lang + :type string + :initform "en" :documentation "Language code for the questionnaire.") (data-file :initarg :data-file :accessor questionnaire-data-file + :type pathname + :initform (ml-survey/fileops:ensure-surveys-dir) :documentation "Location of data file as pathname.") (survey-uid :initarg :survey-uid :reader questionnaire-survey-uid + :type integer + :initform 0 :documentation "Unique identifier for the survey.") (post-params :initarg :post-params :accessor questionnaire-post-params :documentation "Additional parameters for post-processing.") (timestamp-created :initarg :timestamp-created :reader questionnaire-timestamp-created + :initform (ml-survey/app:today+now) :documentation "Creation/modification time (auto-generated)."))) (defmethod initialize-instance :after ((q questionnaire) &key) - (with-slots (timestamp-created uid data-file survey-uid) q - (or timestamp-created - (setf timestamp-created (ml-survey/app:today+now))) - (or uid - (setf uid (ml-survey/app:generate-uuid))) - (or data-file - (setf data-file (pathname (format nil "~a~a/~a.lisp" - (ml-survey/fileops:ensure-surveys-dir) - survey-uid - uid)))))) + (with-slots (uid data-file survey-uid) q + (let ((uid-str (format nil "~a" uid)) + (data-file-str (format nil "~a" data-file))) + (unless (search uid-str data-file-str) + (setf data-file + (pathname (format nil "~a~a/~a.lisp" + (ml-survey/fileops:ensure-surveys-dir) + survey-uid + uid))))))) (defmethod make-questionnaire (&rest initargs &key &allow-other-keys) "Create a new questionnaire instance. @@ -51,4 +58,4 @@ Accepts all valid initargs for questionnaire class." (defmethod questionnaire-write-file ((q questionnaire)) (ml-survey/fileops:write-to-file (questionnaire-data-file q) - (questionnaire-to-list q))) + (questionnaire-to-plist q))) diff --git a/src/models/survey.lisp b/src/models/survey.lisp index 72f93d6..3741ae2 100644 --- a/src/models/survey.lisp +++ b/src/models/survey.lisp @@ -1,31 +1,35 @@ ;;; -*- mode: lisp; coding: utf-8; -*- + (in-package :ml-survey/models) (defclass survey () ((uid :initarg :uid :reader survey-uid :type integer + :initform (ml-survey/app:generate-uuid) :documentation "Unique ID.") (data-dir :initarg :data-dir :reader survey-data-dir :type pathname + :initform (ml-survey/fileops:ensure-surveys-dir) :documentation "The directory where questionnaires are saved.") (properties :initarg :properties - :reader survey-properties + :accessor survey-properties :type list + :initform '(("title" . "") + ("description" . "") + ("questionnaire" . "")) :documentation "Properties as title and description.")) (:documentation "Represents a survey.")) (defmethod initialize-instance :after ((survey survey) &key) - (with-slots (uid data-dir properties) survey - (or (if (integerp uid) - uid - (setf uid (parse-integer uid))) - (setf uid (ml-survey/app:generate-uuid))) - (or data-dir + (with-slots (uid data-dir) survey + (let ((uid-str (format nil "~a/" uid)) + (data-dir-str (format nil "~a" data-dir))) + (unless (search uid-str data-dir-str) (setf data-dir - (uiop:merge-pathnames* (format nil "~a/" uid) - (ml-survey/fileops:ensure-surveys-dir)))))) + (uiop:merge-pathnames* uid-str + (ml-survey/fileops:ensure-surveys-dir))))))) (defgeneric survey-id-p (survey) (:documentation "Check if the survey ID is present in the surveys database.")) @@ -43,8 +47,12 @@ (:documentation "Get description property.")) (defmethod survey-uid-p ((survey survey)) - (let ((ids (mapcar #'first (ml-survey/fileops:surveys-db)))) - (if (member (survey-id survey)) ids) t nil)) + (if (remove-if-not (lambda (s) + (eql (getf s :uid) + (survey-uid survey))) + (ml-survey/fileops:surveys-db)) + t + nil)) (defmethod survey-data-dir-files ((survey survey)) (uiop:directory-files (survey-data-dir survey))) @@ -72,9 +80,22 @@ MAKE-FN: Function which is applied to the questionnaire data structure. Can be u (defmethod survey-to-plist ((survey survey)) (object-to-plist survey)) -(defun build-questionnaire-link (survey-id resource) +(defun make-survey (&rest initargs &key &allow-other-keys) + "Create a new survey instance. +Accepts all valid initargs for survey class." + (apply #'make-instance 'survey initargs)) + +(defun build-questionnaire-link (survey-uid resource) (format nil "/questionnaire/~a~a" survey-uid resource)) +(defun plist-to-survey (survey-plist) + (apply #'make-instance 'survey survey-plist)) + +(defun filter-surveys-by-uid (survey-uid) + (remove-if-not (lambda (s) + (eql (getf s :uid) survey-uid)) + (ml-survey/fileops:surveys-db))) + (defmethod survey-html ((survey survey)) (spinneret:with-html (:dl (loop for property in (survey-properties survey) @@ -83,5 +104,5 @@ MAKE-FN: Function which is applied to the questionnaire data structure. Can be u (:dt key) (cond ((string= key "questionnaire") (: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))))))) diff --git a/src/questionnaire/handler.lisp b/src/questionnaire/handler.lisp index c0b3d57..69543ac 100644 --- a/src/questionnaire/handler.lisp +++ b/src/questionnaire/handler.lisp @@ -33,10 +33,7 @@ (define-easy-handler (questionnaire-handler :uri #'questionnaire-uri) () (let* ((survey-uid (parse-integer (extract-uri-param :survey-id))) - (questionnaire (make-questionnaire :timestamp-created nil - :uid nil - :data-file nil - :survey-uid survey-uid + (questionnaire (make-questionnaire :survey-uid survey-uid :lang (extract-uri-param :lang) :name (extract-uri-param :questionnaire)))) (process-request questionnaire))) diff --git a/src/survey/handler.lisp b/src/survey/handler.lisp index dc3eeef..6b32a1d 100644 --- a/src/survey/handler.lisp +++ b/src/survey/handler.lisp @@ -12,9 +12,9 @@ (survey-uri-p (hunchentoot:request-uri request))) (define-easy-handler (survey-handler :uri #'survey-uri) () - (let* ((survey-uid (ml-survey/app:extract-from (hunchentoot:request-uri*) - :survey-id)) - (s (make-instance 'survey :id survey-uid)) + (let* ((survey-uid (parse-integer (ml-survey/app:extract-from (hunchentoot:request-uri*) + :survey-id))) + (s (plist-to-survey (first (filter-surveys-by-uid survey-uid)))) (questionnaires (survey-questionnaires s)) (assessments (parse-questionnaires questionnaires))) (view s assessments))) diff --git a/src/survey/view.lisp b/src/survey/view.lisp index 1660520..9d08c91 100644 --- a/src/survey/view.lisp +++ b/src/survey/view.lisp @@ -11,9 +11,9 @@ (with-body-main "fluid" (:div :class "row" (with-section-props (with-title-bar "Properties") - (:p (format nil "ID: ~a" (survey-id survey))) + (:p (format nil "ID: ~a" (survey-uid survey))) (survey-html survey)) (with-section-col (with-title-bar "Assesments") (loop for assessment in assessments when assessments - do (assessment-html assessment (survey-id survey))))))))) + do (assessment-html assessment (survey-uid survey))))))))) diff --git a/src/surveys/handler.lisp b/src/surveys/handler.lisp index 5581d74..7396aeb 100644 --- a/src/surveys/handler.lisp +++ b/src/surveys/handler.lisp @@ -3,8 +3,7 @@ (defun list-of-surveys () (mapcar (lambda (x) - (make-instance 'survey - :id (first x))) + (plist-to-survey x)) (ml-survey/fileops:surveys-db))) (define-easy-handler (surveys-handler :uri "/") nil diff --git a/src/surveys/view.lisp b/src/surveys/view.lisp index 960b812..ef34e80 100644 --- a/src/surveys/view.lisp +++ b/src/surveys/view.lisp @@ -28,7 +28,7 @@ SURVEYS: List of survey objects." (let* ((title (survey-properties-title survey)) (description (survey-properties-description survey)) (description-empty (string= description "")) - (id (survey-id survey)) + (id (survey-uid survey)) (url (format nil "/surveys/~a" id))) (with-card* :card-header