finally able to save the picture
This commit is contained in:
parent
0cad38bb05
commit
d857692815
2 changed files with 49 additions and 134 deletions
|
|
@ -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) => {
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue