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

idk lisp

Browse source
This commit is contained in:
Chris Cochrun 2024-11-07 20:58:15 -06:00
parent 3eb7011be8
commit a777d0a29e
4 changed files with 143 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
content/mt-form.md
View file

@ -56,4 +56,4 @@ Mission Trip applications are closed until next year.
<!-- - I acknowledge that I am expected to do my share of the work on the mission trip and I will be willing to do what is asked of me with an "I'd be glad to" attitude. -->
<!-- - **I will work at making this mission trip a priority!** even if other events come up after I am accepted on a mission trip, I will commit to still go on this trip. -->
<!-- {{< mt-form >}} -->
{{< mt-form >}}

116
src/health-form.lisp Normal file
View file

@ -0,0 +1,116 @@
(defclass health-form ()
((first-name
:initarg :first-name
:accessor first-name
:type string)
(last-name
:initarg :last-name
:accessor last-name
:type string)
(parent-first-name
:initarg :parent-first-name
:accessor parent-first-name
:type string)
(parent-last-name
:initarg :parent-last-name
:accessor parent-last-name
:type string)
(birth-date
:initarg :birth-date
:accessor birth-date
:type string)
(street
:initarg :street
:accessor street
:type string)
(city
:initarg :city
:accessor city
:type string)
(state
:initarg :state
:accessor state
:type string)
(zip
:initarg :zip
:accessor zip
:type string)
(cell-phone
:initarg :cell-phone
:accessor cell-phone
:type string)
(home-phone
:initarg :home-phone
:accessor home-phone
:type string)
(additional-emergency-contact
:initarg :additional-emergency-contact
:accessor additional-emergency-contact
:type string)
(doctor-name
:initarg :doctor-name
:accessor doctor-name
:type string)
(doctor-city
:initarg :doctor-city
:accessor doctor-city
:type string)
(doctor-phone
:initarg :doctor-phone
:accessor doctor-phone
:type string)
(medical-coverage
:initarg :medical-coverage
:accessor medical-coverage
:type string)
(insurance-name
:initarg :insurance-name
:accessor insurance-name
:type string)
(policy-number
:initarg :policy-number
:accessor policy-number
:type string)
(agreement
:initarg :agreement
:accessor agreement
:type string)
(allergies
:initarg :allergies
:accessor allergies
:type string)
(specific-allergies
:initarg :specific-allergies
:accessor specific-allergies
:type string)
(allergic-treatment
:initarg :allergic-treatment
:accessor allergic-treatment
:type string)
(conditions
:initarg :conditions
:accessor conditions
:type string)
(tetanus-shot
:initarg :tetanus-shot
:accessor tetanus-shot
:type string)
(swimming-ability
:initarg :swimming-ability
:accessor swimming-ability
:type string)
(other-notes
:initarg :other-notes
:accessor other-notes
:type string)))
(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=))))
(defmethod list-to-hf (list)
(:documentation "Takes an alist and casts it to a health-form")
(make-instance 'health-form :first-name (get-form-value "first-name" list)))

40
src/main.lisp
View file

@ -55,10 +55,7 @@
: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"))))
(setf data `((37 . ,student-name)
(data `((37 . ,student-name)
(38 . ,parent-name)
(39 . ,(get-form-value "birth-date" data-list))
(40 . ,(get-form-value "street" data-list))
@ -82,15 +79,16 @@
(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))))
(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)
(log:info 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)))
:verbose t)
t))
(defun get-form-value (key list)
"Takes the key and alist of an online form and returns the value from it"
@ -141,12 +139,13 @@ with the image attached to us"
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@cochrun.xyz" "chris@tfcconnection.org")
(if *devmode* '("chris@tfcconnection.org")
'("chris@tfcconnection.org" "ethan@tfcconnection.org"))
(format nil "~a ~a filled out a Mission Trip Form!" first-name last-name)
(format nil "Mission Trip Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN"
:ssl :tls
:authentication '(:login "no-reply@mail.tfcconnection.org" "r9f36mNZFtiW4f")
:authentication `(:login "no-reply@mail.tfcconnection.org" ,*email-password*)
:attachments attachment
:html-message
(with-html-string
@ -186,12 +185,13 @@ with the image attached"
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org" "ethan@tfcconnection.org")
(if *devmode* '("chris@tfcconnection.org")
'("chris@tfcconnection.org" "ethan@tfcconnection.org"))
(format nil "~a ~a filled out a Camp Form!" first-name last-name)
(format nil "Camp Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN"
:ssl :tls
:authentication '(:login "no-reply@mail.tfcconnection.org" "r9f36mNZFtiW4f")
:authentication `(:login "no-reply@mail.tfcconnection.org" ,*email-password*)
:attachments attachment
:html-message
(with-html-string
@ -232,12 +232,13 @@ with the image attached"
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org")
(if *devmode* '("chris@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")
:authentication `(:login "no-reply@mail.tfcconnection.org" ,*email-password*)
:attachments attachment
:html-message
(with-html-string
@ -256,6 +257,10 @@ with the image attached"
"-" (car row) " ")))
(:td (cdr row))))))))))))
(setf (ningle:route *app* "/mt-form" :method :post)
#'(lambda (params)
(log:info params)))
(setf (ningle:route *app* "/health-form" :method :post)
#'(lambda (params)
(log:info params)
@ -374,9 +379,6 @@ with the image attached"
(uiop:quit)))
(error (c) (format t "Woops, an unknown error occured:~&~a~&" c))))
(fiveam:test test-camp-form
(fiveam:is (string= "Redirecting to the health form" (camp-form test-data))))
(setf test-data '(("first-name" . "Frodo") ("last-name" . "Braggins")
("parent-first-name" . "Bilbo")
("parent-last-name" . "Braggins")
@ -388,3 +390,9 @@ with the image attached"
("allergies" . "No") ("week" . "week1")
("shirt" . "medium") ("final-agreement" . "yes")
("health-form" . "now") ("registration" . "now")))
(fiveam:test test-camp-form
(fiveam:is (string= "Redirecting to the health form" (camp-form test-data))))
(fiveam:test test-post-health-form
(fiveam:is (post-health-form test-data)))

3
tfcserver.asd
View file

@ -21,7 +21,8 @@
"cl-smtp") ;; <== list of Quicklisp dependencies
:components ((:module "src"
:components
((:file "main"))))
((:file "health-form")
(:file "main" :depends-on ("health-form")))))
:description "Restful server to handle website pieces"
:long-description "Restful server to handle website pieces"
;; :in-order-to ((test-op (test-op "tfcserver-test")))