It works!
This addition adds a common lisp server that takes a post request from the health-form on the website and feeds it to nocodb. I still have to upload insurance cards to both nextcloud and nocodb, but I've found out how to save the images or pdfs as files and then I can worry about taking that saved file and posting it to the server.
This commit is contained in:
parent
78eb9da780
commit
96bc09ad4c
|
|
@ -21,6 +21,51 @@
|
||||||
|
|
||||||
(defvar *server* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242)))
|
(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") ()
|
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
|
||||||
(setf (hunchentoot:content-type*) "application/json")
|
(setf (hunchentoot:content-type*) "application/json")
|
||||||
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
|
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
|
||||||
|
|
@ -46,14 +91,20 @@
|
||||||
(end (if start (position #\" content-disposition :start (1+ start)) nil))
|
(end (if start (position #\" content-disposition :start (1+ start)) nil))
|
||||||
(name (if end (if start (subseq content-disposition (1+ start) end) nil) nil))
|
(name (if end (if start (subseq content-disposition (1+ start) end) nil) nil))
|
||||||
(content (if (string= name "image")
|
(content (if (string= name "image")
|
||||||
(rest
|
(butlast (rest
|
||||||
(rest
|
(rest
|
||||||
(rest
|
(rest
|
||||||
(rest
|
(rest
|
||||||
(serapeum:lines i :eol-style :crlf
|
(serapeum:lines i :eol-style :crlf
|
||||||
:honor-crlf t :keep-eols t)))))
|
:honor-crlf t
|
||||||
(nth 3 (serapeum:lines i :eol-style :crlf
|
:keep-eols t))))))
|
||||||
:honor-crlf t))))
|
(butlast
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(serapeum:lines i :eol-style :crlf
|
||||||
|
:honor-crlf t
|
||||||
|
:keep-eols t)))))))
|
||||||
(file-start (if (string= name "image")
|
(file-start (if (string= name "image")
|
||||||
(position #\" content-disposition :start 44)))
|
(position #\" content-disposition :start 44)))
|
||||||
(file-end (if file-start
|
(file-end (if file-start
|
||||||
|
|
@ -64,10 +115,16 @@
|
||||||
(form-list nil))
|
(form-list nil))
|
||||||
|
|
||||||
;; This gets rid of beginning and ending NIL values
|
;; 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
|
(if name (if (string/= name "image") (progn
|
||||||
(format t "~&~A: ~A" name content)
|
(format t "~&~A: ~A" name content)
|
||||||
(setq form-list (acons name content form-list)))) nil)
|
(setq form-list (acons name content form-list)))) nil)
|
||||||
(if (string= name "image") (setq content (butlast content)))
|
|
||||||
|
|
||||||
(if (string= "image" name)
|
(if (string= "image" name)
|
||||||
(progn (format t "~&~A: ~A" name image-file-name)
|
(progn (format t "~&~A: ~A" name image-file-name)
|
||||||
|
|
@ -75,42 +132,6 @@
|
||||||
(save-string-file
|
(save-string-file
|
||||||
(apply #'concatenate 'string content) image-file-name)))
|
(apply #'concatenate 'string content) image-file-name)))
|
||||||
|
|
||||||
(setq *last-list-data* (append *last-list-data* form-list)))))))))
|
(setq *last-list-data* (append *last-list-data* form-list))))
|
||||||
|
(post-health-form *last-list-data*))))))
|
||||||
(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))
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue