diff --git a/src/server/main.lisp b/src/server/main.lisp index a146077..d97d942 100644 --- a/src/server/main.lisp +++ b/src/server/main.lisp @@ -21,6 +21,51 @@ (defvar *server* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))) +(defun post-health-form (data-list) + "Takes the health form as an alist and posts it to nocodb" + (let* ((student-name (concatenate 'string + (cdr (assoc "firstname" data-list :test 'string=)) + " " + (cdr (assoc "lastname" data-list :test 'string=)))) + (parent-name (concatenate 'string + (cdr (assoc "parentfirstname" data-list :test 'string=)) + " " + (cdr (assoc "parentlastname" data-list :test 'string=)))) + (headers (list (cons "xc-token" *auth-token*) (cons "Content-Type" "application/json")))) + + (setf (cdr (assoc "firstname" data-list :test 'string=)) student-name) + (setf (car (assoc "firstname" data-list :test 'string=)) "Student Name") + (setf (cdr (assoc "parentfirstname" data-list :test 'string=)) parent-name) + (setf (car (assoc "parentfirstname" data-list :test 'string=)) "Parent Name") + (setf (car (assoc "add-emergency-contact" data-list :test 'string=)) "emergency-contact") + (setf (car (assoc "doctorname" data-list :test 'string=)) "doctor") + (setf (car (assoc "doctorphone" data-list :test 'string=)) "doctor-phone") + (setf (car (assoc "doctorcity" data-list :test 'string=)) "doctor-city") + (setf (car (assoc "allergic-treatment" data-list :test 'string=)) "allergy-treatments") + (setf (car (assoc "tetanus-shot" data-list :test 'string=)) "tetanus-shot-date") + (format t "~&~A" data-list) + + (dex:post "https://tbl.tfcconnection.org/api/v1/db/data/v1/TFC/Health%20Forms/" + :headers headers + :content (stringify data-list) + :verbose t))) + +(defun print-hash-entry (key value) + (format t "~S: ~S~%" key (if (hash-table-p value) (maphash 'print-hash-entry value) value))) + +(defun process-form (form) + "Processes the form and sends it on" + (uiop:println "---") + (maphash 'print-hash-entry form) + (uiop:println "---")) + +(defun save-string-file (string file-path) + "save a file that is represented as a string to disk that came from a multipart/form-data" + (serapeum/bundle:write-string-into-file string file-path + :if-exists :overwrite + :if-does-not-exist :create + :external-format :latin-1)) + (hunchentoot:define-easy-handler (respond :uri "/health-form") () (setf (hunchentoot:content-type*) "application/json") (let ((request-type (hunchentoot:request-method hunchentoot:*request*))) @@ -46,14 +91,20 @@ (end (if start (position #\" content-disposition :start (1+ start)) nil)) (name (if end (if start (subseq content-disposition (1+ start) end) nil) nil)) (content (if (string= name "image") - (rest + (butlast (rest + (rest + (rest + (rest + (serapeum:lines i :eol-style :crlf + :honor-crlf t + :keep-eols t)))))) + (butlast (rest (rest (rest (serapeum:lines i :eol-style :crlf - :honor-crlf t :keep-eols t))))) - (nth 3 (serapeum:lines i :eol-style :crlf - :honor-crlf t)))) + :honor-crlf t + :keep-eols t))))))) (file-start (if (string= name "image") (position #\" content-disposition :start 44))) (file-end (if file-start @@ -64,10 +115,16 @@ (form-list nil)) ;; This gets rid of beginning and ending NIL values + (if (string/= name "image") + (if (listp content) + (setq content (serapeum:mapconcat + (lambda (x) (if (string= x "") + (coerce #\Newline 'string) + x)) + content "")))) (if name (if (string/= name "image") (progn (format t "~&~A: ~A" name content) (setq form-list (acons name content form-list)))) nil) - (if (string= name "image") (setq content (butlast content))) (if (string= "image" name) (progn (format t "~&~A: ~A" name image-file-name) @@ -75,42 +132,6 @@ (save-string-file (apply #'concatenate 'string content) image-file-name))) - (setq *last-list-data* (append *last-list-data* form-list))))))))) - -(defun post-health-form (data-list) - "Takes the health form as an alist and posts it to nocodb" - (let* ((student-name (concatenate 'string (cdr (assoc "firstname" data-list :test 'string=)) " " (cdr (assoc "lastname" data-list :test 'string=)))) - (parent-name (concatenate 'string (cdr (assoc "parentfirstname" data-list :test 'string=)) " " (cdr (assoc "parentlastname" data-list :test 'string=)))) - (agreement t) - (medical-coverage (string= (cdr (assoc "medical-coverage" data-list :test 'string=)) "yes")) - (data nil)) - (setf (assoc "firstname" data-list :test 'string=) '("Student Name" . student-name)) - (setf (assoc "lastname" data-list :test 'string=) nil) - (setf (assoc "parentfirstname" data-list :test 'string=) '("Parent Name" . parent-name)) - (setf (assoc "parentlastname" data-list :test 'string=) nil) - (format t "~&~A" data-list) - (dex:post "https://tbl.tfcconnection.org/api/v1/db/data/v1/TFC/Health%20Forms/" - :headers '(("xc-auth" . *auth-token*)) - :content data-list))) - -(defun test-car-inner (item alist) - "Looks inside the inner car and tests to see if it is equal to item" - (format t "~&~A" (car alist)) - (eql (car alist) item)) - -(defun print-hash-entry (key value) - (format t "~S: ~S~%" key (if (hash-table-p value) (maphash 'print-hash-entry value) value))) - -(defun process-form (form) - "Processes the form and sends it on" - (uiop:println "---") - (maphash 'print-hash-entry form) - (uiop:println "---")) - -(defun save-string-file (string file-path) - "save a file that is represented as a string to disk that came from a multipart/form-data" - (serapeum/bundle:write-string-into-file string file-path - :if-exists :overwrite - :if-does-not-exist :create - :external-format :latin-1)) + (setq *last-list-data* (append *last-list-data* form-list)))) + (post-health-form *last-list-data*))))))