diff --git a/package.lisp b/package.lisp index a7b6222..97d928a 100644 --- a/package.lisp +++ b/package.lisp @@ -17,7 +17,11 @@ #:*app* #:start-server #:stop-server - #:restart-server)) + #:restart-server + #:today + #:now + #:generate-uuid + #:*survey-data-dir*)) (defpackage ml-survey/forms (:use #:cl) diff --git a/src/handlers.lisp b/src/handlers.lisp index b2ea42a..576607c 100644 --- a/src/handlers.lisp +++ b/src/handlers.lisp @@ -42,13 +42,38 @@ (defun return-sus-form (lang) "Based on LANG decide which sus form to show." (check-type lang string) - (cond ((string= lang "en") (ml-survey/forms:sus-form-en)) - ((string= lang "de") (ml-survey/forms:sus-form-de)) + (cond ((string= lang "en") #'ml-survey/forms:sus-form-en) + ((string= lang "de") #'ml-survey/forms:sus-form-de) (t (error "Unsupported language: ~A" lang)))) (define-easy-handler (questionnaire :uri #'questionnaire-uri) (lang) - (setf *html-lang* lang) - (return-sus-form lang)) + (let ((survey-id (second (split-uri (hunchentoot:request-uri*))))) + (setf *html-lang* lang) + (funcall (return-sus-form lang) survey-id))) + +(defun questionnaire-submit-uri-p (uri) + "Check if the request URI matches the pattern '/survey/'" + (let ((parts (split-uri uri))) + (and (= (length parts) 3) + (string= (first parts) "survey") + (every #'digit-char-p (second parts)) + (search "submit" (third parts))))) + +(defun questionnaire-submit-uri (request) + (questionnaire-submit-uri-p (hunchentoot:request-uri request))) + +(defun ensure-data-file-exist (id &optional lang) + (ensure-directories-exist (format nil "~a~a/~a-~a.lisp" + *survey-data-dir* + id + (generate-uuid) + lang))) + +(define-easy-handler (questionnaire-submit :uri #'questionnaire-submit-uri) (lang) + (let ((post-params (post-parameters* *request*)) + (id (second (split-uri (hunchentoot:request-uri*))))) + (store-response (ensure-data-file-exist id lang) post-params) + "thank you")) (defun survey-uri-p (uri) "Check if the request URI matches the pattern '/survey/'" @@ -72,7 +97,7 @@ (define-easy-handler (create-survey :uri "/create-survey") nil (let ((post-params (post-parameters* *request*)) - (uid (* (get-universal-time) (random 999))) + (uid (ml-survey:generate-uuid)) (stored-surveys (load-response (make-surveys-db-path)))) (store-response (make-surveys-db-path) (push (list uid post-params) stored-surveys)) (ml-survey/views:create-survey uid))) diff --git a/src/main.lisp b/src/main.lisp index d915a96..7f1c0ed 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -1,5 +1,10 @@ (in-package :ml-survey) +(defvar *survey-data-dir* + (ensure-directories-exist (format nil + "~adata/survey/" + (uiop:getcwd)))) + (defun create-server (name port &key address document-root) (let ((acceptor (make-instance 'hunchentoot:easy-acceptor :address address diff --git a/src/views/forms/sus.lisp b/src/views/forms/sus.lisp index 5cfbff9..a3e6919 100644 --- a/src/views/forms/sus.lisp +++ b/src/views/forms/sus.lisp @@ -1,12 +1,12 @@ (in-package :ml-survey/forms) -(defun sus-form-en () +(defun sus-form-en (survey-id) (with-page (:title "SUS Form") (ml-survey/partials:navbar-en) (:section :class "container" (:h2 "Usability Feedback Form") (:p "Please fill out the following forms and press the submit button.") - (:form :action "/submit" + (:form :action (format nil "/survey/~a/submit?lang=en" survey-id) :method "post" :class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5) (multi-form @@ -104,13 +104,13 @@ (find-l10n "submit" *html-lang* *l10n*)))))) -(defun sus-form-de () +(defun sus-form-de (survey-id) (with-page (:title "SUS Formular") (ml-survey/partials:navbar-de) (:section :class "container" (:h2 "Usability Feedback Formular") (:p "Bitte füllen Sie die folgende Formular aus und klicken Sie auf die Schaltfläche 'Senden'.") - (:form :action "/submit" + (:form :action (format nil "/survey/~a/submit?lang=de" survey-id) :method "post" :class (dev.metalisp.sbt/utility:spacing :property "m" :side "y" :size 5) (multi-form