finally able to save the picture

This commit is contained in:
Chris Cochrun 2023-05-30 15:26:57 -05:00
parent 0cad38bb05
commit d857692815
2 changed files with 49 additions and 134 deletions

View file

@ -63,12 +63,14 @@
/* data.delete("image"); */
validate(data);
let obj = {};
data.forEach((value, key) => obj[key] = value);
/* console.log(JSON.stringify(data)); */
fetch("http://localhost:4242/health-form", {
method: "POST",
/* headers: {
* "Content-Type": "multipart/form-data",
* "Content-Type": "application/json",
* }, */
body: data
}).then((res) => {

View file

@ -6,24 +6,20 @@
(in-package :tfc-server)
;; (defun handler (env) '(200 nil ("Hello World, bleh!")))
(defvar *last*)
(defvar *last-data*)
(defvar *last-list-data*)
(defvar *stream*)
(defvar *token* "boFFRM68vvXbO-DO7S9YDg86lHX027-hd07mn0dh")
;; (clack:stop (clack:clackup (lambda (env)
;; '(200 nil ("Hello, World!")))
;; (clack.handler:stop *clack-server*)
(setf hunchentoot:*default-connection-timeout* 240)
;; (defparameter *clack-server* (clack:clackup (lambda (env)
;; (funcall 'handler env))))
(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
(defvar *server* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242)))
(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
(setf (hunchentoot:content-type*) "text/plain")
(format nil "Hey~@[ ~A~]!" name))
(setf hunchentoot:*default-connection-timeout* 160)
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
(setf (hunchentoot:content-type*) "application/json")
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
@ -34,158 +30,75 @@
(setq *stream* (hunchentoot::content-stream hunchentoot:*request*))
(let* ((stream (hunchentoot::content-stream hunchentoot:*request*))
(data (hunchentoot::get-post-data :request *last*))
(content-type (hunchentoot:header-in "content-type" *last*))
(content-type (hunchentoot:header-in "content-type" hunchentoot:*request*))
(boundary (let ((position (position #\= content-type)))
(when position
(subseq content-type (1+ position)))))
(string-data (flexi-streams:octets-to-string data))
(parts (ppcre:split boundary string-data))
;; (multipart-parser (fast-http:make-multipart-parser content-type
;; (lambda (field-name field-headers field-metadata field-body-bytes)
;; (uiop:println field-name)
;; (uiop:println field-headers)
;; (uiop:println field-metadata)
;; (uiop:println field-body-bytes)
;; )))
)
(parts (ppcre:split boundary string-data)))
;; (uiop:println (fast-http:http-multipart-parse multipart-parser (lambda (field-name field-headers field-metadata field-body-bytes)
;; (uiop:println field-name)
;; (uiop:println field-headers)
;; (uiop:println field-metadata)
;; (uiop:println field-body-bytes)
;; ) string-data))
;; (println multipart-parser)
(println content-type)
(println boundary)
;; (println string-data)
(setq *last-data* parts)
(uiop:println (hunchentoot::parse-multipart-form-data *last* *utf-8-external-format*))
(setq *last-list-data* nil)
(loop :for i :in *last-data*
:do (let* ((content-disposition (nth 1
(serapeum:lines i :eol-style :cr :honor-crlf t)))
(serapeum:lines i :eol-style :crlf :honor-crlf t)))
(start (if content-disposition (position #\" content-disposition)))
(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 (rest (rest
(serapeum:lines i :eol-style :cr :honor-crlf t))))
(nth 3 (serapeum:lines i :eol-style :cr :honor-crlf t))))
(image-content-type (if (string= name "image") (nth 2 (serapeum:lines i :eol-style :cr :honor-crlf t))))
(file-start (if (string= name "image") (position #\" content-disposition :start 44)))
(file-end (if file-start (position #\" content-disposition :start (1+ file-start)) nil))
(image-file-name (if (string= name "image") (subseq content-disposition (1+ file-start) file-end) nil))
(image-stream (if (string= name "image") (open image-file-name
:direction :output
:if-does-not-exist :create
:if-exists :overwrite))))
(rest
(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))))
(file-start (if (string= name "image")
(position #\" content-disposition :start 44)))
(file-end (if file-start
(position #\" content-disposition :start (1+ file-start)) nil))
(image-file-name (if (string= name "image")
(subseq content-disposition
(1+ file-start) file-end) nil))
(form-list '()))
;; This gets rid of beginning and ending NIL values
;; (if name (if (string/= name "image") (format t "~&~A: ~A" name content)) nil)
(if name (if (string/= name "image") (progn
(format t "~&~A: ~A" name content)
(setq form-list (destructuring-bind (name) (list content) (list :name content))))) nil)
(if (string= name "image") (setq content (butlast content)))
;; (uiop:println image-content-type)
;; (uiop:println content)
;; (uiop:println (string= "" image-file-name))
(if (string/= "" image-file-name)
(if (string= name "image")
(with-open-file (image-stream (pathname (truename image-file-name))
:direction :output
:element-type '(unsigned-byte 8)
:if-exists :overwrite
:if-does-not-exist :create)
(write-sequence (flex:string-to-octets (write-to-string content)) image-stream))))
;; (if (string= name "image") (format t "~A" (pathname (truename image-file-name))))
(if (string= "image" name)
(progn (format t "~&~A: ~A" name image-file-name)
(setq form-list (list name image-file-name))
(save-string-file
(apply #'concatenate 'string content) image-file-name)))
;; (if (string= name "image") (setq file-path (serapeum:write-stream-into-file
;; *image-stream*
;; (pathname (truename image-file-name))
;; :if-exists :overwrite
;; :if-does-not-exist :create)))
;; (if (string= name "image") (format t "~&~A:~A" name content))
))
;; This actually worked, but the ending is wrong
;; (loop :for i :in *last-data*
;; :do (let* ((content (nth 1
;; (serapeum:lines i :eol-style :cr :honor-crlf t)))
;; (start (position #\" content))
;; (end (position #\" content :from-end t))
;; (name (if start (subseq content (1+ start) end) nil)))
;; (uiop:println name)))
;; (uiop:println "OTHER")
;; (uiop:println (hunchentoot::get-request-data stream))
;; (uiop:println (rfc2388:parse-mime data boundary))
;; (let* ((data (hunchentoot:raw-post-data :force-text t))
;; (json-obj (com.inuoe.jzon:parse data))
;; )
;; ;; (print (format nil "Json: ~A" (com.inuoe.jzon:stringify json-obj)))
;; (uiop:println "Received Health Form")
;; (render-json json-obj)
;; (setq last json-obj)
;; (process-form json-obj)
;; data)
)))))
(setq *last-list-data* (append *last-list-data* form-list)))))))))
(defun display-stream (stream)
(loop for line = (read-line stream nil)
while line do (format t "~A~%" line)))
(defvar *last*)
(defvar *last-data*)
(defvar *stream*)
(defvar *token* "boFFRM68vvXbO-DO7S9YDg86lHX027-hd07mn0dh")
(defun print-hash-entry (key value)
(format t "~S: ~S~%" 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"
(let ((firstname (gethash "firstname" form))
(lastname (gethash "lastname" form))
(parentfirstname (gethash "parentfirstname" form))
(parentlastname (gethash "parentlastname" form))
(street (gethash "street" form))
(city (gethash "city" form))
(state (gethash "state" form))
(zip (gethash "zip" form))
(cellphone (gethash "cellphone" form))
(homephone (gethash "homephone" form))
(add-emergency-contact (gethash "add-emergency-contact" form))
(add-emergency-contact-phone (gethash "add-emergency-contact-phone" form))
(doctorname (gethash "doctorname" form))
(doctorcity (gethash "doctorcity" form))
(doctorphone (gethash "doctorphone" form))
(medical-coverage (gethash "medical-coverage" form))
(insurance-name (gethash "insurance-name" form))
(policy-number (gethash "policy-number" form))
(image (gethash "image" form))
(agreement (gethash "agreement" form))
(allergies (gethash "allergies" form))
(allergies-other (gethash "allergies-other" form))
(specific-allergies (gethash "specific-allergies" form))
(allergic-treatment (gethash "allergic-treatment" form))
(conditions (gethash "conditions" form))
(tetanus-shot (gethash "tetanus-shot" form))
(swimming-ability (gethash "swimming-ability" form))
(medication-schedule (gethash "medication-schedule" form))
(other-notes (gethash "other-notes" form))
(age (gethash "age" form)))
(uiop:println "---")
(maphash 'print-hash-entry form)
(uiop:println "---")))
(uiop:println "---"))
(defun render-json (object)
(uiop:println (format nil "Json: ~A" (com.inuoe.jzon:stringify object))))
(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))