diff options
| author | ckonstanski <kostcarl@isu.edu> | 2026-08-16 13:28:23 -0600 |
|---|---|---|
| committer | ckonstanski <kostcarl@isu.edu> | 2026-08-16 13:28:23 -0600 |
| commit | e46e242b8d7cc08e2f3edfc7effee706d058d201 (patch) | |
| tree | 3022b842f1be9f89de1ccfd493dd82960d4e2c8f /lisp | |
| parent | b52fa04a73e3e2ccaa1bf1d4949db331d2a095ee (diff) | |
migrate to react
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/bogenherr.asd | 12 | ||||
| -rw-r--r-- | lisp/service/about-us-service.lisp | 19 | ||||
| -rw-r--r-- | lisp/service/base-service.lisp | 206 | ||||
| -rw-r--r-- | lisp/service/contact-us-service.lisp | 4 | ||||
| -rw-r--r-- | lisp/service/gallery-service.lisp | 9 | ||||
| -rw-r--r-- | lisp/service/generics.lisp | 15 | ||||
| -rw-r--r-- | lisp/service/home-service.lisp | 3 | ||||
| -rw-r--r-- | lisp/service/login-service.lisp | 5 | ||||
| -rw-r--r-- | lisp/service/menu-service.lisp | 3 | ||||
| -rw-r--r-- | lisp/service/messages-service.lisp | 4 | ||||
| -rw-r--r-- | lisp/service/password-service.lisp | 3 | ||||
| -rw-r--r-- | lisp/service/profile-service.lisp | 5 | ||||
| -rw-r--r-- | lisp/service/rest-service.lisp | 2 | ||||
| -rw-r--r-- | lisp/service/testimonials-service.lisp | 5 | ||||
| -rw-r--r-- | lisp/service/users-service.lisp | 94 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs | 1415 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/site.lisp | 254 | ||||
| -rw-r--r-- | lisp/webapps/bogenherr/static/css/stylesheet.css | 4 | ||||
| -rw-r--r-- | lisp/webapps/generics.lisp | 12 | ||||
| -rw-r--r-- | lisp/webapps/webapp-loader.lisp | 177 |
20 files changed, 1115 insertions, 1136 deletions
diff --git a/lisp/bogenherr.asd b/lisp/bogenherr.asd index ba57330..37c34e7 100644 --- a/lisp/bogenherr.asd +++ b/lisp/bogenherr.asd @@ -51,8 +51,7 @@ (:file "contact-pkg" :depends-on ("contact-us")))) (:module service :depends-on (sql) - :components ((:file "generics") - (:file "base-service") + :components ((:file "base-service") (:file "rest-service" :depends-on ("base-service")) (:file "auth-service" :depends-on ("rest-service")) (:file "generic-form" :depends-on ("rest-service")) @@ -67,11 +66,4 @@ (:file "testimonials-service" :depends-on ("generic-form" "auth-service")) (:file "contact-us-service" :depends-on ("generic-form" "auth-service")) (:file "users-service" :depends-on ("generic-form" "auth-service")) - (:file "messages-service" :depends-on ("generic-form" "auth-service")))) - (:module webapps - :depends-on (service) - :components ((:file "generics") - (:file "webapp-loader" :depends-on ("generics")) - (:module bogenherr - :depends-on ("webapp-loader") - :components ((:file "site"))))))) + (:file "messages-service" :depends-on ("generic-form" "auth-service")))))) diff --git a/lisp/service/about-us-service.lisp b/lisp/service/about-us-service.lisp index 1ede1d2..33e95a6 100644 --- a/lisp/service/about-us-service.lisp +++ b/lisp/service/about-us-service.lisp @@ -9,8 +9,10 @@ :accessor category)) (:documentation "")) -(defun about-us-json (category) +(defun about-us-json (category &optional message errormsg) (with-noauth (instance about-us-service) + (when (not (org-ckons-core::null-or-empty-p message)) (setf (message instance) message)) + (when (not (org-ckons-core::null-or-empty-p errormsg)) (setf (errormsg instance) errormsg)) (setf (category instance) category))) (defclass about-us/view-service (about-us-service) @@ -51,7 +53,7 @@ (setf (form instance) (make-form "about-us-modify-form" nil nil - `((:label "Content" :name "txt-content" :field-type "textarea" :value ,(content about-us) :required "required") + `((:label "Content" :name "content" :field-type "textarea" :value ,(content about-us) :required "required") (:label "Modify" :field-type "button" :onclick "on_about_us_modify_submit_clicked()")))))))) (defun about-us-modify-submit-json (category content) @@ -64,3 +66,16 @@ (update-record general-pkg about-us)))) (setf (content instance) content) (setf (message instance) "About Us text saved successfully."))) + +(define-endpoint ("/lessons" :method :get) () about-us-json "lessons") +(define-endpoint ("/lessons/view" :method :get) () about-us-view-json "lessons") +(define-endpoint ("/lessons/modify" :method :post) () about-us-modify-json "lessons") +(define-endpoint ("/lessons/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "lessons" content) +(define-endpoint ("/gigs" :method :get) () about-us-json "gigs") +(define-endpoint ("/gigs/view" :method :get) () about-us-view-json "gigs") +(define-endpoint ("/gigs/modify" :method :post) () about-us-modify-json "gigs") +(define-endpoint ("/gigs/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "gigs" content) +(define-endpoint ("/programming" :method :get) () about-us-json "programming") +(define-endpoint ("/programming/view" :method :get) () about-us-view-json "programming") +(define-endpoint ("/programming/modify" :method :post) () about-us-modify-json "programming") +(define-endpoint ("/programming/modify/submit" :method :post) (&post (content :parameter-type 'string)) about-us-modify-submit-json "programming" content) diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp index ecd9469..760e2b9 100644 --- a/lisp/service/base-service.lisp +++ b/lisp/service/base-service.lisp @@ -3,15 +3,192 @@ (in-package :bogenherr) -(defclass base-service () - () +;; webapp + +(defvar *acceptor* nil) +(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher)) +(defvar *webapps* (make-hash-table :test 'equal)) +(defvar *webapp* nil) +(defvar *uri* nil) +(defvar *header-register* nil) +(defvar *sessionid* nil) +(defparameter *port* 3012) +(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./")) + "The location of the web server root on the filesystem.") + +(defclass webapp () + ((name :initarg :name + :initform nil + :accessor name + :documentation "The name of the webapp as used in the code. A +string used as the key to any webapp config lookup.") + (scheme :initarg :scheme + :initform nil + :accessor scheme) + (url :initarg :url + :initform nil + :accessor url + :documentation "The domain portion of the URL to the +root of the webapp.") + (document-root :initarg :document-root + :initform nil + :accessor document-root + :documentation "The absolute filesystem path to the +webapp's top-level directory which is inside the webapps folder.") + (title :initarg :title + :initform nil + :accessor title + :documentation "The default title that shows up in +the browser title bar.") + (meta-description :initarg :meta-description + :initform nil + :accessor meta-description + :documentation "The text that goes into the META DESCRIPTION +tag, and anywhere else we want to put this text so that it will show +up in Google.") + (databases :initarg :databases + :initform nil + :accessor databases) + (mail-mx :initarg :mail-mx + :initform nil + :accessor mail-mx) + (mail-from :initarg :mail-from + :initform nil + :accessor mail-from) + (mail-postmaster :initarg :mail-postmaster + :initform nil + :accessor mail-postmaster) + (mail-webmaster :initarg :mail-webmaster + :initform nil + :accessor mail-webmaster) + (mail-info :initarg :mail-info + :initform nil + :accessor mail-info) + (mail-login-notify :initarg :mail-login-notify + :initform nil + :accessor mail-login-notify) + (mail-authentication :initarg :mail-authentication + :initform nil + :accessor mail-authentication) + (mail-ssl :initarg :mail-ssl + :initform nil + :accessor mail-ssl)) (:documentation "")) +(defmethod get-site-file-path ((webapp webapp)) + (format nil "~a/site" (document-root webapp))) + +(defmethod get-pages-file-paths ((webapp webapp)) + (mapcar (lambda (pages-file) + (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) "")) + (remove-if (lambda (x) (equal x "shared")) + (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp)))))) + +(defun make-server-path (relative-path) + "Makes a relative filesystem path into a full one, using +`*server-root*' as the base." + (make-document-root-path *server-root* relative-path)) + +(defun make-document-root-path (document-root relative-path) + "Makes a relative filesystem path into a full one, using +`document-root' as the base." + (concatenate 'string document-root relative-path)) + +(defun make-webapp-path (relative-path) + "Makes an absolute filesystem path to a location in the webapps +folder." + (concatenate 'string *server-root* "webapps/" relative-path)) + +(defun get-options-files () + (mapcar (lambda (webapp-directory) + (format nil "~a/conf/options.lisp" webapp-directory)) + (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x) + (org-ckons-core::match-it "webapps/shared$" x) + (org-ckons-core::match-it "webapps/CVS$" x) + (org-ckons-core::match-it "webapps/\\.$" x) + (org-ckons-core::match-it "webapps/\\.\\.$" x))) + (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path "")))))) + +(defun set-webapp (webapp) + "Sets a `webapp' object in `*webapps*'. The lookup key is the webapp +name. If a webapp already exists under this key, it gets overwritten +with the new one." + (setf (gethash (name webapp) *webapps*) webapp)) + +(defun get-webapp (key) + "Gets the webapp object stored under the key `key'." + (gethash key *webapps*)) + +(defun populate-webapps () + (loop for options-file in (get-options-files) + do (with-open-file (input options-file :direction :input) + (let* ((form (read input))) + (set-webapp (make-instance 'webapp + :name (getf form :name) + :scheme (getf form :scheme) + :url (getf form :url) + :document-root (make-webapp-path (getf form :document-root)) + :title (getf form :title) + :meta-description (getf form :meta-description) + :databases (getf form :databases) + :mail-mx (getf form :mail-mx) + :mail-from (getf form :mail-from) + :mail-postmaster (getf form :mail-postmaster) + :mail-webmaster (getf form :mail-webmaster) + :mail-info (getf form :mail-info) + :mail-login-notify (getf form :mail-login-notify) + :mail-authentication (getf form :mail-authentication) + :mail-ssl (getf form :mail-ssl))))))) + +(defun bogenherr () + "Call this to start the server." + (when (null *acceptor*) + (let ((package (string-downcase (package-name #.*package*)))) + (populate-webapps) + (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) + (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package)) + (setf *session-secret* (org-ckons-session::generate-sessionid)) + (populate-webapps) + (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor + :port *port* + :document-root (make-server-path (format nil "webapps/~a/" package)) + :name (format nil "~a-acceptor" package))))))) + +(defmacro with-request-wrapper (uri page-function &rest args) + (let ((package (string-downcase (package-name #.*package*)))) + `(let (output) + (let* ((*webapp* (get-webapp ,package)) + (*uri* ,uri) + (*header-register* (make-instance 'org-ckons-session::header-register)) + (*sessionid* (ensure-user-session-exists))) + (ensure-user-exists) + (setf output (,page-function ,@args)) + (org-ckons-session::ship-headers *header-register*)) + output))) + +(defmacro define-endpoint (template-and-options var-list page-function &rest args) + "Does the grunt work of creating an `easy-routes' route for each page +you wish to publish." + (let ((name (gensym)) + (uri (first template-and-options)) + (method (getf (rest template-and-options) :method))) + `(progn + (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method)) + (easy-routes:defroute ,name ,template-and-options + ,var-list + (with-request-wrapper ,uri ,page-function ,@args))))) + +;; base-service + (defmacro loop-intersect-slots ((slot record other-object) &body body) `(loop for ,slot in (intersect-slots ,record (org-ckons-core::map-slot-names ,other-object)) do (when (slot-is-field-p ,slot) ,@body))) +(defclass base-service () + () + (:documentation "")) + (defmethod copy-from-record ((base-service base-service) (record record)) (loop-intersect-slots (slot record base-service) (setf (slot-value base-service slot) (slot-value record slot)))) @@ -19,3 +196,28 @@ (defmethod copy-to-record ((base-service base-service) (record record)) (loop-intersect-slots (slot record base-service) (setf (slot-value record slot) (slot-value base-service slot)))) + +(defun base (&optional (start-url "/home")) + (org-ckons-http::html5 + `(html + (head + ((meta :name "viewport" :content "width=device-width, initial-scale=1, shrink-to-fit=no")) + ((meta :charset "utf-8")) + ((title) ,(title *webapp*)) + ,@(mapcar (lambda (css) + `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin)))) + '((:href "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/css/bootstrap.min.css" :integrity "sha384-xOolHFLEh07PJGoPkLv1IbcEPTNtaed2xpHsD9ESMhqIYd0nLMwNLD69Npy4HI+N" :crossorigin "anonymous") + (:href "/static/css/stylesheet.css" :crossorigin "anonymous"))) + ,@(mapcar (lambda (js) + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "sha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) + ((script :type "text/javascript" :src "/cljs-out/dev-main.js"))) + ((body :onload ,(format nil "bogenherr.core.start(~a)" (if start-url + (format nil "'~a'" start-url) + "null"))) + ((div :id "app")) + ,@(mapcar (lambda (js) + `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) + '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous"))))))) + +(define-endpoint ("/" :method :get) () base) diff --git a/lisp/service/contact-us-service.lisp b/lisp/service/contact-us-service.lisp index 4e2aada..eea7f49 100644 --- a/lisp/service/contact-us-service.lisp +++ b/lisp/service/contact-us-service.lisp @@ -82,3 +82,7 @@ (error (e) (declare (ignore e)) (setf (session-value :errormsg) "Error submitting form."))))))) + +(define-endpoint ("/contact-us" :method :get) () contact-us-json) +(define-endpoint ("/contact-us/view" :method :get) () contact-us-view-json) +(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) contact-us-email-json first_name last_name email phone comments) diff --git a/lisp/service/gallery-service.lisp b/lisp/service/gallery-service.lisp index c3d0825..d20339b 100644 --- a/lisp/service/gallery-service.lisp +++ b/lisp/service/gallery-service.lisp @@ -134,3 +134,12 @@ (when gallery (setf (org-ckons-session::content-type *header-register*) (mime_type gallery)) (ironclad:hex-string-to-byte-array (content gallery))))))) + +(define-endpoint ("/gallery" :method :get) () gallery-json) +(define-endpoint ("/gallery/view" :method :get) () gallery-view-json) +(define-endpoint ("/gallery/add" :method :post) () gallery-add-json) +(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-add-submit-json description video_embed_url upload) +(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) gallery-modify-json id) +(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) gallery-modify-submit-json id description video_embed_url upload) +(define-endpoint ("/gallery/delete/:id" :method :delete) (&path (id 'integer)) gallery-delete-json id) +(define-endpoint ("/gallery/file/view/:id" :method :get) (&path (id 'integer)) gallery-file-view-json id) diff --git a/lisp/service/generics.lisp b/lisp/service/generics.lisp deleted file mode 100644 index 592d245..0000000 --- a/lisp/service/generics.lisp +++ /dev/null @@ -1,15 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defgeneric copy-from-record (base-service record) - (:documentation "Copies the fields from `record' to -`base-service'.")) - -(defgeneric copy-to-record (base-service record) - (:documentation "Copies the fields from `base-service' to -`record'.")) - -(defgeneric sanitize-rest-json (rest-service) - (:documentation "")) diff --git a/lisp/service/home-service.lisp b/lisp/service/home-service.lisp index da6ded6..30e5a03 100644 --- a/lisp/service/home-service.lisp +++ b/lisp/service/home-service.lisp @@ -16,3 +16,6 @@ (with-noauth (instance home-service) (when (not (org-ckons-core::null-or-empty-p message)) (setf (message instance) message)) (when (not (org-ckons-core::null-or-empty-p errormsg)) (setf (errormsg instance) errormsg)))) + +(define-endpoint ("/home" :method :get) () home-json) +(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) home-json message errormsg) diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp index 7a80bfd..dfe245c 100644 --- a/lisp/service/login-service.lisp +++ b/lisp/service/login-service.lisp @@ -62,3 +62,8 @@ (setf (session-value :errormsg) "Login failed.")))))) (setf (message instance) (session-value :message)) (setf (errormsg instance) (session-value :errormsg)))) + +(define-endpoint ("/login" :method :get) () login-json) +(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) login-authenticate-json username pwd) +(define-endpoint ("/login/forgot" :method :get) () login-forgot-json) +(define-endpoint ("/logout" :method :get) () logout-json) diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index 90b513a..44b9020 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -96,3 +96,6 @@ (format nil "~a ~a" (first_name user) (last_name user)) "No User Found")) (org-ckons-json::objects-to-json `(,instance)))) + +(define-endpoint ("/menu" :method :get) () menu-json) +(define-endpoint ("/menu/user" :method :get) () menu-user-json) diff --git a/lisp/service/messages-service.lisp b/lisp/service/messages-service.lisp index e03c04c..c40113c 100644 --- a/lisp/service/messages-service.lisp +++ b/lisp/service/messages-service.lisp @@ -55,3 +55,7 @@ (error (e) (declare (ignore e)) (setf (session-value :errormsg) (format nil "Error marking message ~a." read))))))) + +(define-endpoint ("/messages" :method :get) () messages-json) +(define-endpoint ("/messages/results" :method :post) (&post (read :parameter-type 'string)) messages-results-json read) +(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) messages-mark-json read id) diff --git a/lisp/service/password-service.lisp b/lisp/service/password-service.lisp index 32507d2..de9878a 100644 --- a/lisp/service/password-service.lisp +++ b/lisp/service/password-service.lisp @@ -48,3 +48,6 @@ (set-user user) (setf (session-value :message) "Password saved successfully.")) (setf (session-value :errormsg) "An error occured.")))))) + +(define-endpoint ("/password" :method :get) () password-json) +(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) password-submit-json id pwd pwd2) diff --git a/lisp/service/profile-service.lisp b/lisp/service/profile-service.lisp index 256d599..d14e3c7 100644 --- a/lisp/service/profile-service.lisp +++ b/lisp/service/profile-service.lisp @@ -59,3 +59,8 @@ (set-user user) (setf (session-value :message) "Profile saved successfully.")) (setf (session-value :errormsg) "An error occured.")))))) + +(define-endpoint ("/profile" :method :get) () profile-json) +(define-endpoint ("/profile/view" :method :get) () profile-view-json) +(define-endpoint ("/profile/modify" :method :post) () profile-modify-json) +(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) profile-modify-submit-json id username first_name last_name email phone) diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp index b01f7fa..4be2ce4 100644 --- a/lisp/service/rest-service.lisp +++ b/lisp/service/rest-service.lisp @@ -39,3 +39,5 @@ (loop for slot in (intersection '(org-ckons-session::*session-key *table *where-expression pwd) (org-ckons-core::map-slot-names rest-service)) do (setf (slot-value rest-service slot) nil))) + +(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) location-json location) diff --git a/lisp/service/testimonials-service.lisp b/lisp/service/testimonials-service.lisp index 97133f7..bdd3a7d 100644 --- a/lisp/service/testimonials-service.lisp +++ b/lisp/service/testimonials-service.lisp @@ -67,3 +67,8 @@ (update-record general-pkg testimonials)))) (setf (content instance) content) (setf (session-value :message) "Testimonials text saved successfully."))) + +(define-endpoint ("/testimonials" :method :get) () testimonials-json) +(define-endpoint ("/testimonials/view" :method :get) () testimonials-view-json) +(define-endpoint ("/testimonials/modify" :method :post) () testimonials-modify-json) +(define-endpoint ("/testimonials/modify/submit" :method :post) (&post (content :parameter-type 'string)) testimonials-modify-submit-json content) diff --git a/lisp/service/users-service.lisp b/lisp/service/users-service.lisp index 5b16d46..a2b29d4 100644 --- a/lisp/service/users-service.lisp +++ b/lisp/service/users-service.lisp @@ -35,7 +35,7 @@ :accessor form)) (:documentation "")) -(defun role-checkboxes (role-groups &optional active-role-groups) +(defun role-checkboxes (name role-groups &optional active-role-groups) (remove-if 'null (mapcar (lambda (role-group) (when (not (intersection `(,(name role-group)) `("_Public" "profile-admin") :test 'string=)) @@ -45,7 +45,7 @@ active-role-groups) :test 'string=) '(:checked "checked" :value "on")))) - (remove-if 'null `(:name ,(format nil "chk_~a" (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked))))) + (remove-if 'null `(:name ,(format nil "chk_~a_~a" name (name role-group)) :label ,(name role-group) :field-type "checkbox" ,@checked))))) role-groups))) (defun users-add-json () @@ -61,7 +61,7 @@ `((:name "first_name" :label "First Name" :field-type "text" :required "required") (:name "last_name" :label "Last Name" :field-type "text" :required "required") (:name "email" :label "Email" :field-type "text" :required "required") - ,@(role-checkboxes role-groups) + ,@(role-checkboxes "users_add" role-groups) (:label "Add User" :field-type "button" :onclick "on_users_add_submit_clicked()")))))))) (defun users-add-submit-json (role_groups first_name last_name email) @@ -95,12 +95,12 @@ ((p) "Please click the following link to complete the registration:") ((p) ((a :href ,(format nil - "~a://~a/register?hash=~a" + "~a://~a/register/~a" (scheme *webapp*) (url *webapp*) (hash registration))) ,(format nil - "~a://~a/register?hash=~a" + "~a://~a/register/~a" (scheme *webapp*) (url *webapp*) (hash registration)))))))) @@ -145,18 +145,16 @@ (registration (get-registration-by-hash auth-pkg hash))) (registrations-gc auth-pkg) (if registration - (progn - (setf (form instance) - (make-form "users-register-form" - nil - t - `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required") - (:name "username" :label "Username" :field-type "text" :required "required") - (:name "pwd" :label "Password" :field-type "password" :required "required") - (:name "pwd2" :label "Password (again)" :field-type "password" :required "required") - (:name "phone" :label "Phone" :field-type "text") - (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()")))) - (setf (session-value :message) "Registered successfully.")) + (setf (form instance) + (make-form "users-register-form" + nil + t + `((:name "hash" :field-type "hidden" :value ,(hash registration) :required "required") + (:name "username" :label "Username" :field-type "text" :required "required") + (:name "pwd" :label "Password" :field-type "password" :required "required") + (:name "pwd2" :label "Password (again)" :field-type "password" :required "required") + (:name "phone" :label "Phone" :field-type "text") + (:label "Register" :field-type "button" :onclick "on_users_register_submit_clicked()")))) (setf (session-value :errormsg) "Error: invalid registration.")))))) (defclass users/register/submit-service (rest-service) @@ -170,30 +168,29 @@ registration) (registrations-gc auth-pkg) (setf registration (get-registration-by-hash auth-pkg hash)) - (org-ckons-json::objects-to-json - `(,(if registration - (if (string= pwd pwd2) - (let ((user (make-instance 'user - :username username - :pwd pwd - :first_name (first_name registration) - :last_name (last_name registration) - :email (email registration) - :phone phone - :active t))) - (if (insert-user auth-pkg user) - (progn - (loop for role-group in (union '("profile-admin") - (cl-ppcre:split "\\|" (role_groups registration)) - :test 'string=) - do (insert-user-role-group auth-pkg (make-instance 'user-role - :user_id (id user) - :role_group_name role-group))) - (delete-registration auth-pkg hash) - (setf (session-value :message) "Registration completed successfully.")) - (setf (session-value :errormsg) "Error while completing registration."))) - (setf (session-value :errormsg) "Error: passwords do not match.")) - (setf (session-value :errormsg) "Error while completing registration.")))))))) + (if registration + (if (string= pwd pwd2) + (let ((user (make-instance 'user + :username username + :pwd pwd + :first_name (first_name registration) + :last_name (last_name registration) + :email (email registration) + :phone phone + :active t))) + (if (insert-user auth-pkg user) + (progn + (loop for role-group in (union '("profile-admin") + (cl-ppcre:split "\\|" (role_groups registration)) + :test 'string=) + do (insert-user-role-group auth-pkg (make-instance 'user-role + :user_id (id user) + :role_group_name role-group))) + (delete-registration auth-pkg hash) + (setf (session-value :message) "Registration completed successfully.")) + (setf (session-value :errormsg) "Error while completing registration."))) + (setf (session-value :errormsg) "Error: passwords do not match.")) + (setf (session-value :errormsg) "Error while completing registration.")))))) (defclass users/modify-service (users/add-service) () @@ -218,7 +215,7 @@ (:name "last_name" :label "Last Name" :field-type "text" :value ,(last_name user) :required "required") (:name "email" :label "Email" :field-type "text" :value ,(email user) :required "required") (:name "phone" :label "Phone" :field-type "text" :value ,(phone user)) - ,@(role-checkboxes role-groups active-role-groups) + ,@(role-checkboxes "users_modify" role-groups active-role-groups) (:label "Modify User" :field-type "button" :onclick "on_users_modify_submit_clicked()")))) (setf (session-value :errormsg) "Error: could not modify user. Not found.")))))) @@ -280,3 +277,16 @@ (setf (session-value :errormsg) nil) (setf (session-value :message) "User deleted successfully."))) (setf (session-value :errormsg) "Error: could not delete user: not found.")))))) + +(define-endpoint ("/users" :method :get) () users-json) +(define-endpoint ("/users/view" :method :get) () users-view-json) +(define-endpoint ("/users/add" :method :post) () users-add-json) +(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) users-add-submit-json role_groups first_name last_name email) +(define-endpoint ("/register" :method :get) (&get (hash :parameter-type 'string)) base (format nil "/register/~a" hash)) +(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) users-register-json hash) +(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) users-register-form-json hash) +(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) users-register-submit-json hash username pwd pwd2 phone) +(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) users-modify-json id) +(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) users-modify-submit-json id role_groups username first_name last_name email phone) +(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) users-toggle-active-json id) +(define-endpoint ("/users/delete/:id" :method :delete) (&path (id 'integer)) users-delete-json id) diff --git a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs index d18a067..9ffa3d2 100644 --- a/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs +++ b/lisp/webapps/bogenherr/clojurescript/bogenherr/src/bogenherr/core.cljs @@ -1,8 +1,6 @@ (ns bogenherr.core - (:require-macros [hiccups.core :as hiccups :refer [html]]) (:require [ajax.core :refer [GET POST PUT DELETE raw-response-format]] [dommy.core :as dommy] - [hiccups.runtime :as hiccupsrt] [cljsjs.showdown :as showdown] [clojure.string :as str] [cljs-time.format :as time-format] @@ -14,14 +12,34 @@ ;; declarations +(declare reset-login-state) +(declare reset-profile-state) +(declare reset-profile-view-state) +(declare reset-profile-modify-state) +(declare reset-about-us-category-state) +(declare reset-about-us-state) +(declare reset-about-us-view-state) +(declare reset-about-us-modify-state) +(declare reset-gallery-state) +(declare reset-gallery-view-state) +(declare comp-gallery-image-fullscreen) +(declare reset-gallery-add-state) +(declare reset-gallery-modify-state) +(declare reset-contact-us-state) +(declare reset-contact-us-view-state) +(declare reset-messages-state) +(declare reset-messages-results-state) +(declare reset-users-state) +(declare reset-users-view-state) +(declare reset-users-add-state) +(declare reset-users-register-state) +(declare reset-users-register-form-state) +(declare reset-users-modify-state) (declare date-sql-to-pretty) (declare markdown-to-html) (declare reduce-checkboxes) -(declare comp-app) -(declare start-render) -(declare start-location) -(declare reset-location) -(declare start) +(declare form-fields-to-map) +(declare highlight-row) (declare notifications) (declare auth-notifications) (declare comp-menu-main) @@ -32,7 +50,7 @@ (declare comp-home) (declare handler-home) (declare render-home) -(declare template-login) +(declare comp-login) (declare handler-login) (declare render-login) (declare on-login-submit-clicked) @@ -40,53 +58,55 @@ (declare render-login-authenticate) (declare handler-logout) (declare render-logout) -(declare template-profile) +(declare comp-profile) (declare handler-profile) (declare render-profile) -(declare template-profile-view) +(declare comp-profile-view) (declare handler-profile-view) (declare render-profile-view) (declare on-profile-modify-clicked) -(declare template-profile-modify) +(declare comp-profile-modify) (declare handler-profile-modify) (declare render-profile-modify) (declare on-profile-modify-submit-clicked) (declare handler-profile-modify-submit) (declare render-profile-modify-submit) -(declare template-password) +(declare comp-password) (declare handler-password) (declare render-password) (declare on-password-submit-clicked) (declare handler-password-submit) (declare render-password-submit) -(declare template-about-us) +(declare comp-about-us) (declare handler-about-us) (declare render-lessons) -(declare template-about-us-view) +(declare comp-about-us-view) (declare handler-about-us-view) (declare render-about-us-view) (declare on-about-us-modify-clicked) -(declare template-about-us-modify) +(declare comp-about-us-modify) (declare handler-about-us-modify) (declare render-about-us-modify) (declare on-about-us-modify-submit-clicked) (declare handler-about-us-modify-submit) (declare render-about-us-modify-submit) +(declare comp-gallery) +(declare handler-gallery) (declare render-gallery) -(declare template-gallery-view) +(declare comp-gallery-view) (declare template-gallery-image-fullscreen) (declare on-gallery-image-clicked ) (declare handler-gallery-view) (declare render-gallery-view) (declare on-gallery-add-clicked) -(declare template-gallery-add) +(declare comp-gallery-add) (declare handler-gallery-add) (declare render-gallery-add) (declare on-gallery-add-submit-clicked) (declare handler-gallery-add-submit) (declare render-gallery-add-submit) (declare on-gallery-modify-clicked) -(declare template-gallery-modify) +(declare comp-gallery-modify) (declare handler-gallery-modify) (declare render-gallery-modify) (declare on-gallery-modify-submit-clicked) @@ -95,64 +115,63 @@ (declare on-gallery-delete-clicked) (declare handler-gallery-delete) (declare render-gallery-delete) -(declare template-testimonials) -(declare handler-testimonials) -(declare render-testimonials) -(declare template-testimonials-view) -(declare handler-testimonials-view) -(declare render-testimonials-view) -(declare on-testimonials-modify-clicked) -(declare template-testimonials-modify) -(declare handler-testimonials-modify) -(declare render-testimonials-modify) -(declare on-testimonials-modify-submit-clicked) -(declare handler-testimonials-modify-submit) -(declare render-testimonials-modify-submit) -(declare template-contact-us) +;; (declare comp-testimonials) +;; (declare handler-testimonials) +;; (declare render-testimonials) +;; (declare comp-testimonials-view) +;; (declare handler-testimonials-view) +;; (declare render-testimonials-view) +;; (declare on-testimonials-modify-clicked) +;; (declare comp-testimonials-modify) +;; (declare handler-testimonials-modify) +;; (declare render-testimonials-modify) +;; (declare on-testimonials-modify-submit-clicked) +;; (declare handler-testimonials-modify-submit) +;; (declare render-testimonials-modify-submit) +(declare comp-contact-us) (declare handler-contact-us) (declare render-contact-us) -(declare template-contact-us-view) +(declare comp-contact-us-view) (declare handler-contact-us-view) (declare render-contact-us-view) (declare on-contact-us-email-submit-clicked) (declare handler-contact-us-email-submit) (declare render-contact-us-email-submit) -(declare template-messages) +(declare comp-messages) (declare handler-messages) (declare render-messages) (declare on-messages-mode-clicked) -(declare template-messages-results) +(declare comp-messages-results) (declare handler-messages-results) (declare render-messages-results) (declare on-messages-mark) (declare handler-messages-mark) (declare render-messages-mark) -(declare template-users) +(declare comp-users) (declare handler-users) (declare render-users) -(declare template-users-view) +(declare comp-users-view) (declare handler-users-view) (declare render-users-view) (declare on-users-add-clicked) -(declare template-users-add) +(declare comp-users-add) (declare handler-users-add) (declare render-users-add) (declare on-users-add-submit-clicked) (declare handler-users-add-submit) (declare render-users-add-submit) -(declare template-users-register) +(declare comp-users-register) (declare handler-users-register) (declare render-users-register) -(declare template-users-register-form) +(declare comp-users-register-form) (declare handler-users-register-form) (declare handler-users-register-form-impl) (declare render-users-register-form) (declare on-users-register-submit-clicked) -(declare template-users-register-submit) (declare handler-users-register-submit) (declare render-users-register-submit) (declare on-users-modify-clicked) -(declare template-users-modify) +(declare comp-users-modify) (declare handler-users-modify) (declare render-users-modify) (declare on-users-modify-submit-clicked) @@ -164,23 +183,131 @@ (declare on-users-delete-clicked) (declare handler-users-delete) (declare render-users-delete) +(declare push-menu-hook) (declare on-menu-clicked) (declare handler-location) (declare goto-location) (declare goto-register) (declare reset-app) -(declare reset-about-us-category) +(declare start-location) +(declare reset-location) +(declare comp-app) +(declare start-render) +(declare start) (enable-console-print!) -(defonce jquery (js* "$")) -(defonce sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) -(defonce pretty-formatter (time-format/formatters :rfc822)) -(defonce location-state (r/atom "/home")) -(defonce about-us-category-state (r/atom nil)) -(defonce menu-main-state (r/atom [])) -(defonce menu-user-state (r/atom [])) -(defonce menu-user-label (r/atom nil)) +(def jquery (js* "$")) +(def sql-formatter (time-format/formatter "yyyy-MM-dd HH:mm:ss")) +(def pretty-formatter (time-format/formatters :rfc822)) +(def location-state (r/atom "/home")) +(def about-us-category-state (r/atom nil)) +(def menu-main-state (r/atom [])) +(def menu-user-state (r/atom [])) +(def menu-user-label (r/atom "Guest User")) +(def login-state (r/atom {})) +(def profile-state (r/atom {})) +(def profile-view-state (r/atom {})) +(def profile-modify-state (r/atom {})) +(def password-state (r/atom {})) +(def about-us-state (r/atom {})) +(def about-us-view-state (r/atom {})) +(def about-us-modify-state (r/atom {})) +(def gallery-state (r/atom {})) +(def gallery-view-state (r/atom {})) +(def gallery-add-state (r/atom {})) +(def gallery-modify-state (r/atom {})) +(def gallery-image-state (r/atom nil)) +(def contact-us-state (r/atom {})) +(def contact-us-view-state (r/atom {})) +(def messages-state (r/atom {})) +(def messages-results-state (r/atom {})) +(def users-state (r/atom {})) +(def users-view-state (r/atom {})) +(def users-add-state (r/atom {})) +(def users-register-state (r/atom {})) +(def users-register-form-state (r/atom {})) +(def users-modify-state (r/atom {})) +(def menu-hooks (atom {})) + +(defn push-menu-hook [hook] + "`hook' is a map of the form {:handler \"/some/url\" :func #(some-fn)}" + (swap! menu-hooks assoc (get hook :handler) hook)) + +(defn reset-location [url] + (reset! location-state (first (str/split url "?")))) + +(defn reset-login-state [jsonobj] + (reset! login-state jsonobj)) + +(defn reset-profile-state [jsonobj] + (reset! profile-state jsonobj)) + +(defn reset-profile-view-state [jsonobj] + (reset! profile-view-state jsonobj)) + +(defn reset-profile-modify-state [jsonobj] + (reset! profile-modify-state jsonobj)) + +(defn reset-password-state [jsonobj] + (reset! password-state jsonobj)) + +(defn reset-about-us-category-state [category] + (reset! about-us-category-state category)) + +(defn reset-about-us-state [jsonobj] + (reset! about-us-state jsonobj)) + +(defn reset-about-us-view-state [jsonobj] + (reset! about-us-view-state jsonobj)) + +(defn reset-about-us-modify-state [jsonobj] + (reset! about-us-modify-state jsonobj)) + +(defn reset-gallery-state [jsonobj] + (reset! gallery-state jsonobj)) + +(defn reset-gallery-view-state [jsonobj] + (reset! gallery-view-state jsonobj)) + +(defn reset-gallery-image-state [src] + (reset! gallery-image-state src)) + +(defn reset-gallery-add-state [jsonobj] + (reset! gallery-add-state jsonobj)) + +(defn reset-gallery-modify-state [jsonobj] + (reset! gallery-modify-state jsonobj)) + +(defn reset-contact-us-state [jsonobj] + (reset! contact-us-state jsonobj)) + +(defn reset-contact-us-view-state [jsonobj] + (reset! contact-us-view-state jsonobj)) + +(defn reset-messages-state [jsonobj] + (reset! messages-state jsonobj)) + +(defn reset-messages-results-state [jsonobj] + (reset! messages-results-state jsonobj)) + +(defn reset-users-state [jsonobj] + (reset! users-state jsonobj)) + +(defn reset-users-view-state [jsonobj] + (reset! users-view-state jsonobj)) + +(defn reset-users-add-state [jsonobj] + (reset! users-add-state jsonobj)) + +(defn reset-users-register-state [jsonobj] + (reset! users-register-state jsonobj)) + +(defn reset-users-register-form-state [jsonobj] + (reset! users-register-form-state jsonobj)) + +(defn reset-users-modify-state [jsonobj] + (reset! users-modify-state jsonobj)) ;; helper functions @@ -198,66 +325,21 @@ separating the throwaway prefix and the remaining useful bit. `selector' will likely be something like: [id^='chk_']" (reduce (fn [x y] - (cond (and x y) (str x "|" y) - (and x (not y)) x - (and (not x) y) y + (cond (and (not (empty? x)) (not (empty? y))) (str x "|" y) + (and (not (empty? x)) (empty? y)) x + (and (empty? x) (not (empty? y))) y :else "")) (map (fn [elem] (let [this (jquery (str "#" (dommy/attr elem :id)))] (when (-> this (.prop "checked")) - (second (str/split (-> this (.prop "id")) "_"))))) + (last (str/split (-> this (.prop "id")) "_"))))) (.toArray (jquery selector))))) -;; body - -(defn comp-app [] - [:div {:class "container-fluid"} - [:div {:class "banner"} - [:table {:width "100%" :height "100%"} - [:tbody - [:tr - [:td {:class "banner-menu"} - [comp-menu-user]] - [:td {:class "banner-title"} "Bogen-" [:i "Herr"]] - [:td {:class "banner-menu"} " "]]]]] - [comp-menu-main] - [ck-notifications/comp-errormsg] - [ck-notifications/comp-message] - [:div {:id "body"}] - [:div {:id "footer"} - [:hr] - "Carlos Konstanski (970) 294-9708" - [:br] - [:a {:href "https://git.ckons.org/bogenherr.git/tree" - :target "_blank"} - "Source code in Git"]]]) - -;; start the react app - -(defn start-render [] - (let [app-root (rdc/create-root (js/document.getElementById "app"))] - (rdc/render app-root [comp-app]))) - -(defn start-location [] - (cond (str/starts-with? @location-state "/register/") - (goto-register (str/replace-first @location-state "/register/" "")) - :else - (goto-location @location-state))) - -(defn reset-location [url] - (reset! location-state url)) - -(defn reset-about-us-category [category] - (reset! about-us-category-state category)) - -(defn ^:dev/after-load start - ([] - (start-render) - (start-location)) - ([url] - (reset-location url) - (start-render) - (start-location))) +(defn form-fields-to-map [selector] + (let [form-name (str/replace (str/replace-first (first (str/split selector " ")) "#" "") "-" "_")] + (apply merge (for [x (jquery selector) + :when (not (empty? (.-name x)))] + {(str/replace (.-name x) (str form-name "-") "") (.-value x)})))) ;; notifications @@ -300,7 +382,7 @@ :aria-expanded "false"} @menu-user-label] [:div {:class "dropdown-menu" :aria-labelledby "button-menu-user"} - (for [menuitem @menu-user-state] + (for [menuitem (doall @menu-user-state)] [:a {:key (get menuitem "id") :class "dropdown-item" :on-click #(on-menu-clicked (get menuitem "handler"))} @@ -321,20 +403,19 @@ ;; home -(hiccups/defhtml template-home [jsonobj] - [:div - [:h2 {:style "text-align: center"} "Welcome To Carlos Konstanski's Music Studio"] - [:h3 {:style "text-align: center"} +(defn comp-home [] + [:div {:style {:display (cond (or (= @location-state "/home")) "block" :else "none")}} + [:h2 {:style {:text-align "center"}} "Welcome To Carlos Konstanski's Music Studio"] + [:h3 {:style {:text-align "center"}} [:i "a.k.a. der Bogenherr" [:br] "a.k.a. Dr. Divertimento"]] - [:h2 {:style "text-align: center"} "Study the Violin, Viola and Viola d'Amore With Me!"] - [:div {:style "text-align: center"} - [:img {:style "width: 100%" + [:h2 {:style {:text-align "center"}} "Study the Violin, Viola and Viola d'Amore With Me!"] + [:div {:style {:text-align "center"}} + [:img {:style {:width "100%"} :src "/static/images/instrument-cabinet.jpg"}]]]) (defn handler-home [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj)))) + (notifications jsonobj))) (defn render-home ([] @@ -348,16 +429,17 @@ ;; login -(hiccups/defhtml template-login [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)) - [:div {:style "text-align: center"} - [:a {:href ""} "Forgot password?"]]) +(defn comp-login [] + [:div {:style {:display (cond (or (= @location-state "/login")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @login-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @login-state "form") (namespace ::x)))}] + [:div {:style {:text-align "center"}} + [:a {:href ""} "Forgot password?"]]]) (defn handler-login [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj)))) + (reset-login-state jsonobj) + (notifications jsonobj))) (defn render-login [] (GET "/login" {:handler handler-login})) @@ -383,52 +465,51 @@ (defn render-login-authenticate [] (POST "/login/authenticate" {:format :raw - :params {:username (dommy/value (dommy/sel1 :#username)) - :pwd (dommy/value (dommy/sel1 :#pwd))} + :params (form-fields-to-map "#login-form :input") :handler handler-login-authenticate})) ;; logout (defn handler-logout [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (render-home "You are now logged out" "") - (reset-location "/home") - (render-menu))) + (render-home "You are now logged out" "") + (reset-location "/home") + (render-menu)) (defn render-logout [] (GET "/logout" {:handler handler-logout})) ;; profile -(hiccups/defhtml template-profile [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 {:class "modal-title"} "Profile - Modify"] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-profile [] + [:div {:style {:display (cond (or (= @location-state "/profile")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @profile-state "title")] + [comp-profile-view] + [:div {:id "modify-profile" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 {:class "modal-title"} "Profile - Modify"] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-profile-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-profile [response] (let [jsonobj (js->clj (js/JSON.parse response))] + (reset-profile-state jsonobj) (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-profile jsonobj)) (render-profile-view))) (defn render-profile [] @@ -436,31 +517,43 @@ ;; profile-view -(hiccups/defhtml template-profile-view [jsonobj] - [:div {:style "text-align: right"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_profile_modify_clicked()")}]] - [:div {:class "container"} - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Username:"] - [:div {:class "col-10"} (get jsonobj "username")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "First Name:"] - [:div {:class "col-10"} (get jsonobj "first_name")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Last Name:"] - [:div {:class "col-10"} (get jsonobj "last_name")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Email:"] - [:div {:class "col-10"} (get jsonobj "email")]] - [:div {:class "row"} - [:div {:class "col" :style "text-align: right"} "Phone:"] - [:div {:class "col-10"} (get jsonobj "phone")]]]) +(defn comp-profile-view [] + [:div + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-profile-modify-clicked)}]] + (for [item (get @profile-view-state "items")] + [:div {:class "container"} + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Username:"] + [:div {:class "col-10" + :key (str "profile-view-username-" (get item "id"))} + (get item "username")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "First Name:"] + [:div {:class "col-10" + :key (str "profile-view-first_name-" (get item "id"))} + (get item "first_name")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Last Name:"] + [:div {:class "col-10" + :key (str "profile-view-last_name-" (get item "id"))} + (get item "last_name")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Email:"] + [:div {:class "col-10" + :key (str "profile-view-email-" (get item "id"))} + (get item "email")]] + [:div {:class "row"} + [:div {:class "col" :style {:text-align "right"}} "Phone:"] + [:div {:class "col-10" + :key (str "profile-view-phone-" (get item "id"))} + (get item "phone")]]])]) (defn handler-profile-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-profile-view jsonobj)))) + (reset-profile-view-state jsonobj) + (auth-notifications jsonobj))) (defn render-profile-view [] (GET "/profile/view" {:handler handler-profile-view})) @@ -470,14 +563,14 @@ (defn on-profile-modify-clicked [] (render-profile-modify)) -(hiccups/defhtml template-profile-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-profile-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @profile-modify-state "form") (namespace ::x)))}]) (defn handler-profile-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-profile-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-profile-modify-state jsonobj) + (.modal (jquery "#modify-profile")))) (defn render-profile-modify [] (POST "/profile/modify" {:handler handler-profile-modify})) @@ -488,7 +581,7 @@ (when (-> (jquery "#profile-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modify-profile") "hide") (render-profile-modify-submit))) (defn handler-profile-modify-submit [response] @@ -499,24 +592,20 @@ (defn render-profile-modify-submit [] (POST "/profile/modify/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :username (dommy/value (dommy/sel1 :#username)) - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (form-fields-to-map "#profile-modify-form :input") :handler handler-profile-modify-submit})) ;; password -(hiccups/defhtml template-password [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-password [jsonobj] + [:div {:style {:display (cond (or (= @location-state "/password")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @password-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @password-state "form") (namespace ::x)))}]]) (defn handler-password [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-password jsonobj)))) + (reset-password-state jsonobj))) (defn render-password [] (GET "/password" {:handler handler-password})) @@ -537,46 +626,51 @@ (defn render-password-submit [] (POST "/password/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :pwd (dommy/value (dommy/sel1 :#pwd)) - :pwd2 (dommy/value (dommy/sel1 :#pwd2))} + :params (form-fields-to-map "#password-form :input") :handler handler-password-submit})) -;; about-us (lessons, gigs, programming) +;; about-us -(hiccups/defhtml template-about-us [jsonobj] - [:h1 {:style "text-align: center"} - (cond (= @about-us-category-state "lessons") "About the Studio" - (= @about-us-category-state "gigs") "Hire Me to Play" - (= @about-us-category-state "programming") "Hire Me to Write Software")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-about-us [] + [:div {:style {:display (cond (or (= @location-state "/lessons") + (= @location-state "/gigs") + (= @location-state "/programming")) + "block" :else "none")}} + [:h3 {:style {:text-align "center"}} + (cond (= @about-us-category-state "lessons") "About the Studio" + (= @about-us-category-state "gigs") "Hire Me to Play" + (= @about-us-category-state "programming") "Hire Me to Write Software")] + [comp-about-us-view] + [:div {:id "modify-about-us" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (str (cond (= @about-us-category-state "lessons") "About the Studio" + (= @about-us-category-state "gigs") "Hire Me to Play" + (= @about-us-category-state "programming") "Hire Me to Write Software") + " - Modify")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-about-us-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-about-us [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (reset-about-us-category (get jsonobj "category")) + (reset-about-us-category-state (get jsonobj "category")) + (reset-about-us-state jsonobj) (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-about-us jsonobj)) (render-about-us-view))) (defn render-lessons [] @@ -590,18 +684,17 @@ ;; about-us-view -(hiccups/defhtml template-about-us-view [jsonobj] - (when (get jsonobj "adminP") - [:div {:style "text-align: right;"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_about_us_modify_clicked()")}]]) - [:div {:id "markdown"}]) +(defn comp-about-us-view [] + [:div + (when (get @about-us-view-state "adminP") + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-about-us-modify-clicked)}]]) + [:div {:dangerouslySetInnerHTML (r/unsafe-html (markdown-to-html (get @about-us-view-state "content")))}]]) (defn handler-about-us-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-about-us-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) + (reset-about-us-view-state jsonobj))) (defn render-about-us-view [] (GET (str "/" @about-us-category-state "/view") @@ -612,19 +705,14 @@ (defn on-about-us-modify-clicked [] (render-about-us-modify)) -(hiccups/defhtml template-about-us-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-about-us-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @about-us-modify-state "form") (namespace ::x)))}]) (defn handler-about-us-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) - (str (cond (= @about-us-category-state "lessons") "About the Studio" - (= @about-us-category-state "gigs") "For Hire" - (= @about-us-category-state "programming") "Software Consulting") - " - Modify")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-about-us-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-about-us-modify-state jsonobj) + (.modal (jquery "#modify-about-us")))) (defn render-about-us-modify [] (POST (str "/" @about-us-category-state "/modify") @@ -636,72 +724,93 @@ (when (-> (jquery "#about-us-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modify-about-us") "hide") (render-about-us-modify-submit))) (defn handler-about-us-modify-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-about-us-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) + (reset-about-us-view-state jsonobj) + (auth-notifications jsonobj))) (defn render-about-us-modify-submit [] (POST (str "/" @about-us-category-state "/modify/submit") {:format :raw - :params {:content (dommy/value (dommy/sel1 :#txt-content))} + :params (form-fields-to-map "#about-us-modify-form :input") :handler handler-about-us-modify-submit})) ;; gallery -(hiccups/defhtml template-gallery [jsonobj] - [:h1 {:style "text-align: center"} "Gallery"] - [:div {:id "content"}] - [:div {:id "image" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg mw-100 w-75"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "image-body" - :class "modal-body" - :style "width: 100%"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Close"]]]]] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 425px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-gallery [] + [:div {:style {:display (cond (or (= @location-state "/gallery")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @gallery-state "title")] + [comp-gallery-view] + [:div {:id "modal-gallery-image" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg mw-100 w-75"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:width "100%"}} + [comp-gallery-image-fullscreen]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Close"]]]]] + [:div {:id "modal-gallery-add" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @gallery-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-gallery-add]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]] + [:div {:id "modal-gallery-modify" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @gallery-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-gallery-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-gallery [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-gallery jsonobj)) + (reset-gallery-state jsonobj) (render-gallery-view))) (defn render-gallery [] @@ -709,60 +818,62 @@ ;; gallery-view -(hiccups/defhtml template-gallery-view [jsonobj] - [:div {:style "text-align: right"} - (when (get jsonobj "adminP") - [:img {:src "/static/images/add.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_gallery_add_clicked()")}])] - (let [results (get jsonobj "results")] - (cond (empty? results) - [:h5 {:style "text-align: center"} "No results found."] - :else - (for [rec results] - [:span {:style "width:720px; height:425px"} - [:table - [:tr - [:td - (cond (not (= (get rec "video_embed_url") "null")) - [:iframe {:width "720" - :height "405" - :src (get rec "video_embed_url") - :frameborder "0" - :allow "accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" - :referrerpolicy "strict-origin-when-cross-origin" - :allowfullscreen "allowfullscreen"}] - :else - (let [img-src (str "/gallery/file/view/" (get rec "id"))] - [:img {:style "height:405px; cursor:pointer; cursor:hand" - :src img-src - :onclick (str (namespace ::x) ".on_gallery_image_clicked('" img-src "')")}]))] - (when (get jsonobj "adminP") - [:td {:style "text-align:right; vertical-align:top"} - [:img {:src "/static/images/edit.png" - :onclick (str (namespace ::x) ".on_gallery_modify_clicked(" (get rec "id") ")")}] - [:br] - [:img {:src "/static/images/delete.png" - :onclick (str (namespace ::x) ".on_gallery_delete_clicked(" (get rec "id") ")")}]])] - [:tr - [:td (get rec "description")]] - [:tr - [:td " "]] - [:tr - [:td " "]]]])))) +(defn comp-gallery-view [] + [:div + (when (get @gallery-view-state "adminP") + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/add.png" + :on-click #(on-gallery-add-clicked)}]]) + (cond (empty? (get @gallery-view-state "results")) + [:h5 {:style {:text-align "center"}} "No results found."] + :else + (for [rec (get @gallery-view-state "results")] + [:span {:style {:width "720px" + :height "425px"}} + [:table + [:tr + [:td + (cond (not (= (get rec "video_embed_url") "null")) + [:iframe {:width "720" + :height "405" + :src (get rec "video_embed_url") + :frameborder "0" + :allow "accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" + :referrerpolicy "strict-origin-when-cross-origin" + :allowfullscreen "allowfullscreen"}] + :else + (let [img-src (str "/gallery/file/view/" (get rec "id"))] + [:img {:style {:height "405px"} + :src img-src + :on-click #(on-gallery-image-clicked img-src)}]))] + (when (get @gallery-view-state "adminP") + [:td {:style {:text-align "right" + :vertical-align "top"}} + [:img {:src "/static/images/edit.png" + :on-click #(on-gallery-modify-clicked (get rec "id"))}] + [:br] + [:img {:src "/static/images/delete.png" + :on-click #(on-gallery-delete-clicked (get rec "id"))}]])] + [:tr + [:td (get rec "description")]] + [:tr + [:td " "]] + [:tr + [:td " "]]]]))]) -(hiccups/defhtml template-gallery-image-fullscreen [src] - [:img {:src src - :style "width: 100%"}]) +(defn comp-gallery-image-fullscreen [] + [:div + [:img {:src @gallery-image-state + :style {:width "100%"}}]]) (defn on-gallery-image-clicked [src] - (dommy/set-html! (dommy/sel1 :#image-body) (template-gallery-image-fullscreen src)) - (.modal (jquery "#image"))) + (reset-gallery-image-state src) + (.modal (jquery "#modal-gallery-image"))) (defn handler-gallery-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-gallery-view jsonobj)))) + (reset-gallery-view-state jsonobj))) (defn render-gallery-view [] (GET "/gallery/view" {:handler handler-gallery-view})) @@ -772,15 +883,14 @@ (defn on-gallery-add-clicked [] (render-gallery-add)) -(hiccups/defhtml template-gallery-add [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-gallery-add [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @gallery-add-state "form") (namespace ::x)))}]) (defn handler-gallery-add [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) "Gallery - Add") - (dommy/set-html! (dommy/sel1 :#modify-body) (template-gallery-add jsonobj)) - (.modal (jquery "#modify")))) + (reset-gallery-add-state jsonobj) + (.modal (jquery "#modal-gallery-add")))) (defn render-gallery-add [] (POST "/gallery/add" {:handler handler-gallery-add})) @@ -791,7 +901,7 @@ (when (-> (jquery "#gallery-add-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-gallery-add") "hide") (render-gallery-add-submit))) (defn handler-gallery-add-submit [response] @@ -811,15 +921,14 @@ (defn on-gallery-modify-clicked [id] (render-gallery-modify id)) -(hiccups/defhtml template-gallery-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-gallery-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @gallery-modify-state "form") (namespace ::x)))}]) (defn handler-gallery-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) "Gallery - Modify") - (dommy/set-html! (dommy/sel1 :#modify-body) (template-gallery-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-gallery-modify-state jsonobj) + (.modal (jquery "#modal-gallery-modify")))) (defn render-gallery-modify [id] (POST "/gallery/modify" @@ -833,7 +942,7 @@ (when (-> (jquery "#gallery-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-gallery-modify") "hide") (render-gallery-modify-submit))) (defn handler-gallery-modify-submit [response] @@ -864,119 +973,125 @@ {:format :raw :handler handler-gallery-delete})) -;; testimonials +;; ;; testimonials -(hiccups/defhtml template-testimonials [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 460px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +;; (hiccups/defhtml template-testimonials [jsonobj] +;; [:h3 {:style "text-align: center"} (get jsonobj "title")] +;; [:div {:id "content"}] +;; [:div {:id "modify" +;; :class "modal fade" +;; :role "dialog" +;; :tabindex "-1"} +;; [:div {:class "modal-dialog modal-lg"} +;; [:div {:class "modal-content"} +;; [:div {:class "modal-header"} +;; [:h5 [:span {:id "modify-title"}]] +;; [:button {:type "button" +;; :class "close" +;; :data-dismiss "modal"} +;; "×"]] +;; [:div {:id "modify-body" +;; :class "modal-body" +;; :style "height: 460px;"}] +;; [:div {:class "modal-footer"} +;; [:button {:type "submit" +;; :class "btn btn-danger btn-default" +;; :data-dismiss "modal"} +;; [:span {:class "glyphicon glyphicon-remove"}] +;; "Cancel"]]]]]) -(defn handler-testimonials [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-testimonials jsonobj)) - (render-testimonials-view))) +;; (defn handler-testimonials [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (notifications jsonobj) +;; (dommy/set-html! (dommy/sel1 :#body) (template-testimonials jsonobj)) +;; (render-testimonials-view))) -(defn render-testimonials [] - (GET "/testimonials" {:handler handler-testimonials})) +;; (defn render-testimonials [] +;; (GET "/testimonials" {:handler handler-testimonials})) -;; testimonials-view +;; ;; testimonials-view -(hiccups/defhtml template-testimonials-view [jsonobj] - (when (get jsonobj "adminP") - [:div {:style "text-align: right;"} - [:img {:src "/static/images/edit.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_testimonials_modify_clicked()")}]]) - [:div {:id "markdown"}]) +;; (hiccups/defhtml template-testimonials-view [jsonobj] +;; (when (get jsonobj "adminP") +;; [:div {:style "text-align: right;"} +;; [:img {:src "/static/images/edit.png" +;; :style "cursor:pointer; cursor:hand" +;; :onclick (str (namespace ::x) ".on_testimonials_modify_clicked()")}]]) +;; [:div {:id "markdown"}]) -(defn handler-testimonials-view [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-testimonials-view jsonobj)) - (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) +;; (defn handler-testimonials-view [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (dommy/set-html! (dommy/sel1 :#content) (template-testimonials-view jsonobj)) +;; (dommy/set-html! (dommy/sel1 :#markdown) (markdown-to-html (get jsonobj "content"))))) -(defn render-testimonials-view [] - (GET "/testimonials/view" {:handler handler-testimonials-view})) +;; (defn render-testimonials-view [] +;; (GET "/testimonials/view" {:handler handler-testimonials-view})) -;; testimonials-modify +;; ;; testimonials-modify -(defn on-testimonials-modify-clicked [] - (render-testimonials-modify)) +;; (defn on-testimonials-modify-clicked [] +;; (render-testimonials-modify)) -(hiccups/defhtml template-testimonials-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +;; (hiccups/defhtml template-testimonials-modify [jsonobj] +;; (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) -(defn handler-testimonials-modify [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-testimonials-modify jsonobj)) - (.modal (jquery "#modify")))) +;; (defn handler-testimonials-modify [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (auth-notifications jsonobj) +;; (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) +;; (dommy/set-html! (dommy/sel1 :#modify-body) (template-testimonials-modify jsonobj)) +;; (.modal (jquery "#modify")))) -(defn render-testimonials-modify [] - (POST "/testimonials/modify" {:handler handler-testimonials-modify})) +;; (defn render-testimonials-modify [] +;; (POST "/testimonials/modify" {:handler handler-testimonials-modify})) -;; testimonials-modify-submit +;; ;; testimonials-modify-submit -(defn on-testimonials-modify-submit-clicked [] - (when (-> (jquery "#testimonials-modify-form") - (.get "0") - (.checkValidity)) - (.modal (jquery "#modify") "hide") - (render-testimonials-modify-submit))) +;; (defn on-testimonials-modify-submit-clicked [] +;; (when (-> (jquery "#testimonials-modify-form") +;; (.get "0") +;; (.checkValidity)) +;; (.modal (jquery "#modify") "hide") +;; (render-testimonials-modify-submit))) -(defn handler-testimonials-modify-submit [response] - (let [jsonobj (js->clj (js/JSON.parse response))] - (auth-notifications jsonobj) - (on-menu-clicked "/testimonials"))) +;; (defn handler-testimonials-modify-submit [response] +;; (let [jsonobj (js->clj (js/JSON.parse response))] +;; (auth-notifications jsonobj) +;; (on-menu-clicked "/testimonials"))) -(defn render-testimonials-modify-submit [] - (POST "/testimonials/modify/submit" - {:format :raw - :params {:content (dommy/value (dommy/sel1 :#txt-content))} - :handler handler-testimonials-modify-submit})) +;; (defn render-testimonials-modify-submit [] +;; (POST "/testimonials/modify/submit" +;; {:format :raw +;; :params {:content (dommy/value (dommy/sel1 :#txt-content))} +;; :handler handler-testimonials-modify-submit})) ;; contact-us -(hiccups/defhtml template-contact-us [jsonobj] - [:h1 {:style "text-align: center"} "Reach out to me by filling out the form."] - [:div {:id "content"}] - [:table {:width "100%"} - [:tr - [:td {:style "width: 100%; text-align: center;"} - [:h3 "Located on the edge of the ISU campus!"]]] - [:tr - [:td {:style "width: 100%; text-align: center;"} - [:iframe {:src "https://www.google.com/maps/embed?pb=!1m18!1m12!1m3!1d3225.263770603599!2d-112.4266916!3d42.8635091!2m3!1f0!2f0!3f0!3m2!1i1024!2i768!4f13.1!3m3!1m2!1s0x53554f343c440407%3A0xf13bf897ecb4f7e0!2sBogenherr%20Violin%20and%20Viola%20Studio!5e1!3m2!1sen!2sus!4v1783097048097!5m2!1sen!2sus" - :style "width: 600px; height: 450px; border: 0px;" - :allowfullscreen "" - :loading "lazy" - :referrerpolicy "strict-origin-when-cross-origin"}]]]]) +(defn comp-contact-us [] + [:div {:style {:display (cond (or (= @location-state "/contact-us")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} "Reach out to me by filling out the form."] + [comp-contact-us-view] + [:table {:width "100%"} + [:tbody + [:tr + [:td {:style {:width "100%" + :text-align "center"}} + [:h3 "Located on the edge of the ISU campus!"]]] + [:tr + [:td {:style {:width "100%" + :text-align "center"}} + [:iframe {:src "https://www.google.com/maps/embed?pb=!1m18!1m12!1m3!1d3225.263770603599!2d-112.4266916!3d42.8635091!2m3!1f0!2f0!3f0!3m2!1i1024!2i768!4f13.1!3m3!1m2!1s0x53554f343c440407%3A0xf13bf897ecb4f7e0!2sBogenherr%20Violin%20and%20Viola%20Studio!5e1!3m2!1sen!2sus!4v1783097048097!5m2!1sen!2sus" + :style {:width "600px" + :height "450px" + :border "0px"} + :allowfullscreen "" + :loading "lazy" + :referrerpolicy "strict-origin-when-cross-origin"}]]]]]]) (defn handler-contact-us [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-contact-us jsonobj)) + (reset-contact-us-state jsonobj) (render-contact-us-view))) (defn render-contact-us [] @@ -984,13 +1099,13 @@ ;; contact-us-view -(hiccups/defhtml template-contact-us-view [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-contact-us-view [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @contact-us-view-state "form") (namespace ::x)))}]) (defn handler-contact-us-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-contact-us-view jsonobj)))) + (reset-contact-us-view-state jsonobj))) (defn render-contact-us-view [] (GET "/contact-us/view" {:handler handler-contact-us-view})) @@ -1009,26 +1124,21 @@ (defn render-contact-us-email-submit [] (POST "/contact-us/email" {:format :raw - :params {:first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone)) - :comments (dommy/value (dommy/sel1 :#comments))} + :params (form-fields-to-map "#contact-us-form :input") :handler handler-contact-us-email-submit})) ;; messages -(hiccups/defhtml template-messages [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)) - [:div {:id "results"}]) +(defn comp-messages [] + [:div {:style {:display (cond (or (= @location-state "/messages")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @messages-state "title")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @messages-state "form") (namespace ::x)))}] + [comp-messages-results]]) (defn handler-messages [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-messages jsonobj)) - (when (not (empty? (dommy/value (dommy/sel1 :#read)))) - (render-messages-results)))) + (reset-messages-state jsonobj))) (defn render-messages [] (GET "/messages" {:handler handler-messages})) @@ -1036,56 +1146,54 @@ ;; messages-results (defn on-messages-mode-clicked [read] - (dommy/set-value! (dommy/sel1 :#read) read) + (dommy/set-value! (dommy/sel1 :#messages_select_mode_form-read) read) (render-messages-results)) -(hiccups/defhtml template-messages-results [jsonobj] - (let [results (get jsonobj "results") +(defn comp-messages-results [] + (let [results (get @messages-results-state "results") keys (remove (fn [x] (not (get (first results) x))) (keys (first results)))] - (cond (empty? results) - [:h5 {:style "text-align: center"} "No results found."] - :else - [:table {:class "table table-hover"} - [:thead - [:tr - (for [key keys] - [:th key]) - [:th - (str "Mark " (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "unread" - :else - "read"))]]] - [:tbody - (for [rec results] - (let [onclick "void()"] - [:tr - (for [key keys] - [:td {:onclick onclick} (get rec key)]) - [:td [:img {:src (str "/static/images/" - (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "edit-undo.png" - :else - "edit-redo.png")) - :style "cursor: pointer; cursor: hand" - :onclick (str (namespace ::x) - ".on_messages_mark(" - (cond (= (dommy/value (dommy/sel1 :#read)) "read") - "'unread'" - :else - "'read'") - "," (get rec "id") ")")}]]]))]]))) + [:div + (cond (empty? results) + [:h5 {:style {:text-align "center"}} "No results found."] + :else + [:table {:class "table table-hover"} + [:thead + [:tr + (for [key keys] + [:th key]) + [:th + (str "Mark " (cond (= (dommy/value (dommy/sel1 :#messages_select_mode_form-read)) "read") + "unread" + :else + "read"))]]] + [:tbody + (for [rec results] + (let [onclick "void()"] + [:tr + (for [key keys] + [:td {:onclick onclick} (get rec key)]) + [:td [:img {:src (str "/static/images/" + (cond (= (dommy/value (dommy/sel1 :#messages_select_mode_form-read)) "read") + "edit-undo.png" + :else + "edit-redo.png")) + :on-click #(on-messages-mark (cond (= (dommy/value (dommy/sel1 :#messages_select_mode_form-read)) "read") + "'unread'" + :else + "'read'") + (get rec "id"))}]]]))]])])) (defn handler-messages-results [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#results) (template-messages-results jsonobj)))) + (reset-messages-results-state jsonobj))) (defn render-messages-results [] (POST "/messages/results" {:format :raw - :params {:read (dommy/value (dommy/sel1 :#read))} + :params (form-fields-to-map "#messages-select-mode-form :input") :handler handler-messages-results})) ;; messages-mark @@ -1101,41 +1209,62 @@ (defn render-messages-mark [read id] (POST "/messages/mark" {:format :raw - :params {:read read - :id id} + :params (merge (form-fields-to-map "#messages-select-mode-form :input") {"id" (str id)}) :handler handler-messages-mark})) ;; users -(hiccups/defhtml template-users [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}] - [:div {:id "modify" - :class "modal fade" - :role "dialog" - :tabindex "-1"} - [:div {:class "modal-dialog modal-lg"} - [:div {:class "modal-content"} - [:div {:class "modal-header"} - [:h5 [:span {:id "modify-title"}]] - [:button {:type "button" - :class "close" - :data-dismiss "modal"} - "×"]] - [:div {:id "modify-body" - :class "modal-body" - :style "height: 450px;"}] - [:div {:class "modal-footer"} - [:button {:type "submit" - :class "btn btn-danger btn-default" - :data-dismiss "modal"} - [:span {:class "glyphicon glyphicon-remove"}] - "Cancel"]]]]]) +(defn comp-users [] + [:div {:style {:display (cond (or (= @location-state "/users")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @users-state "title")] + [comp-users-view] + [:div {:id "modal-users-add" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @users-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-users-add]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]] + [:div {:id "modal-users-modify" + :class "modal fade" + :role "dialog" + :tab-index "-1"} + [:div {:class "modal-dialog modal-lg"} + [:div {:class "modal-content"} + [:div {:class "modal-header"} + [:h5 (get @users-state "title")] + [:button {:type "button" + :class "close" + :data-dismiss "modal"} + "X"]] + [:div {:class "modal-body" + :style {:height "460px"}} + [comp-users-modify]] + [:div {:class "modal-footer"} + [:button {:type "submit" + :class "btn btn-danger btn-default" + :data-dismiss "modal"} + [:span {:class "glyphicon glyphicon-remove"}] + "Cancel"]]]]]]) (defn handler-users [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#body) (template-users jsonobj)) + (reset-users-state jsonobj) (render-users-view))) (defn render-users [] @@ -1143,42 +1272,46 @@ ;; users-view -(hiccups/defhtml template-users-view [jsonobj] - [:div {:style "text-align: right"} - [:img {:src "/static/images/add.png" - :style "cursor:pointer; cursor:hand" - :onclick (str (namespace ::x) ".on_users_add_clicked()")}]] - [:table {:class "table table-striped table-hover table-sm"} - [:thead - [:tr - [:th {:scope "col"} "Active?"] - [:th {:scope "col"} "Last Name"] - [:th {:scope "col"} "First Name"] - [:th {:scope "col"} "Username"] - [:th {:scope "col"} "Email"] - [:th {:scope "col"} "Phone"] - [:th {:scope "col"} "Del"]]] - [:tbody - (for [user (get jsonobj "users")] - (let [onclick (str (namespace ::x) ".on_users_modify_clicked(" (get user "id") ")") - toggle-active (str (namespace ::x) ".on_users_toggle_active_clicked(" (get user "id") ")")] - [:tr - [:td [:img {:src (cond (get user "active") - "/static/images/yes.png" - :else - "/static/images/no.png") - :onclick toggle-active}]] - [:td {:onclick onclick} (get user "last_name")] - [:td {:onclick onclick} (get user "first_name")] - [:td {:onclick onclick} (get user "username")] - [:td {:onclick onclick} (get user "email")] - [:td {:onclick onclick} (get user "phone")] - [:td [:img {:src "/static/images/delete.png" - :onclick (str (namespace ::x) ".on_users_delete_clicked(" (get user "id") ", '" (get user "first_name") "', '" (get user "last_name") "')")}]]]))]]) - +(defn comp-users-view [] + [:div + [:div {:style {:text-align "right"}} + [:img {:src "/static/images/add.png" + :on-click #(on-users-add-clicked)}]] + [:table {:class "table table-striped table-hover table-sm"} + [:thead + [:tr + [:th {:scope "col"} "Active?"] + [:th {:scope "col"} "Last Name"] + [:th {:scope "col"} "First Name"] + [:th {:scope "col"} "Username"] + [:th {:scope "col"} "Email"] + [:th {:scope "col"} "Phone"] + [:th {:scope "col"} "Mod"] + [:th {:scope "col"} "Del"]]] + [:tbody + (for [user (get @users-view-state "users")] + [:tr + [:td [:img {:src (cond (get user "active") + "/static/images/yes.png" + :else + "/static/images/no.png") + :on-click #(on-users-toggle-active-clicked (get user "id"))}]] + [:td (get user "last_name")] + [:td (get user "first_name")] + [:td (get user "username")] + [:td (get user "email")] + [:td (get user "phone")] + [:td {:width "30"} + [:img {:src "/static/images/edit.png" + :on-click #(on-users-modify-clicked (get user "id"))}]] + [:td {:width "30"} + [:img {:src "/static/images/delete.png" + :on-click #(on-users-delete-clicked (get user "id"))}]]])]]]) + (defn handler-users-view [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#content) (template-users-view jsonobj)))) + (notifications jsonobj) + (reset-users-view-state jsonobj))) (defn render-users-view [] (GET "/users/view" {:handler handler-users-view})) @@ -1188,15 +1321,14 @@ (defn on-users-add-clicked [] (render-users-add)) -(hiccups/defhtml template-users-add [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-users-add [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-add-state "form") (namespace ::x)))}]) (defn handler-users-add [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-users-add jsonobj)) - (.modal (jquery "#modify")))) + (reset-users-add-state jsonobj) + (.modal (jquery "#modal-users-add")))) (defn render-users-add [] (POST "/users/add" {:handler handler-users-add})) @@ -1207,7 +1339,7 @@ (when (-> (jquery "#users-add-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-users-add") "hide") (render-users-add-submit))) (defn handler-users-add-submit [response] @@ -1218,21 +1350,20 @@ (defn render-users-add-submit [] (POST "/users/add/submit" {:format :raw - :params {:role_groups (reduce-checkboxes "[id^='chk_']") - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email))} + :params (merge (form-fields-to-map "#users-add-form :input") + {:role_groups (reduce-checkboxes "[id^='users_add_form-chk_users_add_']")}) :handler handler-users-add-submit})) ;; users-register -(hiccups/defhtml template-users-register [jsonobj] - [:h3 {:style "text-align: center"} (get jsonobj "title")] - [:div {:id "content"}]) +(defn comp-users-register [] + [:div {:style {:display (cond (or (= @location-state "/users/register")) "block" :else "none")}} + [:h3 {:style {:text-align "center"}} (get @users-register-state "title")] + [comp-users-register-form]]) (defn handler-users-register [response] (let [jsonobj (js->clj (js/JSON.parse response))] - (dommy/set-html! (dommy/sel1 :#body) (template-users-register jsonobj)) + (reset-users-register-state jsonobj) (render-users-register-form (get jsonobj "hash")))) (defn render-users-register [hash] @@ -1243,22 +1374,23 @@ ;; users-register-form -(hiccups/defhtml template-users-register-form [jsonobj] - (cond (get jsonobj "errormsg") - [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} - "Click here to return to the home page."] - :else - (do - [:p (str "Welcome " (get jsonobj "firstName") " " (get jsonobj "lastName") " to the new user registration page. Please fill out the form below to complete your registration.")] - [:p "Create a new username and password for your login to the website. Phone number is optional."] - [:p (str "Your email address is recorded as " (get jsonobj "email") ". This is where notifications will be sent. If this is not the desired email address, you can change it later by visiting the Edit Profile page.")] - [:p (str "This registration will expire in " (get jsonobj "validFor") ". Please submit this form before that time.")] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))))) +(defn comp-users-register-form [] + [:div + (cond (get @users-register-form-state "errormsg") + [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} + "Click here to return to the home page."] + :else + (do + [:p (str "Welcome " (get @users-register-form-state "firstName") " " (get @users-register-form-state "lastName") " to the new user registration page. Please fill out the form below to complete your registration.")] + [:p "Create a new username and password for your login to the website. Phone number is optional."] + [:p (str "Your email address is recorded as " (get @users-register-form-state "email") ". This is where notifications will be sent. If this is not the desired email address, you can change it later by visiting the Edit Profile page.")] + [:p (str "This registration will expire in " (get @users-register-form-state "validFor") ". Please submit this form before that time.")] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-register-form-state "form") (namespace ::x)))}]))]) (defn handler-users-register-form [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#content) (template-users-register-form jsonobj)))) + (reset-users-register-form-state jsonobj))) (defn render-users-register-form [hash] (POST "/users/register/form" @@ -1274,28 +1406,15 @@ (.checkValidity)) (render-users-register-submit))) -(hiccups/defhtml template-users-register-submit [jsonobj] - [:a {:href (str "javascript:" (namespace ::x) ".reset_app()")} - "Click here to start using the website!"]) - (defn handler-users-register-submit [response] (let [jsonobj (js->clj (js/JSON.parse response))] (notifications jsonobj) - (cond (get jsonobj "errormsg") - (do - (dommy/set-value! (dommy/sel1 :#pwd) "") - (dommy/set-value! (dommy/sel1 :#pwd2) "")) - :else - (dommy/set-html! (dommy/sel1 :#content) (template-users-register-submit jsonobj))))) + (reset-app))) (defn render-users-register-submit [] (POST "/users/register/submit" {:format :raw - :params {:hash (dommy/value (dommy/sel1 :#hash)) - :username (dommy/value (dommy/sel1 :#username)) - :pwd (dommy/value (dommy/sel1 :#pwd)) - :pwd2 (dommy/value (dommy/sel1 :#pwd2)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (form-fields-to-map "#users-register-form :input") :handler handler-users-register-submit})) ;; users-modify @@ -1303,15 +1422,14 @@ (defn on-users-modify-clicked [id] (render-users-modify id)) -(hiccups/defhtml template-users-modify [jsonobj] - (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) +(defn comp-users-modify [] + [:div {:dangerouslySetInnerHTML (r/unsafe-html (ck-form/template-generic-form (get @users-modify-state "form") (namespace ::x)))}]) (defn handler-users-modify [response] (let [jsonobj (js->clj (js/JSON.parse response))] (auth-notifications jsonobj) - (dommy/set-html! (dommy/sel1 :#modify-title) (get jsonobj "title")) - (dommy/set-html! (dommy/sel1 :#modify-body) (template-users-modify jsonobj)) - (.modal (jquery "#modify")))) + (reset-users-modify-state jsonobj) + (.modal (jquery "#modal-users-modify")))) (defn render-users-modify [id] (POST "/users/modify" @@ -1325,7 +1443,7 @@ (when (-> (jquery "#users-modify-form") (.get "0") (.checkValidity)) - (.modal (jquery "#modify") "hide") + (.modal (jquery "#modal-users-modify") "hide") (render-users-modify-submit))) (defn handler-users-modify-submit [response] @@ -1336,13 +1454,8 @@ (defn render-users-modify-submit [] (POST "/users/modify/submit" {:format :raw - :params {:id (dommy/value (dommy/sel1 :#id)) - :role_groups (reduce-checkboxes "[id^='chk_']") - :username (dommy/value (dommy/sel1 :#username)) - :first_name (dommy/value (dommy/sel1 :#first_name)) - :last_name (dommy/value (dommy/sel1 :#last_name)) - :email (dommy/value (dommy/sel1 :#email)) - :phone (dommy/value (dommy/sel1 :#phone))} + :params (merge (form-fields-to-map "#users-modify-form :input") + {:role_groups (reduce-checkboxes "[id^='users_modify_form-chk_users_modify_']")}) :handler handler-users-modify-submit})) ;; users-toggle-active @@ -1363,8 +1476,8 @@ ;; users-delete -(defn on-users-delete-clicked [id first-name last-name] - (when (js/confirm (str "Are you sure you want to delete " first-name " " last-name "? This action cannot be undone.")) +(defn on-users-delete-clicked [id] + (when (js/confirm (str "Are you sure you want to delete " id "? This action cannot be undone.")) (render-users-delete id))) (defn handler-users-delete [response] @@ -1379,22 +1492,26 @@ ;; location +(push-menu-hook {:handler "/home" :func #(render-home)}) +(push-menu-hook {:handler "/login" :func #(render-login)}) +(push-menu-hook {:handler "/logout" :func #(render-logout)}) +(push-menu-hook {:handler "/profile" :func #(render-profile)}) +(push-menu-hook {:handler "/password" :func #(render-password)}) +(push-menu-hook {:handler "/lessons" :func #(render-lessons)}) +(push-menu-hook {:handler "/gigs" :func #(render-gigs)}) +(push-menu-hook {:handler "/programming" :func #(render-programming)}) +(push-menu-hook {:handler "/gallery" :func #(render-gallery)}) +(push-menu-hook {:handler "/contact-us" :func #(render-contact-us)}) +(push-menu-hook {:handler "/messages" :func #(render-messages)}) +(push-menu-hook {:handler "/users" :func #(render-users)}) +(push-menu-hook {:handler "/users/register" :func #(render-users)}) + (defn on-menu-clicked [handler] (reset-location handler) (render-menu) - (cond (= handler "/home") (render-home) - (= handler "/login") (render-login) - (= handler "/logout") (render-logout) - (= handler "/profile") (render-profile) - (= handler "/password") (render-password) - (= handler "/lessons") (render-lessons) - (= handler "/gigs") (render-gigs) - (= handler "/programming") (render-programming) - (= handler "/gallery") (render-gallery) - (= handler "/testimonials") (render-testimonials) - (= handler "/contact-us") (render-contact-us) - (= handler "/messages") (render-messages) - (= handler "/users") (render-users))) + (let [hook (get @menu-hooks handler)] + (when hook + (apply (get hook :func) '())))) (defn handler-location [response] (let [jsonobj (js->clj (js/JSON.parse response))] @@ -1414,3 +1531,57 @@ (reset-location "/users/register") (render-menu) (render-users-register hash)) + +;; body + +(defn comp-app [] + [:div {:class "container-fluid"} + [:div {:class "banner"} + [:table {:width "100%" :height "100%"} + [:tbody + [:tr + [:td {:class "banner-menu"} + [comp-menu-user]] + [:td {:class "banner-title"} "Bogen-" [:i "Herr"]] + [:td {:class "banner-menu"} " "]]]]] + [comp-menu-main] + [ck-notifications/comp-errormsg] + [ck-notifications/comp-message] + [comp-home] + [comp-login] + [comp-about-us] + [comp-profile] + [comp-password] + [comp-gallery] + [comp-contact-us] + [comp-messages] + [comp-users] + [comp-users-register] + [:div {:id "footer"} + [:hr] + "Carlos Konstanski (970) 294-9708" + [:br] + [:a {:href "https://git.ckons.org/bogenherr.git/tree" + :target "_blank"} + "Source code in Git"]]]) + +;; start the react app + +(defn start-render [] + (let [app-root (rdc/create-root (js/document.getElementById "app"))] + (rdc/render app-root [comp-app]))) + +(defn start-location [] + (cond (str/starts-with? @location-state "/register/") + (goto-register (str/replace-first @location-state "/register/" "")) + :else + (goto-location @location-state))) + +(defn ^:dev/after-load start + ([] + (start-render) + (start-location)) + ([url] + (reset-location url) + (start-render) + (start-location))) diff --git a/lisp/webapps/bogenherr/site.lisp b/lisp/webapps/bogenherr/site.lisp deleted file mode 100644 index b47b9d4..0000000 --- a/lisp/webapps/bogenherr/site.lisp +++ /dev/null @@ -1,254 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defmacro .base (&optional (start-url "/home")) - `(org-ckons-http::html5 - `(html - (head - ((meta :name "viewport" :content "width=device-width, initial-scale=1, shrink-to-fit=no")) - ((meta :charset "utf-8")) - ((title) ,(title *webapp*)) - ,@(mapcar (lambda (css) - `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin)))) - '((:href "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/css/bootstrap.min.css" :integrity "sha384-xOolHFLEh07PJGoPkLv1IbcEPTNtaed2xpHsD9ESMhqIYd0nLMwNLD69Npy4HI+N" :crossorigin "anonymous") - (:href "/static/css/stylesheet.css" :crossorigin "anonymous"))) - ,@(mapcar (lambda (js) - `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) - '((:src "https://code.jquery.com/jquery-3.7.1.slim.min.js" :integrity "sha256-kmHvs0B+OpCW5GVHUNjv9rOmY0IvSIRcf7zGUDTDQM8=" :crossorigin "anonymous"))) - ((script :type "text/javascript" :src "/cljs-out/dev-main.js"))) - ((body :onload ,(format nil "bogenherr.core.start(~a)" ,(if start-url - (format nil "'~a'" start-url) - "null"))) - ((div :id "app")) - ,@(mapcar (lambda (js) - `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin)))) - '((:src "https://cdn.jsdelivr.net/npm/bootstrap@4.6.2/dist/js/bootstrap.bundle.min.js" :integrity "sha384-Fy6S3B9q64WdZWQUiU+q4/2Lc9npb8tCaSX9FK7E8HnRr0Jz8D6OP9dO5Vg3Q9ct" :crossorigin "anonymous"))))))) - -(defmacro .location () - `(location-json location)) - -(defmacro .home-get () - `(home-json)) - -(defmacro .home-post () - `(home-json message errormsg)) - -(defmacro .menu () - `(menu-json)) - -(defmacro .menu-user () - `(menu-user-json)) - -(defmacro .login () - `(login-json)) - -(defmacro .login-authenticate () - `(login-authenticate-json username pwd)) - -(defmacro .login-forgot () - `(login-forgot-json)) - -(defmacro .logout () - `(logout-json)) - -(defmacro .profile () - `(profile-json)) - -(defmacro .profile-view () - `(profile-view-json)) - -(defmacro .profile-modify () - `(profile-modify-json)) - -(defmacro .profile-modify-submit () - `(profile-modify-submit-json id username first_name last_name email phone)) - -(defmacro .password () - `(password-json)) - -(defmacro .password-submit () - `(password-submit-json id pwd pwd2)) - -(defmacro .lessons () - `(about-us-json "lessons")) - -(defmacro .lessons-view () - `(about-us-view-json "lessons")) - -(defmacro .lessons-modify () - `(about-us-modify-json "lessons")) - -(defmacro .lessons-modify-submit () - `(about-us-modify-submit-json "lessons" content)) - -(defmacro .gigs () - `(about-us-json "gigs")) - -(defmacro .gigs-view () - `(about-us-view-json "gigs")) - -(defmacro .gigs-modify () - `(about-us-modify-json "gigs")) - -(defmacro .gigs-modify-submit () - `(about-us-modify-submit-json "gigs" content)) - -(defmacro .programming () - `(about-us-json "programming")) - -(defmacro .programming-view () - `(about-us-view-json "programming")) - -(defmacro .programming-modify () - `(about-us-modify-json "programming")) - -(defmacro .programming-modify-submit () - `(about-us-modify-submit-json "programming" content)) - -(defmacro .gallery () - `(gallery-json)) - -(defmacro .gallery-view () - `(gallery-view-json)) - -(defmacro .gallery-add () - `(gallery-add-json)) - -(defmacro .gallery-add-submit () - `(gallery-add-submit-json description video_embed_url upload)) - -(defmacro .gallery-modify () - `(gallery-modify-json id)) - -(defmacro .gallery-modify-submit () - `(gallery-modify-submit-json id description video_embed_url upload)) - -(defmacro .gallery-delete () - `(gallery-delete-json id)) - -(defmacro .gallery-file-view () - `(gallery-file-view id)) - -(defmacro .testimonials () - `(testimonials-json)) - -(defmacro .testimonials-view () - `(testimonials-view-json)) - -(defmacro .testimonials-modify () - `(testimonials-modify-json)) - -(defmacro .testimonials-modify-submit () - `(testimonials-modify-submit-json content)) - -(defmacro .contact-us () - `(contact-us-json)) - -(defmacro .contact-us-view () - `(contact-us-view-json)) - -(defmacro .contact-us-email () - `(contact-us-email-json first_name last_name email phone comments)) - -(defmacro .messages () - `(messages-json)) - -(defmacro .messages-results () - `(messages-results-json read)) - -(defmacro .messages-mark () - `(messages-mark-json read id)) - -(defmacro .users () - `(users-json)) - -(defmacro .users-view () - `(users-view-json)) - -(defmacro .users-add () - `(users-add-json)) - -(defmacro .users-add-submit () - `(users-add-submit-json role_groups first_name last_name email)) - -(defmacro .users-register () - `(users-register-json hash)) - -(defmacro .users-register-form () - `(users-register-form-json hash)) - -(defmacro .users-register-submit () - `(users-register-submit-json hash username pwd pwd2 phone)) - -(defmacro .users-modify () - `(users-modify-json id)) - -(defmacro .users-modify-submit () - `(users-modify-submit-json id role_groups username first_name last_name email phone)) - -(defmacro .users-toggle-active () - `(users-toggle-active-json id)) - -(defmacro .users-delete () - `(users-delete-json id)) - -(define-endpoint ("/" :method :get) () .base) -(define-endpoint ("/location" :method :post) (&post (location :parameter-type 'string)) .location) -(define-endpoint ("/home" :method :get) () .home-get) -(define-endpoint ("/home" :method :post) (&post (message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post) -(define-endpoint ("/menu" :method :get) () .menu) -(define-endpoint ("/menu/user" :method :get) () .menu-user) -(define-endpoint ("/login" :method :get) () .login) -(define-endpoint ("/login/authenticate" :method :post) (&post (username :parameter-type 'string) (pwd :parameter-type 'string)) .login-authenticate) -(define-endpoint ("/login/forgot" :method :get) () .login-forgot) -(define-endpoint ("/logout" :method :get) () .logout) -(define-endpoint ("/profile" :method :get) () .profile) -(define-endpoint ("/profile/view" :method :get) () .profile-view) -(define-endpoint ("/profile/modify" :method :post) () .profile-modify) -(define-endpoint ("/profile/modify/submit" :method :post) (&post (id :parameter-type 'integer) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .profile-modify-submit) -(define-endpoint ("/password" :method :get) () .password) -(define-endpoint ("/password/submit" :method :post) (&post (id :parameter-type 'integer) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string)) .password-submit) -(define-endpoint ("/lessons" :method :get) () .lessons) -(define-endpoint ("/lessons/view" :method :get) () .lessons-view) -(define-endpoint ("/lessons/modify" :method :post) () .lessons-modify) -(define-endpoint ("/lessons/modify/submit" :method :post) (&post (content :parameter-type 'string)) .lessons-modify-submit) -(define-endpoint ("/gigs" :method :get) () .gigs) -(define-endpoint ("/gigs/view" :method :get) () .gigs-view) -(define-endpoint ("/gigs/modify" :method :post) () .gigs-modify) -(define-endpoint ("/gigs/modify/submit" :method :post) (&post (content :parameter-type 'string)) .gigs-modify-submit) -(define-endpoint ("/programming" :method :get) () .programming) -(define-endpoint ("/programming/view" :method :get) () .programming-view) -(define-endpoint ("/programming/modify" :method :post) () .programming-modify) -(define-endpoint ("/programming/modify/submit" :method :post) (&post (content :parameter-type 'string)) .programming-modify-submit) -(define-endpoint ("/gallery" :method :get) () .gallery) -(define-endpoint ("/gallery/view" :method :get) () .gallery-view) -(define-endpoint ("/gallery/add" :method :post) () .gallery-add) -(define-endpoint ("/gallery/add/submit" :method :post) (&post (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-add-submit) -(define-endpoint ("/gallery/modify" :method :post) (&post (id :parameter-type 'integer)) .gallery-modify) -(define-endpoint ("/gallery/modify/submit" :method :post) (&post (id :parameter-type 'integer) (description :parameter-type 'string) (video_embed_url :parameter-type 'string) (upload :parameter-type 'string)) .gallery-modify-submit) -(define-endpoint ("/gallery/delete/:id" :method :delete) (&path (id 'integer)) .gallery-delete) -(define-endpoint ("/gallery/file/view/:id" :method :get) (&path (id 'integer)) .gallery-file-view) -(define-endpoint ("/testimonials" :method :get) () .testimonials) -(define-endpoint ("/testimonials/view" :method :get) () .testimonials-view) -(define-endpoint ("/testimonials/modify" :method :post) () .testimonials-modify) -(define-endpoint ("/testimonials/modify/submit" :method :post) (&post (content :parameter-type 'string)) .testimonials-modify-submit) -(define-endpoint ("/contact-us" :method :get) () .contact-us) -(define-endpoint ("/contact-us/view" :method :get) () .contact-us-view) -(define-endpoint ("/contact-us/email" :method :post) (&post (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string) (comments :parameter-type 'string)) .contact-us-email) -(define-endpoint ("/messages" :method :get) () .messages) -(define-endpoint ("/messages/results" :method :post) (&post (read :parameter-type 'string)) .messages-results) -(define-endpoint ("/messages/mark" :method :post) (&post (read :parameter-type 'string) (id :parameter-type 'integer)) .messages-mark) -(define-endpoint ("/users" :method :get) () .users) -(define-endpoint ("/users/view" :method :get) () .users-view) -(define-endpoint ("/users/add" :method :post) () .users-add) -(define-endpoint ("/users/add/submit" :method :post) (&post (role_groups :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string)) .users-add-submit) -(define-endpoint ("/register/:hash" :method :get) (&path (hash 'string)) .base (format nil "/register/~a" hash)) -(define-endpoint ("/users/register" :method :post) (&post (hash :parameter-type 'string)) .users-register) -(define-endpoint ("/users/register/form" :method :post) (&post (hash :parameter-type 'string)) .users-register-form) -(define-endpoint ("/users/register/submit" :method :post) (&post (hash :parameter-type 'string) (username :parameter-type 'string) (pwd :parameter-type 'string) (pwd2 :parameter-type 'string) (phone :parameter-type 'string)) .users-register-submit) -(define-endpoint ("/users/modify" :method :post) (&post (id :parameter-type 'integer)) .users-modify) -(define-endpoint ("/users/modify/submit" :method :post) (&post (id :parameter-type 'integer) (role_groups :parameter-type 'string) (username :parameter-type 'string) (first_name :parameter-type 'string) (last_name :parameter-type 'string) (email :parameter-type 'string) (phone :parameter-type 'string)) .users-modify-submit) -(define-endpoint ("/users/toggle-active" :method :post) (&post (id :parameter-type 'integer)) .users-toggle-active) -(define-endpoint ("/users/delete/:id" :method :delete) (&path (id 'integer)) .users-delete) diff --git a/lisp/webapps/bogenherr/static/css/stylesheet.css b/lisp/webapps/bogenherr/static/css/stylesheet.css index 659aa54..be74c95 100644 --- a/lisp/webapps/bogenherr/static/css/stylesheet.css +++ b/lisp/webapps/bogenherr/static/css/stylesheet.css @@ -9,6 +9,10 @@ hr { width: 200px; } +tr.selected { + background-color: lightblue; +} + a { color: #ffd081; } diff --git a/lisp/webapps/generics.lisp b/lisp/webapps/generics.lisp deleted file mode 100644 index c986e5b..0000000 --- a/lisp/webapps/generics.lisp +++ /dev/null @@ -1,12 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defgeneric get-site-file-path (webapp) - (:documentation "Builds a full filesystem path to a webapp's site -file.")) - -(defgeneric get-pages-file-paths (webapp) - (:documentation "")) - diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp deleted file mode 100644 index e18f661..0000000 --- a/lisp/webapps/webapp-loader.lisp +++ /dev/null @@ -1,177 +0,0 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(declaim (optimize (speed 0) (safety 3) (debug 3))) - -(in-package :bogenherr) - -(defvar *acceptor* nil) -(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher)) -(defvar *webapps* (make-hash-table :test 'equal)) -(defvar *webapp* nil) -(defvar *uri* nil) -(defvar *header-register* nil) -(defvar *sessionid* nil) -(defparameter *port* 3012) -(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./")) - "The location of the web server root on the filesystem.") - -(defclass webapp () - ((name :initarg :name - :initform nil - :accessor name - :documentation "The name of the webapp as used in the code. A -string used as the key to any webapp config lookup.") - (scheme :initarg :scheme - :initform nil - :accessor scheme) - (url :initarg :url - :initform nil - :accessor url - :documentation "The domain portion of the URL to the -root of the webapp.") - (document-root :initarg :document-root - :initform nil - :accessor document-root - :documentation "The absolute filesystem path to the -webapp's top-level directory which is inside the webapps folder.") - (title :initarg :title - :initform nil - :accessor title - :documentation "The default title that shows up in -the browser title bar.") - (meta-description :initarg :meta-description - :initform nil - :accessor meta-description - :documentation "The text that goes into the META DESCRIPTION -tag, and anywhere else we want to put this text so that it will show -up in Google.") - (databases :initarg :databases - :initform nil - :accessor databases) - (mail-mx :initarg :mail-mx - :initform nil - :accessor mail-mx) - (mail-from :initarg :mail-from - :initform nil - :accessor mail-from) - (mail-postmaster :initarg :mail-postmaster - :initform nil - :accessor mail-postmaster) - (mail-webmaster :initarg :mail-webmaster - :initform nil - :accessor mail-webmaster) - (mail-info :initarg :mail-info - :initform nil - :accessor mail-info) - (mail-login-notify :initarg :mail-login-notify - :initform nil - :accessor mail-login-notify) - (mail-authentication :initarg :mail-authentication - :initform nil - :accessor mail-authentication) - (mail-ssl :initarg :mail-ssl - :initform nil - :accessor mail-ssl)) - (:documentation "")) - -(defmethod get-site-file-path ((webapp webapp)) - (format nil "~a/site" (document-root webapp))) - -(defmethod get-pages-file-paths ((webapp webapp)) - (mapcar (lambda (pages-file) - (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) "")) - (remove-if (lambda (x) (equal x "shared")) - (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp)))))) - -(defun make-server-path (relative-path) - "Makes a relative filesystem path into a full one, using -`*server-root*' as the base." - (make-document-root-path *server-root* relative-path)) - -(defun make-document-root-path (document-root relative-path) - "Makes a relative filesystem path into a full one, using -`document-root' as the base." - (concatenate 'string document-root relative-path)) - -(defun make-webapp-path (relative-path) - "Makes an absolute filesystem path to a location in the webapps -folder." - (concatenate 'string *server-root* "webapps/" relative-path)) - -(defun get-options-files () - (mapcar (lambda (webapp-directory) - (format nil "~a/conf/options.lisp" webapp-directory)) - (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x) - (org-ckons-core::match-it "webapps/shared$" x) - (org-ckons-core::match-it "webapps/CVS$" x) - (org-ckons-core::match-it "webapps/\\.$" x) - (org-ckons-core::match-it "webapps/\\.\\.$" x))) - (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path "")))))) - -(defun set-webapp (webapp) - "Sets a `webapp' object in `*webapps*'. The lookup key is the webapp -name. If a webapp already exists under this key, it gets overwritten -with the new one." - (setf (gethash (name webapp) *webapps*) webapp)) - -(defun get-webapp (key) - "Gets the webapp object stored under the key `key'." - (gethash key *webapps*)) - -(defun populate-webapps () - (loop for options-file in (get-options-files) - do (with-open-file (input options-file :direction :input) - (let* ((form (read input))) - (set-webapp (make-instance 'webapp - :name (getf form :name) - :scheme (getf form :scheme) - :url (getf form :url) - :document-root (make-webapp-path (getf form :document-root)) - :title (getf form :title) - :meta-description (getf form :meta-description) - :databases (getf form :databases) - :mail-mx (getf form :mail-mx) - :mail-from (getf form :mail-from) - :mail-postmaster (getf form :mail-postmaster) - :mail-webmaster (getf form :mail-webmaster) - :mail-info (getf form :mail-info) - :mail-login-notify (getf form :mail-login-notify) - :mail-authentication (getf form :mail-authentication) - :mail-ssl (getf form :mail-ssl))))))) - -(defun bogenherr () - "Call this to start the server." - (when (null *acceptor*) - (let ((package (string-downcase (package-name #.*package*)))) - (populate-webapps) - (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) - (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package)) - (setf *session-secret* (org-ckons-session::generate-sessionid)) - (populate-webapps) - (setf *acceptor* (start (make-instance 'easy-routes:easy-routes-acceptor - :port *port* - :document-root (make-server-path (format nil "webapps/~a/" package)) - :name (format nil "~a-acceptor" package))))))) - -(defmacro with-request-wrapper (uri page-function &rest args) - (let ((package (string-downcase (package-name #.*package*)))) - `(let (output) - (let* ((*webapp* (get-webapp ,package)) - (*uri* ,uri) - (*header-register* (make-instance 'org-ckons-session::header-register)) - (*sessionid* (ensure-user-session-exists))) - (ensure-user-exists) - (setf output (,page-function ,@args)) - (org-ckons-session::ship-headers *header-register*)) - output))) - -(defmacro define-endpoint (template-and-options var-list page-function &rest args) - "Does the grunt work of creating an `easy-routes' route for each page -you wish to publish." - (let ((name (gensym)) - (uri (first template-and-options)) - (method (getf (rest template-and-options) :method))) - `(progn - (org-ckons-core::logger (format nil "Publishing page. URL = [~a], method = [~a]" ,uri ,method)) - (easy-routes:defroute ,name ,template-and-options - ,var-list - (with-request-wrapper ,uri ,page-function ,@args))))) |
