From 67740cf2c61a946d65a253d8b140f666bfd4d256 Mon Sep 17 00:00:00 2001 From: Chris Cochrun Date: Wed, 16 Oct 2024 15:19:03 -0500 Subject: [PATCH] health-forms are working again --- src/main.lisp | 316 ++++++++++++-------------------------------------- 1 file changed, 72 insertions(+), 244 deletions(-) diff --git a/src/main.lisp b/src/main.lisp index c39d81a..3d4751a 100644 --- a/src/main.lisp +++ b/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")