From 056777b3634273b8e1fd9eb2ed14e9465f692011 Mon Sep 17 00:00:00 2001
From: Chris Cochrun <chris@cochrun.xyz>
Date: Tue, 12 Dec 2023 17:00:52 -0600
Subject: [PATCH] rename package and working html email from form online
---
src/main.lisp | 372 ++++++++++++++++++++++++++++++++++++++++++--------
1 file changed, 312 insertions(+), 60 deletions(-)
diff --git a/src/main.lisp b/src/main.lisp
index 60f8e24..fa11f68 100644
--- a/src/main.lisp
+++ b/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)