diff --git a/dev.metalisp.survey.asd b/dev.metalisp.survey.asd index 66a681c..71ebbea 100644 --- a/dev.metalisp.survey.asd +++ b/dev.metalisp.survey.asd @@ -10,6 +10,7 @@ ((:module "src" :components ((:file "package") + (:file "fileops") (:file "app") (:file "survey"))) diff --git a/src/fileops.lisp b/src/fileops.lisp new file mode 100644 index 0000000..ab301d7 --- /dev/null +++ b/src/fileops.lisp @@ -0,0 +1,75 @@ +(in-package :ml-survey) + +(defun base-dir () + (let ((os (uiop:detect-os))) + (cond ((eq os :os-windows) + (format nil "~a/" (uiop:getenv "LOCALAPPDATA"))) + + ((eq os :os-unix) + (format nil "~a" (uiop:merge-pathnames* + ".local/share/" + (format nil + "~a/" + (uiop:getenv "HOME"))))) + + ((eq os :os-macos) + (format nil "~a" (uiop:merge-pathnames* + "Library/Application Support/" + (format nil + "~a/" + (uiop:getenv "HOME"))))) + + (t (error "Unsupported OS"))))) + +(defun app-dir () + (uiop:merge-pathnames* "ml-survey/" (base-dir))) + +(defun data-dir () + (uiop:merge-pathnames* "data/surveys/" (app-dir))) + +(defun ensure-data-dir () + (let ((data-dir (data-dir))) + (ensure-directories-exist (data-dir)) + data-dir)) + +(defun ensure-file-exist (pathname) + "Ensure that a file specified by PATHNAME exists, create it if it doesn't." + (unless (uiop:file-exists-p pathname) + (with-open-file (stream pathname + :direction :output + :if-exists :overwrite + :if-does-not-exist :create) + (format stream ""))) + pathname) + +(defun ensure-data-file-exist (survey-id questionnaire-id) + (let ((path (format nil "~a~a/~a.lisp" + (ensure-data-dir) + survey-id + questionnaire-id))) + (ensure-directories-exist path) + (ensure-file-exist path))) + +(defun make-db-file (file) + "Prepare and ensure a database file at FILE-STR path." + (check-type file string) + (let ((path (uiop:merge-pathnames* file (ensure-data-dir)))) + (ensure-file-exist path))) + + +(defun load-response (db) + (check-type db (or string pathname)) + (with-open-file (stream db + :direction :input + :if-does-not-exist :create) + (if (= (file-length stream) 0) + (list) + (read stream)))) + +(defun store-response (db responses) + (check-type db (or string pathname)) + (check-type responses list) + (with-open-file (stream db + :direction :output + :if-exists :supersede) + (prin1 responses stream))) diff --git a/src/handlers/main.lisp b/src/handlers/main.lisp index 5d0734a..279e3a4 100644 --- a/src/handlers/main.lisp +++ b/src/handlers/main.lisp @@ -1,37 +1,5 @@ (in-package :ml-survey/handlers) -(defun base-dir () - (let ((os (uiop:detect-os))) - (cond ((eq os :os-windows) - (format nil "~a/" (uiop:getenv "LOCALAPPDATA"))) - - ((eq os :os-unix) - (format nil "~a" (uiop:merge-pathnames* - ".local/share/" - (format nil - "~a/" - (uiop:getenv "HOME"))))) - - ((eq os :os-macos) - (format nil "~a" (uiop:merge-pathnames* - "Library/Application Support/" - (format nil - "~a/" - (uiop:getenv "HOME"))))) - - (t (error "Unsupported OS"))))) - -(defun app-dir () - (uiop:merge-pathnames* "ml-survey/" (base-dir))) - -(defun data-dir () - (uiop:merge-pathnames* "data/surveys/" (app-dir))) - -(defun ensure-data-dir () - (let ((data-dir (data-dir))) - (ensure-directories-exist (data-dir)) - data-dir)) - (defun split-uri (uri) (check-type uri string) (remove-if #'string-empty-p @@ -56,50 +24,6 @@ (local-time:now) :format '((:hour 2) ":" (:min 2) ":" (:sec 2)))) -(defun ensure-file-exist (pathname) - "Ensure that a file specified by PATHNAME exists, create it if it doesn't." - (unless (uiop:file-exists-p pathname) - (with-open-file (stream pathname - :direction :output - :if-exists :overwrite - :if-does-not-exist :create) - (format stream ""))) - pathname) - -(defun ensure-data-file-exist (survey-id questionnaire-id) - (let ((path (format nil "~a~a/~a.lisp" - (ensure-data-dir) - survey-id - questionnaire-id))) - (ensure-directories-exist path) - (ensure-file-exist path))) - -(defun make-db-file (file) - "Prepare and ensure a database file at FILE-STR path." - (check-type file string) - (let ((path (uiop:merge-pathnames* file (ensure-data-dir)))) - (ensure-file-exist path))) - -(defun make-surveys-db-file () - (make-db-file "surveys-db.lisp")) - -(defun load-response (db) - (check-type db (or string pathname)) - (with-open-file (stream db - :direction :input - :if-does-not-exist :create) - (if (= (file-length stream) 0) - (list) - (read stream)))) - -(defun store-response (db responses) - (check-type db (or string pathname)) - (check-type responses list) - (with-open-file (stream db - :direction :output - :if-exists :supersede) - (prin1 responses stream))) - (defun generate-uuid () (parse-integer (format nil "~A~A~A" (sb-posix:getpid) diff --git a/src/handlers/package.lisp b/src/handlers/package.lisp index 96d40a9..38eda8b 100644 --- a/src/handlers/package.lisp +++ b/src/handlers/package.lisp @@ -9,4 +9,10 @@ #:content-type* #:request-uri #:request-uri* - #:*request*)) + #:*request*) + (:import-from #:ml-survey + #:ensure-data-dir + #:ensure-data-file-exist + #:store-response + #:load-response + #:make-surveys-db-file)) diff --git a/src/handlers/questionnaire.lisp b/src/handlers/questionnaire.lisp index 77dbbec..fee7f8f 100644 --- a/src/handlers/questionnaire.lisp +++ b/src/handlers/questionnaire.lisp @@ -20,20 +20,20 @@ (defun process-questionnaire-get (lang s) (check-type lang string) - (check-type s survey) + (check-type s ml-survey:survey) (setf *html-lang* lang) - (funcall (choose-sus-form lang) (survey-id s))) + (funcall (choose-sus-form lang) (ml-survey:survey-id s))) (defun process-questionnaire-post (request s) (let ((post-params (post-parameters* request)) (questionnaire-id (generate-uuid))) - (store-response (ensure-data-file-exist (survey-id s) + (store-response (ensure-data-file-exist (ml-survey:survey-id s) questionnaire-id) post-params) (ml-survey/views:questionnaire-submit))) (define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang) - (let ((s (make-instance 'survey :id (get-survey-id (request-uri*))))) + (let ((s (make-instance 'ml-survey:survey :id (get-survey-id (request-uri*))))) (cond ((eq (hunchentoot:request-method*) :get) (process-questionnaire-get lang s)) ((eq (hunchentoot:request-method*) :post) diff --git a/src/package.lisp b/src/package.lisp index 585966f..45995c1 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -8,6 +8,11 @@ #:survey-data-dir-p #:survey-data-dir-files #:survey-html + #:ensure-data-dir + #:ensure-data-file-exist + #:store-response + #:load-response + #:make-surveys-db-file #:start #:*app* #:set-default-directory diff --git a/src/survey.lisp b/src/survey.lisp index b4368b8..599ff3e 100644 --- a/src/survey.lisp +++ b/src/survey.lisp @@ -1,3 +1,8 @@ +(in-package :ml-survey) + +(defun make-surveys-db-file () + (make-db-file "surveys-db.lisp")) + (defclass survey () ((id :initarg :id :reader survey-id) (data-dir :initarg :data-dir :reader survey-data-dir) diff --git a/src/views/survey.lisp b/src/views/survey.lisp index 2c6b6d2..3670951 100644 --- a/src/views/survey.lisp +++ b/src/views/survey.lisp @@ -1,6 +1,7 @@ (in-package :ml-survey/views) (defun survey (survey &optional results) + (check-type survey ml-survey:survey) "Generates the view to show the survey created." (with-page (:title "Survey Details") (navbar-en)