rename package and working html email from form online
This commit is contained in:
parent
95fb417cff
commit
056777b363
1 changed files with 312 additions and 60 deletions
372
src/main.lisp
372
src/main.lisp
|
|
@ -6,11 +6,12 @@
|
|||
(require "com.inuoe.jzon")
|
||||
(require "serapeum")
|
||||
(require "bordeaux-threads")
|
||||
(require "spinneret")
|
||||
|
||||
(defpackage tfc-server
|
||||
(:use :cl :uiop :com.inuoe.jzon :clack))
|
||||
(defpackage tfcserver
|
||||
(:use :cl :uiop :com.inuoe.jzon :clack :serapeum :spinneret))
|
||||
|
||||
(in-package :tfc-server)
|
||||
(in-package :tfcserver)
|
||||
|
||||
(defvar *last*)
|
||||
(defvar *last-data*)
|
||||
|
|
@ -26,29 +27,51 @@
|
|||
(make-instance 'hunchentoot:easy-acceptor
|
||||
:port port))))
|
||||
|
||||
(defun setup-for-nextcloud-tables (data-list)
|
||||
"moving the list into a form that makes sense for
|
||||
Nextcloud tables"
|
||||
(setf (car (assoc "Student Name" data-list :test 'string=)
|
||||
"value")))
|
||||
;; (defun setup-for-nextcloud-tables (data-list)
|
||||
;; "moving the list into a form that makes sense for
|
||||
;; Nextcloud tables"
|
||||
;; (setf idk (car (assoc "Student Name" data-list :test 'string=)
|
||||
;; "value")))
|
||||
|
||||
(defparameter *mail-css*
|
||||
'((table :border-collapse "collapse" :width "100%")
|
||||
(("th," td) :padding "8px")
|
||||
(td :text-align "left" :width "70%")
|
||||
(th :text-align "right" :border-right "1px solid #ddd")
|
||||
(tr :border-bottom "1px solid #ddd")
|
||||
(h1 :text-align "center")))
|
||||
|
||||
(defun post-health-form (data-list)
|
||||
"Takes the health form as an alist and posts it to nocodb"
|
||||
(let* ((student-name (concatenate 'string
|
||||
(serapeum:trim-whitespace (cdr (assoc "firstname" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace (cdr (assoc "lastname" data-list
|
||||
:test 'string=)))))
|
||||
(parent-name (concatenate 'string
|
||||
(serapeum:trim-whitespace (cdr (assoc "parentfirstname" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace (cdr (assoc "parentlastname" data-list
|
||||
:test 'string=)))))
|
||||
(let* ((student-name
|
||||
(concatenate 'string
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "firstname" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "lastname" data-list
|
||||
:test 'string=)))))
|
||||
(parent-name
|
||||
(concatenate 'string
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "parentfirstname" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "parentlastname" data-list
|
||||
:test 'string=)))))
|
||||
(image (assoc "image" data-list))
|
||||
(headers (list (cons "Authorization" *auth-token*)
|
||||
(cons "Content-Type" "application/json"))))
|
||||
(cons "Content-Type" "application/json")))
|
||||
(rows (parse (dex:get
|
||||
"https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows"
|
||||
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
|
||||
:verbose t)))
|
||||
(lowid 0)
|
||||
(highest-id (loop for i in
|
||||
(loop for row across rows collect (gethash "id" row))
|
||||
maximizing i)))
|
||||
|
||||
(setq data-list (remove
|
||||
(assoc "lastname" *last-list-data* :test 'string=)
|
||||
|
|
@ -92,46 +115,148 @@ Nextcloud tables"
|
|||
:do (format t "~&~A" entry))
|
||||
(format t "~&~A" "Let's print out the data")
|
||||
(format t "~&~A" data-list)
|
||||
(setq *last-list-data* data-list)
|
||||
(println *last-list-data*)
|
||||
|
||||
(setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace (cdr (assoc "Student Name" *last-list-data* :test 'string=))))
|
||||
("columnId" 38 "value" ,(serapeum:trim-whitespace (cdr (assoc "Parent Name" *last-list-data* :test 'string=))))
|
||||
("columnId" 39 "value" ,(serapeum:trim-whitespace (cdr (assoc "birthdate" *last-list-data* :test 'string=))))
|
||||
("columnId" 40 "value" ,(serapeum:trim-whitespace (cdr (assoc "street" *last-list-data* :test 'string=))))
|
||||
("columnId" 41 "value" ,(serapeum:trim-whitespace (cdr (assoc "city" *last-list-data* :test 'string=))))
|
||||
("columnId" 42 "value" ,(serapeum:trim-whitespace (cdr (assoc "state" *last-list-data* :test 'string=))))
|
||||
("columnId" 43 "value" ,(serapeum:trim-whitespace (cdr (assoc "zip" *last-list-data* :test 'string=))))
|
||||
("columnId" 44 "value" ,(serapeum:trim-whitespace (cdr (assoc "cellphone" *last-list-data* :test 'string=))))
|
||||
("columnId" 45 "value" ,(serapeum:trim-whitespace (cdr (assoc "homephone" *last-list-data* :test 'string=))))
|
||||
("columnId" 46 "value" ,(serapeum:trim-whitespace (cdr (assoc "emergency-contact" *last-list-data* :test 'string=))))
|
||||
("columnId" 47 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor" *last-list-data* :test 'string=))))
|
||||
("columnId" 48 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-city" *last-list-data* :test 'string=))))
|
||||
("columnId" 49 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-phone" *last-list-data* :test 'string=))))
|
||||
("columnId" 50 "value" ,(serapeum:trim-whitespace (cdr (assoc "medical-coverage" *last-list-data* :test 'string=))))
|
||||
("columnId" 51 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-name" *last-list-data* :test 'string=))))
|
||||
("columnId" 52 "value" ,(serapeum:trim-whitespace (cdr (assoc "policy-number" *last-list-data* :test 'string=))))
|
||||
("columnId" 53 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-card" *last-list-data* :test 'string=))))
|
||||
("columnId" 54 "value" ,(serapeum:trim-whitespace (cdr (assoc "agreement" *last-list-data* :test 'string=))))
|
||||
("columnId" 55 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergies" *last-list-data* :test 'string=))))
|
||||
("columnId" 56 "value" ,(serapeum:trim-whitespace (cdr (assoc "specific-allergies" *last-list-data* :test 'string=))))
|
||||
("columnId" 57 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergy-treatment" *last-list-data* :test 'string=))))
|
||||
("columnId" 58 "value" ,(serapeum:trim-whitespace (cdr (assoc "conditions" *last-list-data* :test 'string=))))
|
||||
("columnId" 59 "value" ,(serapeum:trim-whitespace (cdr (assoc "tetanus-shot-date" *last-list-data* :test 'string=))))
|
||||
("columnId" 60 "value" ,(serapeum:trim-whitespace (cdr (assoc "medication-schedule" *last-list-data* :test 'string=))))
|
||||
("columnId" 61 "value" ,(serapeum:trim-whitespace (cdr (assoc "other-notes" *last-list-data* :test 'string=))))
|
||||
("columnId" 62 "value" ,(serapeum:trim-whitespace (cdr (assoc "swimming-ability" *last-list-data* :test 'string=))))
|
||||
))
|
||||
(setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"Student Name"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 38 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"Parent Name"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 39 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"birthdate"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 40 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"street"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 41 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"city"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 42 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"state"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 43 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"zip"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 44 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"cellphone"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 45 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"homephone"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 46 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"emergency-contact"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 47 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"doctor"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 48 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"doctor-city"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 49 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"doctor-phone"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 50 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"medical-coverage"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 51 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"insurance-name"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 52 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"policy-number"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 53 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"insurance-card"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 54 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"agreement"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 55 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"allergies"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 56 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"specific-allergies"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 57 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"allergy-treatment"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 58 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"conditions"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 59 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"tetanus-shot-date"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 60 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"medication-schedule"
|
||||
*last-list-data* :test 'string=))))
|
||||
("columnId" 61 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"other-notes"
|
||||
*last-list-data*
|
||||
:test 'string=))))
|
||||
("columnId" 62 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"swimming-ability"
|
||||
*last-list-data*
|
||||
:test 'string=))))))
|
||||
|
||||
;; (loop for i in *last-list-data*
|
||||
;; do (let ((key (car i))
|
||||
;; (value (serapeum:trim-whitespace (cdr i))))
|
||||
;; (format t "~&~a: ~a" key value)
|
||||
;; (cond ((string= key "Student Name") (terpri) (println "woo")))))
|
||||
(setq special-data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace
|
||||
(cdr (assoc
|
||||
"Student Name"
|
||||
*last-list-data*
|
||||
:test 'string=))))))
|
||||
|
||||
(dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows"
|
||||
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
|
||||
:content (stringify `(("tableid" . 4) ("data" . ,data)))
|
||||
:content (stringify `(("tableId" . 4)
|
||||
("data" . ,special-data)))
|
||||
:verbose t)
|
||||
))
|
||||
|
||||
|
|
@ -159,6 +284,130 @@ Nextcloud tables"
|
|||
:if-does-not-exist :create
|
||||
:external-format :latin-1))
|
||||
|
||||
(defun mail-form (form attachment)
|
||||
"Takes the form as an alist and sends a table formatted email
|
||||
with the image attached"
|
||||
(let ((first-name (serapeum:trim-whitespace
|
||||
(cdr (assoc "firstname" form
|
||||
:test 'string=))))
|
||||
(last-name (serapeum:trim-whitespace
|
||||
(cdr (assoc "lastname" form
|
||||
:test 'string=))))
|
||||
(parent-name (concatenate 'string
|
||||
(serapeum:trim-whitespace
|
||||
(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=))))
|
||||
(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
|
||||
"mail.tfcconnection.org"
|
||||
"no-reply@mail.tfcconnection.org"
|
||||
'("chris@tfcconnection.org" "ethan@tfcconnection.org")
|
||||
(format nil "~a ~a filled out a Health Form!" first-name last-name)
|
||||
(format nil "Health 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 Health Form")
|
||||
(:style (apply #'lass:compile-and-write *mail-css*)))
|
||||
(:body
|
||||
(:h1 (format nil "Health 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)))))))))))))
|
||||
|
||||
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
|
||||
(setf (hunchentoot:content-type*) "plain/text")
|
||||
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
|
||||
|
|
@ -174,7 +423,8 @@ Nextcloud tables"
|
|||
(when position
|
||||
(subseq content-type (1+ position)))))
|
||||
(string-data (flexi-streams:octets-to-string data))
|
||||
(parts (ppcre:split boundary string-data)))
|
||||
(parts (ppcre:split boundary string-data))
|
||||
(attachment nil))
|
||||
|
||||
(setq *last-data* parts)
|
||||
(setq *last-list-data* nil)
|
||||
|
|
@ -249,12 +499,14 @@ Nextcloud tables"
|
|||
(acons name image-file-name form-list))
|
||||
(save-string-file
|
||||
(apply #'concatenate 'string content)
|
||||
image-file-name)))
|
||||
|
||||
image-file-name)
|
||||
(setf attachment image-file-name)))
|
||||
|
||||
(setq *last-list-data*
|
||||
(append *last-list-data* form-list))))
|
||||
(post-health-form *last-list-data*)
|
||||
(format nil "thankyou"))))))
|
||||
;; (post-health-form *last-list-data*)
|
||||
(if (mail-form *last-list-data* attachment)
|
||||
(format nil "thankyou")))))))
|
||||
|
||||
(defun main ()
|
||||
(start-server 4242)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue