TFC/tfcconnection-zola
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

rename package and working html email from form online

Browse source
This commit is contained in:
Chris Cochrun 2023-12-12 17:00:52 -06:00
parent 95fb417cff
commit 056777b363
1 changed files with 312 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

372
src/main.lisp
View file

@ -6,11 +6,12 @@
(require "com.inuoe.jzon") (require "com.inuoe.jzon")
(require "serapeum") (require "serapeum")
(require "bordeaux-threads") (require "bordeaux-threads")
(require "spinneret")
(defpackage tfc-server (defpackage tfcserver
(:use :cl :uiop :com.inuoe.jzon :clack)) (:use :cl :uiop :com.inuoe.jzon :clack :serapeum :spinneret))
(in-package :tfc-server) (in-package :tfcserver)
(defvar *last*) (defvar *last*)
(defvar *last-data*) (defvar *last-data*)
@ -26,29 +27,51 @@
(make-instance 'hunchentoot:easy-acceptor (make-instance 'hunchentoot:easy-acceptor
:port port)))) :port port))))
(defun setup-for-nextcloud-tables (data-list) ;; (defun setup-for-nextcloud-tables (data-list)
"moving the list into a form that makes sense for ;; "moving the list into a form that makes sense for
Nextcloud tables" ;; Nextcloud tables"
(setf (car (assoc "Student Name" data-list :test 'string=) ;; (setf idk (car (assoc "Student Name" data-list :test 'string=)
"value"))) ;; "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) (defun post-health-form (data-list)
"Takes the health form as an alist and posts it to nocodb" "Takes the health form as an alist and posts it to nocodb"
(let* ((student-name (concatenate 'string (let* ((student-name
(serapeum:trim-whitespace (cdr (assoc "firstname" data-list (concatenate 'string
:test 'string=))) (serapeum:trim-whitespace
" " (cdr (assoc "firstname" data-list
(serapeum:trim-whitespace (cdr (assoc "lastname" data-list :test 'string=)))
:test 'string=))))) " "
(parent-name (concatenate 'string (serapeum:trim-whitespace
(serapeum:trim-whitespace (cdr (assoc "parentfirstname" data-list (cdr (assoc "lastname" data-list
:test 'string=))) :test 'string=)))))
" " (parent-name
(serapeum:trim-whitespace (cdr (assoc "parentlastname" data-list (concatenate 'string
:test '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)) (image (assoc "image" data-list))
(headers (list (cons "Authorization" *auth-token*) (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 (setq data-list (remove
(assoc "lastname" *last-list-data* :test 'string=) (assoc "lastname" *last-list-data* :test 'string=)
@ -92,46 +115,148 @@ Nextcloud tables"
:do (format t "~&~A" entry)) :do (format t "~&~A" entry))
(format t "~&~A" "Let's print out the data") (format t "~&~A" "Let's print out the data")
(format t "~&~A" data-list) (format t "~&~A" data-list)
(setq *last-list-data* data-list)
(println *last-list-data*) (println *last-list-data*)
(setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace (cdr (assoc "Student Name" *last-list-data* :test 'string=)))) (setf data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace
("columnId" 38 "value" ,(serapeum:trim-whitespace (cdr (assoc "Parent Name" *last-list-data* :test 'string=)))) (cdr (assoc
("columnId" 39 "value" ,(serapeum:trim-whitespace (cdr (assoc "birthdate" *last-list-data* :test 'string=)))) "Student Name"
("columnId" 40 "value" ,(serapeum:trim-whitespace (cdr (assoc "street" *last-list-data* :test 'string=)))) *last-list-data*
("columnId" 41 "value" ,(serapeum:trim-whitespace (cdr (assoc "city" *last-list-data* :test 'string=)))) :test 'string=))))
("columnId" 42 "value" ,(serapeum:trim-whitespace (cdr (assoc "state" *last-list-data* :test 'string=)))) ("columnId" 38 "value" ,(serapeum:trim-whitespace
("columnId" 43 "value" ,(serapeum:trim-whitespace (cdr (assoc "zip" *last-list-data* :test 'string=)))) (cdr (assoc
("columnId" 44 "value" ,(serapeum:trim-whitespace (cdr (assoc "cellphone" *last-list-data* :test 'string=)))) "Parent Name"
("columnId" 45 "value" ,(serapeum:trim-whitespace (cdr (assoc "homephone" *last-list-data* :test 'string=)))) *last-list-data*
("columnId" 46 "value" ,(serapeum:trim-whitespace (cdr (assoc "emergency-contact" *last-list-data* :test 'string=)))) :test 'string=))))
("columnId" 47 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor" *last-list-data* :test 'string=)))) ("columnId" 39 "value" ,(serapeum:trim-whitespace
("columnId" 48 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-city" *last-list-data* :test 'string=)))) (cdr (assoc
("columnId" 49 "value" ,(serapeum:trim-whitespace (cdr (assoc "doctor-phone" *last-list-data* :test 'string=)))) "birthdate"
("columnId" 50 "value" ,(serapeum:trim-whitespace (cdr (assoc "medical-coverage" *last-list-data* :test 'string=)))) *last-list-data*
("columnId" 51 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-name" *last-list-data* :test 'string=)))) :test 'string=))))
("columnId" 52 "value" ,(serapeum:trim-whitespace (cdr (assoc "policy-number" *last-list-data* :test 'string=)))) ("columnId" 40 "value" ,(serapeum:trim-whitespace
("columnId" 53 "value" ,(serapeum:trim-whitespace (cdr (assoc "insurance-card" *last-list-data* :test 'string=)))) (cdr (assoc
("columnId" 54 "value" ,(serapeum:trim-whitespace (cdr (assoc "agreement" *last-list-data* :test 'string=)))) "street"
("columnId" 55 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergies" *last-list-data* :test 'string=)))) *last-list-data*
("columnId" 56 "value" ,(serapeum:trim-whitespace (cdr (assoc "specific-allergies" *last-list-data* :test 'string=)))) :test 'string=))))
("columnId" 57 "value" ,(serapeum:trim-whitespace (cdr (assoc "allergy-treatment" *last-list-data* :test 'string=)))) ("columnId" 41 "value" ,(serapeum:trim-whitespace
("columnId" 58 "value" ,(serapeum:trim-whitespace (cdr (assoc "conditions" *last-list-data* :test 'string=)))) (cdr (assoc
("columnId" 59 "value" ,(serapeum:trim-whitespace (cdr (assoc "tetanus-shot-date" *last-list-data* :test 'string=)))) "city"
("columnId" 60 "value" ,(serapeum:trim-whitespace (cdr (assoc "medication-schedule" *last-list-data* :test 'string=)))) *last-list-data*
("columnId" 61 "value" ,(serapeum:trim-whitespace (cdr (assoc "other-notes" *last-list-data* :test 'string=)))) :test 'string=))))
("columnId" 62 "value" ,(serapeum:trim-whitespace (cdr (assoc "swimming-ability" *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* (setq special-data `#(("columnId" 37 "value" ,(serapeum:trim-whitespace
;; do (let ((key (car i)) (cdr (assoc
;; (value (serapeum:trim-whitespace (cdr i)))) "Student Name"
;; (format t "~&~a: ~a" key value) *last-list-data*
;; (cond ((string= key "Student Name") (terpri) (println "woo"))))) :test 'string=))))))
(dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows" (dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows"
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b") :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) :verbose t)
)) ))
@ -159,6 +284,130 @@ Nextcloud tables"
:if-does-not-exist :create :if-does-not-exist :create
:external-format :latin-1)) :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") () (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*)))
@ -174,7 +423,8 @@ Nextcloud tables"
(when position (when position
(subseq content-type (1+ position))))) (subseq content-type (1+ position)))))
(string-data (flexi-streams:octets-to-string data)) (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-data* parts)
(setq *last-list-data* nil) (setq *last-list-data* nil)
@ -249,12 +499,14 @@ Nextcloud tables"
(acons name image-file-name form-list)) (acons name image-file-name form-list))
(save-string-file (save-string-file
(apply #'concatenate 'string content) (apply #'concatenate 'string content)
image-file-name))) image-file-name)
(setf attachment image-file-name)))
(setq *last-list-data* (setq *last-list-data*
(append *last-list-data* form-list)))) (append *last-list-data* form-list))))
(post-health-form *last-list-data*) ;; (post-health-form *last-list-data*)
(format nil "thankyou")))))) (if (mail-form *last-list-data* attachment)
(format nil "thankyou")))))))
(defun main () (defun main ()
(start-server 4242) (start-server 4242)