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

health-forms are working again

Browse source
This commit is contained in:
Chris Cochrun 2024-10-16 15:19:03 -05:00
parent 420d5f77e1
commit 67740cf2c6
1 changed files with 72 additions and 244 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

316
src/main.lisp
View file

@ -19,6 +19,8 @@
(log:config :daily "/tmp/tfc-%Y%m%d.log") (log:config :daily "/tmp/tfc-%Y%m%d.log")
(defvar *app* (make-instance 'ningle:app)) (defvar *app* (make-instance 'ningle:app))
(defconstant *nc-password* (uiop:getenv "NC-PASSWORD"))
(defconstant *email-password* (uiop:getenv "EMAIL-PASSWORD"))
(defparameter *mail-css* (defparameter *mail-css*
'((table :border-collapse "collapse" :width "100%") '((table :border-collapse "collapse" :width "100%")
@ -29,277 +31,101 @@
(h1 :text-align "center"))) (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 nextcloud"
(let* ((student-name (let* ((student-name
(concatenate 'string (concatenate 'string
(serapeum:trim-whitespace (serapeum:trim-whitespace
(cdr (assoc "firstname" data-list (cdr (assoc "first-name" data-list
:test 'string=))) :test 'string=)))
" " " "
(serapeum:trim-whitespace (serapeum:trim-whitespace
(cdr (assoc "lastname" data-list (cdr (assoc "last-name" data-list
:test 'string=))))) :test 'string=)))))
(parent-name (parent-name
(concatenate 'string (concatenate 'string
(serapeum:trim-whitespace (serapeum:trim-whitespace
(cdr (assoc "parentfirstname" data-list (cdr (assoc "parent-first-name" data-list
:test 'string=))) :test 'string=)))
" " " "
(serapeum:trim-whitespace (serapeum:trim-whitespace
(cdr (assoc "parentlastname" data-list (cdr (assoc "parent-last-name" data-list
:test 'string=))))) :test 'string=)))))
(image (assoc "image" data-list)) (image (assoc "image" data-list))
(hash-data (make-hash-table))
(data nil)
(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 (setf data `((37 . ,student-name)
"https://staff.tfcconnection.org/apps/tables/api/1/tables/5/rows" (38 . ,parent-name)
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b") (39 . ,(get-form-value "birth-date" data-list))
:verbose t))) (40 . ,(get-form-value "street" data-list))
(lowid 0) (41 . ,(get-form-value "city" data-list))
(highest-id (loop for i in (42 . ,(get-form-value "state" data-list))
(loop for row across rows collect (gethash "id" row)) (43 . ,(get-form-value "zip" data-list))
maximizing i))) (44 . ,(get-form-value "cell-phone" data-list))
(45 . ,(get-form-value "home-phone" data-list))
(46 . ,(get-form-value "additional-emergency-contact" data-list))
(47 . ,(get-form-value "doctor-name" data-list))
(48 . ,(get-form-value "doctor-city" data-list))
(49 . ,(get-form-value "doctor-phone" data-list))
(50 . ,(get-form-value "medical-coverage" data-list))
(51 . ,(get-form-value "insurance-name" data-list))
(52 . ,(get-form-value "policy-number" data-list))
(54 . ,(get-form-value "agreement" data-list))
(55 . ,(get-form-value "allergies" data-list))
(56 . ,(get-form-value "specific-allergies" data-list))
(57 . ,(get-form-value "allergic-treatment" data-list))
(58 . ,(get-form-value "conditions" data-list))
(59 . ,(get-form-value "tetanus-shot" data-list))
(60 . ,(get-form-value "medication-schedule" data-list))
(61 . ,(get-form-value "other-notes" data-list))
(62 . ,(get-form-value "swimming-ability" data-list))))
(loop for i in data
do (setf (gethash (car i) hash-data) (cdr i)))
(log:info hash-data)
(dex:post "https://staff.tfcconnection.org/ocs/v2.php/apps/tables/api/2/tables/4/rows"
:basic-auth `("chris" . ,*nc-password*)
:headers '(("OCS-APIRequest" . "true"))
:content `(("data" . ,(stringify hash-data)))
:verbose t)))
(setq data-list (remove (defun get-form-value (key list)
(assoc "lastname" *last-list-data* :test 'string=) "Takes the key and alist of an online form and returns the value from it"
data-list)) (serapeum:trim-whitespace (cdr (assoc key list :test 'string=))))
(setq data-list (remove
(assoc "parentlastname" *last-list-data* :test 'string=)
data-list))
(setq data-list (remove
(assoc "image" *last-list-data* :test 'string=)
data-list))
(setf (cdr
(assoc "firstname" data-list :test 'string=))
student-name)
(setf (car
(assoc "firstname" data-list :test 'string=))
"Student Name")
(setf (cdr
(assoc "parentfirstname" data-list :test 'string=))
parent-name)
(setf (car
(assoc "parentfirstname" data-list :test 'string=))
"Parent Name")
(setf (car
(assoc "add-emergency-contact" data-list :test 'string=))
"emergency-contact")
(setf (car
(assoc "doctorname" data-list :test 'string=))
"doctor")
(setf (car
(assoc "doctorphone" data-list :test 'string=))
"doctor-phone")
(setf (car
(assoc "doctorcity" data-list :test 'string=))
"doctor-city")
(setf (car
(assoc "allergic-treatment" data-list :test 'string=))
"allergy-treatments")
(setf (car (assoc "tetanus-shot" data-list :test 'string=))
"tetanus-shot-date")
(loop :for entry :in data-list
:do (format t "~&~A" entry))
(format t "~&~A" "Let's print out the data")
(format t "~&~A" data-list)
(uiop: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=))))))
(dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/4/rows"
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
:content `(("data" . ,(stringify special-data)))
:verbose t)
))
(defun post-camp-data (data) (defun post-camp-data (data)
"Takes the camp data as an alist and sends it to nextcloud tables to be input" "Takes the camp data as an alist and sends it to nextcloud tables to be input"
(let ((new-data `((63 . ,(concat (let ((new-data `((63 . ,(concat
(cdr (get-form-value "first-name" data)
(assoc "first-name"
data :test 'string=))
" " " "
(cdr (get-form-value "last-name" data)))
(assoc "last-name"
data :test 'string=))))
(64 . ,(concat (64 . ,(concat
(cdr (get-form-value "parent-first-name" data)
(assoc "parent-first-name"
data :test 'string=))
" " " "
(cdr (get-form-value "parent-last-name" data)))
(assoc "parent-last-name" (65 . ,(get-form-value "parent-phone" data))
data :test 'string=)))) (66 . ,(get-form-value "parent-email" data))
(65 . ,(cdr (67 . ,(get-form-value "birth-date" data))
(assoc "parent-phone" (69 . ,(get-form-value "gender" data))
data :test 'string=))) (70 . ,(get-form-value "street" data))
(66 . ,(cdr (71 . ,(get-form-value "city" data))
(assoc "parent-email" (72 . ,(get-form-value "state" data))
data :test 'string=))) (73 . ,(get-form-value "zip" data))
(67 . ,(cdr (74 . ,(get-form-value "grade" data))
(assoc "birth-date" (75 . ,(get-form-value "week" data))
data :test 'string=))) (76 . ,(get-form-value "shirt" data))
(69 . ,(cdr (77 . ,(get-form-value "registration" data))))
(assoc "gender" (hash-data (make-hash-table)))
data :test 'string=))) (loop for i in new-data
(70 . ,(cdr do (setf (gethash (car i) hash-data) (cdr i)))
(assoc "street" (log:info hash-data)
data :test 'string=)))
(71 . ,(cdr
(assoc "city"
data :test 'string=)))
(72 . ,(cdr
(assoc "state"
data :test 'string=)))
(73 . ,(cdr
(assoc "zip"
data :test 'string=)))
(74 . ,(cdr
(assoc "grade"
data :test 'string=)))
(75 . ,(cdr
(assoc "week"
data :test 'string=)))
(76 . ,(cdr
(assoc "shirt"
data :test 'string=)))
(77 . ,(cdr
(assoc "registration"
data :test 'string=))))))
(log:info new-data)
(bt:make-thread (bt:make-thread
(lambda () (lambda ()
(dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/5/rows" (dex:post "https://staff.tfcconnection.org/ocs/v2.php/apps/tables/api/2/tables/5/rows"
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b") :basic-auth `("chris" . ,*nc-password*)
:content `(("data" . ,(stringify new-data))) :headers '(("OCS-APIRequest" . "true"))
:content `(("data" . ,(stringify hash-data)))
:verbose t))))) :verbose t)))))
(defun mail-mt-form (form attachment) (defun mail-mt-form (form attachment)
@ -443,6 +269,8 @@ with the image attached"
(log:info filename) (log:info filename)
(bt:make-thread (bt:make-thread
(lambda () (lambda ()
(post-health-form params)
(log:info "Sent to Nextcloud")
(mail-health-form params (pathname filename)) (mail-health-form params (pathname filename))
(log:info "Sent email")) (log:info "Sent email"))
:name "health-form") :name "health-form")