api of mt-form almost ready
This commit is contained in:
parent
d0ebf6baab
commit
89deac098f
291
src/main.lisp
291
src/main.lisp
|
|
@ -277,104 +277,137 @@
|
||||||
:if-does-not-exist :create
|
:if-does-not-exist :create
|
||||||
:external-format :latin-1))
|
:external-format :latin-1))
|
||||||
|
|
||||||
|
(defun mail-mt-form (form attachment)
|
||||||
|
"Takes the form as an alist and sends a table formatted email
|
||||||
|
with the image attached to us"
|
||||||
|
(uiop:println form)
|
||||||
|
(let ((first-name (cdr (assoc "firstname" form :test 'string=)))
|
||||||
|
(last-name (cdr (assoc "lastname" form :test 'string=))))
|
||||||
|
(cl-smtp:send-email
|
||||||
|
"mail.tfcconnection.org"
|
||||||
|
"no-reply@mail.tfcconnection.org"
|
||||||
|
'("chris@tfcconnection.org" "chris@cochrun.xyz")
|
||||||
|
(format nil "~a ~a filled out a Mission Trip Form!" first-name last-name)
|
||||||
|
(format nil "Mission Trip Form for ~a ~a" first-name last-name)
|
||||||
|
:display-name "TFC ADMIN"
|
||||||
|
:ssl :tls
|
||||||
|
:authentication '(:login "no-reply@mail.tfcconnection.org" "r9f36mNZFtiW4f")
|
||||||
|
:attachments attachment
|
||||||
|
:html-message
|
||||||
|
(with-html-string
|
||||||
|
(:doctype)
|
||||||
|
(:html
|
||||||
|
(:head (:title "TFC Mission Trip Form")
|
||||||
|
(:style (apply #'lass:compile-and-write *mail-css*)))
|
||||||
|
(:body
|
||||||
|
(:h1 (format nil "Mission Trip Form for ~a ~a" first-name last-name))
|
||||||
|
(:hr)
|
||||||
|
(:table
|
||||||
|
(loop for row in form
|
||||||
|
do (:tr
|
||||||
|
(:th (car row))
|
||||||
|
(:td (trim-whitespace
|
||||||
|
(cdr row)))))))))))
|
||||||
|
(uiop:println "Mail sent!"))
|
||||||
|
|
||||||
(defun mail-form (form attachment)
|
(defun mail-form (form attachment)
|
||||||
"Takes the form as an alist and sends a table formatted email
|
"Takes the form as an alist and sends a table formatted email
|
||||||
with the image attached"
|
with the image attached"
|
||||||
(let ((first-name (serapeum:trim-whitespace
|
(let ((first-name (serapeum:trim-whitespace
|
||||||
(cdr (assoc "firstname" form
|
(cdr (assoc "firstname" form
|
||||||
:test 'string=))))
|
|
||||||
(last-name (serapeum:trim-whitespace
|
|
||||||
(cdr (assoc "lastname" form
|
|
||||||
:test 'string=))))
|
:test 'string=))))
|
||||||
(parent-name (concatenate 'string
|
(last-name (serapeum:trim-whitespace
|
||||||
(serapeum:trim-whitespace
|
(cdr (assoc "lastname" form
|
||||||
(cdr (assoc "parentfirstname" form
|
|
||||||
:test 'string=)))
|
|
||||||
" "
|
|
||||||
(serapeum:trim-whitespace
|
|
||||||
(cdr (assoc "parentlastname" form
|
|
||||||
:test 'string=)))))
|
|
||||||
(birthdate (trim-whitespace
|
|
||||||
(cdr (assoc "birthdate" form
|
|
||||||
:test 'string=))))
|
|
||||||
(city (trim-whitespace
|
|
||||||
(cdr (assoc "city" form
|
|
||||||
:test 'string=))))
|
|
||||||
(street (trim-whitespace
|
|
||||||
(cdr (assoc "street" form
|
|
||||||
:test 'string=))))
|
|
||||||
(state (trim-whitespace
|
|
||||||
(cdr (assoc "state" form
|
|
||||||
:test 'string=))))
|
|
||||||
(zip (trim-whitespace
|
|
||||||
(cdr (assoc "zip" form
|
|
||||||
:test 'string=))))
|
|
||||||
(cellphone (trim-whitespace
|
|
||||||
(cdr (assoc "cellphone" form
|
|
||||||
:test 'string=))))
|
|
||||||
(homephone (trim-whitespace
|
|
||||||
(cdr (assoc "homephone" form
|
|
||||||
:test 'string=))))
|
|
||||||
(emergency-contact (trim-whitespace
|
|
||||||
(cdr (assoc "emergency-contact" form
|
|
||||||
:test 'string=))))
|
|
||||||
(additional-contact (trim-whitespace
|
|
||||||
(cdr (assoc "add-emergency-contact-phone" form
|
|
||||||
:test 'string=))))
|
|
||||||
(doctor (trim-whitespace
|
|
||||||
(cdr (assoc "doctor" form
|
|
||||||
:test 'string=))))
|
|
||||||
(doctor-city (trim-whitespace
|
|
||||||
(cdr (assoc "doctor-city" form
|
|
||||||
:test 'string=))))
|
|
||||||
(doctor-phone (trim-whitespace
|
|
||||||
(cdr (assoc "doctor-phone" form
|
|
||||||
:test 'string=))))
|
|
||||||
(medical-coverage (trim-whitespace
|
|
||||||
(cdr (assoc "medical-coverage" form
|
|
||||||
:test 'string=))))
|
|
||||||
(insurance (trim-whitespace
|
|
||||||
(cdr (assoc "insurance-name" form
|
|
||||||
:test 'string=))))
|
|
||||||
(policy-number (trim-whitespace
|
|
||||||
(cdr (assoc "policy-number" form
|
|
||||||
:test 'string=))))
|
|
||||||
(image (trim-whitespace
|
|
||||||
(cdr (assoc "image" form
|
|
||||||
:test 'string=))))
|
|
||||||
(agreement (trim-whitespace
|
|
||||||
(cdr (assoc "agreement" form
|
|
||||||
:test 'string=))))
|
|
||||||
(allergies (trim-whitespace
|
|
||||||
(cdr (assoc "allergies" form
|
|
||||||
:test 'string=))))
|
|
||||||
(allergies-other (trim-whitespace
|
|
||||||
(cdr (assoc "allergies-other" form
|
|
||||||
:test 'string=))))
|
|
||||||
(specific-allergies (trim-whitespace
|
|
||||||
(cdr (assoc "specific-allergies" form
|
|
||||||
:test 'string=))))
|
|
||||||
(allergy-treatments (trim-whitespace
|
|
||||||
(cdr (assoc "allergy-treatments" form
|
|
||||||
:test 'string=))))
|
|
||||||
(conditions (trim-whitespace
|
|
||||||
(cdr (assoc "conditions" form
|
|
||||||
:test 'string=))))
|
|
||||||
(tetanus (trim-whitespace
|
|
||||||
(cdr (assoc "tetanus-shot-date" form
|
|
||||||
:test 'string=))))
|
|
||||||
(swimming (trim-whitespace
|
|
||||||
(cdr (assoc "swimming-ability" form
|
|
||||||
:test 'string=))))
|
:test 'string=))))
|
||||||
(medication (trim-whitespace
|
(parent-name (concatenate 'string
|
||||||
(cdr (assoc "medication-schedule" form
|
(serapeum:trim-whitespace
|
||||||
:test 'string=))))
|
(cdr (assoc "parentfirstname" form
|
||||||
(other (trim-whitespace
|
:test 'string=)))
|
||||||
(cdr (assoc "other-notes" form
|
" "
|
||||||
|
(serapeum:trim-whitespace
|
||||||
|
(cdr (assoc "parentlastname" form
|
||||||
|
:test 'string=)))))
|
||||||
|
(birthdate (trim-whitespace
|
||||||
|
(cdr (assoc "birthdate" form
|
||||||
|
:test 'string=))))
|
||||||
|
(city (trim-whitespace
|
||||||
|
(cdr (assoc "city" form
|
||||||
|
:test 'string=))))
|
||||||
|
(street (trim-whitespace
|
||||||
|
(cdr (assoc "street" form
|
||||||
:test 'string=))))
|
:test 'string=))))
|
||||||
(age (trim-whitespace
|
(state (trim-whitespace
|
||||||
(cdr (assoc "age" form
|
(cdr (assoc "state" form
|
||||||
:test 'string=)))))
|
:test 'string=))))
|
||||||
|
(zip (trim-whitespace
|
||||||
|
(cdr (assoc "zip" form
|
||||||
|
:test 'string=))))
|
||||||
|
(cellphone (trim-whitespace
|
||||||
|
(cdr (assoc "cellphone" form
|
||||||
|
:test 'string=))))
|
||||||
|
(homephone (trim-whitespace
|
||||||
|
(cdr (assoc "homephone" form
|
||||||
|
:test 'string=))))
|
||||||
|
(emergency-contact (trim-whitespace
|
||||||
|
(cdr (assoc "emergency-contact" form
|
||||||
|
:test 'string=))))
|
||||||
|
(additional-contact (trim-whitespace
|
||||||
|
(cdr (assoc "add-emergency-contact-phone" form
|
||||||
|
:test 'string=))))
|
||||||
|
(doctor (trim-whitespace
|
||||||
|
(cdr (assoc "doctor" form
|
||||||
|
:test 'string=))))
|
||||||
|
(doctor-city (trim-whitespace
|
||||||
|
(cdr (assoc "doctor-city" form
|
||||||
|
:test 'string=))))
|
||||||
|
(doctor-phone (trim-whitespace
|
||||||
|
(cdr (assoc "doctor-phone" form
|
||||||
|
:test 'string=))))
|
||||||
|
(medical-coverage (trim-whitespace
|
||||||
|
(cdr (assoc "medical-coverage" form
|
||||||
|
:test 'string=))))
|
||||||
|
(insurance (trim-whitespace
|
||||||
|
(cdr (assoc "insurance-name" form
|
||||||
|
:test 'string=))))
|
||||||
|
(policy-number (trim-whitespace
|
||||||
|
(cdr (assoc "policy-number" form
|
||||||
|
:test 'string=))))
|
||||||
|
(image (trim-whitespace
|
||||||
|
(cdr (assoc "image" form
|
||||||
|
:test 'string=))))
|
||||||
|
(agreement (trim-whitespace
|
||||||
|
(cdr (assoc "agreement" form
|
||||||
|
:test 'string=))))
|
||||||
|
(allergies (trim-whitespace
|
||||||
|
(cdr (assoc "allergies" form
|
||||||
|
:test 'string=))))
|
||||||
|
(allergies-other (trim-whitespace
|
||||||
|
(cdr (assoc "allergies-other" form
|
||||||
|
:test 'string=))))
|
||||||
|
(specific-allergies (trim-whitespace
|
||||||
|
(cdr (assoc "specific-allergies" form
|
||||||
|
:test 'string=))))
|
||||||
|
(allergy-treatments (trim-whitespace
|
||||||
|
(cdr (assoc "allergy-treatments" form
|
||||||
|
:test 'string=))))
|
||||||
|
(conditions (trim-whitespace
|
||||||
|
(cdr (assoc "conditions" form
|
||||||
|
:test 'string=))))
|
||||||
|
(tetanus (trim-whitespace
|
||||||
|
(cdr (assoc "tetanus-shot-date" form
|
||||||
|
:test 'string=))))
|
||||||
|
(swimming (trim-whitespace
|
||||||
|
(cdr (assoc "swimming-ability" form
|
||||||
|
:test 'string=))))
|
||||||
|
(medication (trim-whitespace
|
||||||
|
(cdr (assoc "medication-schedule" form
|
||||||
|
:test 'string=))))
|
||||||
|
(other (trim-whitespace
|
||||||
|
(cdr (assoc "other-notes" form
|
||||||
|
:test 'string=))))
|
||||||
|
(age (trim-whitespace
|
||||||
|
(cdr (assoc "age" form
|
||||||
|
:test 'string=)))))
|
||||||
(not (cl-smtp:send-email
|
(not (cl-smtp:send-email
|
||||||
"mail.tfcconnection.org"
|
"mail.tfcconnection.org"
|
||||||
"no-reply@mail.tfcconnection.org"
|
"no-reply@mail.tfcconnection.org"
|
||||||
|
|
@ -401,6 +434,82 @@ with the image attached"
|
||||||
(:td (trim-whitespace
|
(:td (trim-whitespace
|
||||||
(cdr row)))))))))))))
|
(cdr row)))))))))))))
|
||||||
|
|
||||||
|
(hunchentoot:define-easy-handler (respond :uri "/mt-form") ()
|
||||||
|
(setf (hunchentoot:content-type*) "plain/text")
|
||||||
|
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
|
||||||
|
(req hunchentoot:*request*)
|
||||||
|
(content-type (hunchentoot:header-in "content-type" req))
|
||||||
|
(boundary (let ((position (position #\= content-type)))
|
||||||
|
(when position
|
||||||
|
(subseq content-type (1+ position)))))
|
||||||
|
(string-data (flexi-streams:octets-to-string (hunchentoot:raw-post-data :request req)))
|
||||||
|
(parts (ppcre:split boundary string-data))
|
||||||
|
(form-list nil)
|
||||||
|
(attachment nil))
|
||||||
|
(cond ((eq request-type :get) nil)
|
||||||
|
((eq request-type :post)
|
||||||
|
(loop :for i :in parts
|
||||||
|
:do (let* ((content-disposition
|
||||||
|
(nth 1
|
||||||
|
(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")
|
||||||
|
(butlast
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(serapeum:lines i
|
||||||
|
:eol-style
|
||||||
|
:crlf
|
||||||
|
:honor-crlf t
|
||||||
|
:keep-eols t))))))
|
||||||
|
(trim-whitespace
|
||||||
|
(car
|
||||||
|
(butlast
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(rest
|
||||||
|
(serapeum:lines i :eol-style :crlf
|
||||||
|
:honor-crlf t
|
||||||
|
:keep-eols 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)))
|
||||||
|
(if name
|
||||||
|
(if (string= name "image")
|
||||||
|
(if (uiop:file-exists-p image-file-name)
|
||||||
|
(progn
|
||||||
|
(save-string-file
|
||||||
|
(apply #'concatenate 'string content)
|
||||||
|
image-file-name)
|
||||||
|
(setq form-list (acons name image-file-name form-list))
|
||||||
|
(setf attachment image-file-name)))
|
||||||
|
(setq form-list (acons name content form-list))))))
|
||||||
|
(if (mail-mt-form form-list attachment)
|
||||||
|
(format nil "thankyou"))))))
|
||||||
|
|
||||||
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
|
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
|
||||||
(setf (hunchentoot:content-type*) "plain/text")
|
(setf (hunchentoot:content-type*) "plain/text")
|
||||||
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
|
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue