health-forms are working again
This commit is contained in:
parent
420d5f77e1
commit
67740cf2c6
316
src/main.lisp
316
src/main.lisp
|
|
@ -19,6 +19,8 @@
|
|||
(log:config :daily "/tmp/tfc-%Y%m%d.log")
|
||||
|
||||
(defvar *app* (make-instance 'ningle:app))
|
||||
(defconstant *nc-password* (uiop:getenv "NC-PASSWORD"))
|
||||
(defconstant *email-password* (uiop:getenv "EMAIL-PASSWORD"))
|
||||
|
||||
(defparameter *mail-css*
|
||||
'((table :border-collapse "collapse" :width "100%")
|
||||
|
|
@ -29,277 +31,101 @@
|
|||
(h1 :text-align "center")))
|
||||
|
||||
(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
|
||||
(concatenate 'string
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "firstname" data-list
|
||||
(cdr (assoc "first-name" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "lastname" data-list
|
||||
(cdr (assoc "last-name" data-list
|
||||
:test 'string=)))))
|
||||
(parent-name
|
||||
(concatenate 'string
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "parentfirstname" data-list
|
||||
(cdr (assoc "parent-first-name" data-list
|
||||
:test 'string=)))
|
||||
" "
|
||||
(serapeum:trim-whitespace
|
||||
(cdr (assoc "parentlastname" data-list
|
||||
(cdr (assoc "parent-last-name" data-list
|
||||
:test 'string=)))))
|
||||
(image (assoc "image" data-list))
|
||||
(hash-data (make-hash-table))
|
||||
(data nil)
|
||||
(headers (list (cons "Authorization" *auth-token*)
|
||||
(cons "Content-Type" "application/json")))
|
||||
(rows (parse (dex:get
|
||||
"https://staff.tfcconnection.org/apps/tables/api/1/tables/5/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)))
|
||||
(cons "Content-Type" "application/json"))))
|
||||
(setf data `((37 . ,student-name)
|
||||
(38 . ,parent-name)
|
||||
(39 . ,(get-form-value "birth-date" data-list))
|
||||
(40 . ,(get-form-value "street" data-list))
|
||||
(41 . ,(get-form-value "city" data-list))
|
||||
(42 . ,(get-form-value "state" data-list))
|
||||
(43 . ,(get-form-value "zip" data-list))
|
||||
(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
|
||||
(assoc "lastname" *last-list-data* :test 'string=)
|
||||
data-list))
|
||||
(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*)
|
||||
(defun get-form-value (key list)
|
||||
"Takes the key and alist of an online form and returns the value from it"
|
||||
(serapeum:trim-whitespace (cdr (assoc key list :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=))))))
|
||||
|
||||
(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)
|
||||
"Takes the camp data as an alist and sends it to nextcloud tables to be input"
|
||||
(let ((new-data `((63 . ,(concat
|
||||
(cdr
|
||||
(assoc "first-name"
|
||||
data :test 'string=))
|
||||
(get-form-value "first-name" data)
|
||||
" "
|
||||
(cdr
|
||||
(assoc "last-name"
|
||||
data :test 'string=))))
|
||||
(get-form-value "last-name" data)))
|
||||
(64 . ,(concat
|
||||
(cdr
|
||||
(assoc "parent-first-name"
|
||||
data :test 'string=))
|
||||
(get-form-value "parent-first-name" data)
|
||||
" "
|
||||
(cdr
|
||||
(assoc "parent-last-name"
|
||||
data :test 'string=))))
|
||||
(65 . ,(cdr
|
||||
(assoc "parent-phone"
|
||||
data :test 'string=)))
|
||||
(66 . ,(cdr
|
||||
(assoc "parent-email"
|
||||
data :test 'string=)))
|
||||
(67 . ,(cdr
|
||||
(assoc "birth-date"
|
||||
data :test 'string=)))
|
||||
(69 . ,(cdr
|
||||
(assoc "gender"
|
||||
data :test 'string=)))
|
||||
(70 . ,(cdr
|
||||
(assoc "street"
|
||||
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)
|
||||
(get-form-value "parent-last-name" data)))
|
||||
(65 . ,(get-form-value "parent-phone" data))
|
||||
(66 . ,(get-form-value "parent-email" data))
|
||||
(67 . ,(get-form-value "birth-date" data))
|
||||
(69 . ,(get-form-value "gender" data))
|
||||
(70 . ,(get-form-value "street" data))
|
||||
(71 . ,(get-form-value "city" data))
|
||||
(72 . ,(get-form-value "state" data))
|
||||
(73 . ,(get-form-value "zip" data))
|
||||
(74 . ,(get-form-value "grade" data))
|
||||
(75 . ,(get-form-value "week" data))
|
||||
(76 . ,(get-form-value "shirt" data))
|
||||
(77 . ,(get-form-value "registration" data))))
|
||||
(hash-data (make-hash-table)))
|
||||
(loop for i in new-data
|
||||
do (setf (gethash (car i) hash-data) (cdr i)))
|
||||
(log:info hash-data)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(dex:post "https://staff.tfcconnection.org/apps/tables/api/1/tables/5/rows"
|
||||
:basic-auth '("chris" . "2VHeGxeC^Zf9KqFK^G@Pt!zu2q^6@b")
|
||||
:content `(("data" . ,(stringify new-data)))
|
||||
(dex:post "https://staff.tfcconnection.org/ocs/v2.php/apps/tables/api/2/tables/5/rows"
|
||||
:basic-auth `("chris" . ,*nc-password*)
|
||||
:headers '(("OCS-APIRequest" . "true"))
|
||||
:content `(("data" . ,(stringify hash-data)))
|
||||
:verbose t)))))
|
||||
|
||||
(defun mail-mt-form (form attachment)
|
||||
|
|
@ -443,6 +269,8 @@ with the image attached"
|
|||
(log:info filename)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(post-health-form params)
|
||||
(log:info "Sent to Nextcloud")
|
||||
(mail-health-form params (pathname filename))
|
||||
(log:info "Sent email"))
|
||||
:name "health-form")
|
||||
|
|
|
|||
Loading…
Reference in a new issue