From 08e435104c42751689553537b1f20ffb14b8dfcc Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Sat, 18 Jul 2026 21:18:18 -0600 Subject: initial commit --- lisp/webapps/generics.lisp | 12 + lisp/webapps/resume/cljs-out | 1 + .../webapps/resume/clojurescript/resume/.gitignore | 16 + .../resume/clojurescript/resume/dev.cljs.edn | 2 + .../resume/clojurescript/resume/project.clj | 24 + .../resume/clojurescript/resume/src/core.cljs | 1073 ++++++++++++++++++++ lisp/webapps/resume/conf/.gitignore | 1 + lisp/webapps/resume/conf/options.lisp.example | 13 + lisp/webapps/resume/site.lisp | 206 ++++ lisp/webapps/resume/static/css/stylesheet.css | 117 +++ lisp/webapps/resume/static/images/add.png | Bin 0 -> 1832 bytes .../webapps/resume/static/images/classical-bow.jpg | Bin 0 -> 158141 bytes lisp/webapps/resume/static/images/delete.png | Bin 0 -> 1427 bytes .../webapps/resume/static/images/document-open.png | Bin 0 -> 608 bytes lisp/webapps/resume/static/images/down.png | Bin 0 -> 1297 bytes lisp/webapps/resume/static/images/download.png | Bin 0 -> 577 bytes lisp/webapps/resume/static/images/edit-redo.png | Bin 0 -> 1584 bytes lisp/webapps/resume/static/images/edit-undo.png | Bin 0 -> 1585 bytes lisp/webapps/resume/static/images/edit.png | Bin 0 -> 1034 bytes .../resume/static/images/emblem-favorite.png | Bin 0 -> 1523 bytes .../resume/static/images/emblem-nowrite.png | Bin 0 -> 1032 bytes .../resume/static/images/instrument-cabinet.jpg | Bin 0 -> 7636700 bytes lisp/webapps/resume/static/images/no.png | Bin 0 -> 1089 bytes lisp/webapps/resume/static/images/sort-alpha.png | Bin 0 -> 625 bytes lisp/webapps/resume/static/images/up.png | Bin 0 -> 1315 bytes lisp/webapps/resume/static/images/violin-strip.jpg | Bin 0 -> 198050 bytes lisp/webapps/resume/static/images/yes.png | Bin 0 -> 1013 bytes lisp/webapps/webapp-loader.lisp | 177 ++++ 28 files changed, 1642 insertions(+) create mode 100644 lisp/webapps/generics.lisp create mode 120000 lisp/webapps/resume/cljs-out create mode 100644 lisp/webapps/resume/clojurescript/resume/.gitignore create mode 100644 lisp/webapps/resume/clojurescript/resume/dev.cljs.edn create mode 100644 lisp/webapps/resume/clojurescript/resume/project.clj create mode 100644 lisp/webapps/resume/clojurescript/resume/src/core.cljs create mode 100644 lisp/webapps/resume/conf/.gitignore create mode 100644 lisp/webapps/resume/conf/options.lisp.example create mode 100644 lisp/webapps/resume/site.lisp create mode 100644 lisp/webapps/resume/static/css/stylesheet.css create mode 100644 lisp/webapps/resume/static/images/add.png create mode 100644 lisp/webapps/resume/static/images/classical-bow.jpg create mode 100644 lisp/webapps/resume/static/images/delete.png create mode 100644 lisp/webapps/resume/static/images/document-open.png create mode 100644 lisp/webapps/resume/static/images/down.png create mode 100644 lisp/webapps/resume/static/images/download.png create mode 100644 lisp/webapps/resume/static/images/edit-redo.png create mode 100644 lisp/webapps/resume/static/images/edit-undo.png create mode 100644 lisp/webapps/resume/static/images/edit.png create mode 100644 lisp/webapps/resume/static/images/emblem-favorite.png create mode 100644 lisp/webapps/resume/static/images/emblem-nowrite.png create mode 100644 lisp/webapps/resume/static/images/instrument-cabinet.jpg create mode 100644 lisp/webapps/resume/static/images/no.png create mode 100644 lisp/webapps/resume/static/images/sort-alpha.png create mode 100644 lisp/webapps/resume/static/images/up.png create mode 100644 lisp/webapps/resume/static/images/violin-strip.jpg create mode 100644 lisp/webapps/resume/static/images/yes.png create mode 100644 lisp/webapps/webapp-loader.lisp (limited to 'lisp/webapps') diff --git a/lisp/webapps/generics.lisp b/lisp/webapps/generics.lisp new file mode 100644 index 0000000..33145ba --- /dev/null +++ b/lisp/webapps/generics.lisp @@ -0,0 +1,12 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :resume) + +(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/resume/cljs-out b/lisp/webapps/resume/cljs-out new file mode 120000 index 0000000..7f17999 --- /dev/null +++ b/lisp/webapps/resume/cljs-out @@ -0,0 +1 @@ +clojurescript/resume/resources/public/cljs-out \ No newline at end of file diff --git a/lisp/webapps/resume/clojurescript/resume/.gitignore b/lisp/webapps/resume/clojurescript/resume/.gitignore new file mode 100644 index 0000000..77c3a20 --- /dev/null +++ b/lisp/webapps/resume/clojurescript/resume/.gitignore @@ -0,0 +1,16 @@ +target +classes +resources +checkouts +pom.xml +pom.xml.asc +*.jar +*.class +.lein-* +.nrepl-port +.rebel_readline_history +.hgignore +.hg +figwheel-main.edn +figwheel_server.log +.rebel_readline_history diff --git a/lisp/webapps/resume/clojurescript/resume/dev.cljs.edn b/lisp/webapps/resume/clojurescript/resume/dev.cljs.edn new file mode 100644 index 0000000..b2a7ff0 --- /dev/null +++ b/lisp/webapps/resume/clojurescript/resume/dev.cljs.edn @@ -0,0 +1,2 @@ +^{:watch-dirs ["src"]} +{:main resume.core} diff --git a/lisp/webapps/resume/clojurescript/resume/project.clj b/lisp/webapps/resume/clojurescript/resume/project.clj new file mode 100644 index 0000000..a19d784 --- /dev/null +++ b/lisp/webapps/resume/clojurescript/resume/project.clj @@ -0,0 +1,24 @@ +(defproject resume.core "0.1.0-SNAPSHOT" + :description "FIXME" + :url "FIXME" + :license "public domain" + :min-lein-version "2.7.1" + :dependencies [[org.clojure/clojure "LATEST"] + [org.clojure/clojurescript "LATEST"] + [cljs-ajax "LATEST"] + [prismatic/dommy "LATEST"] + [hiccups "LATEST"] + [cljsjs/showdown "LATEST"] + [com.andrewmcveigh/cljs-time "LATEST"] + [cljsjs/react "LATEST"] + [cljsjs/react-dom "LATEST"] + [cljsjs/react-dom-server "LATEST"] + [reagent "LATEST"]] + :source-paths ["src"] + :aliases {"fig:build" ["trampoline" "run" "-m" "figwheel.main" "-b" "dev" "-r"] + "fig:min" ["run" "-m" "figwheel.main" "-O" "advanced" "-bo" "dev"]} + :profiles {:dev {:dependencies [[com.bhauman/figwheel-main "LATEST"] + [org.slf4j/slf4j-nop "LATEST"] + [com.bhauman/rebel-readline-cljs "LATEST"]] + :resource-paths ["target"] + :clean-targets ^{:protect false} ["target"]}}) diff --git a/lisp/webapps/resume/clojurescript/resume/src/core.cljs b/lisp/webapps/resume/clojurescript/resume/src/core.cljs new file mode 100644 index 0000000..7010a88 --- /dev/null +++ b/lisp/webapps/resume/clojurescript/resume/src/core.cljs @@ -0,0 +1,1073 @@ +(ns resume.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] + [reagent.core :as r] + [reagent.dom :as rd] + [reagent.dom.client :as rdc] + [org-ckons-cljs.notifications.react :as ck-notifications] + [org-ckons-cljs.form.core :as ck-form])) + +;; declarations + +(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 notifications) +(declare auth-notifications) +(declare comp-menu-main) +(declare comp-menu-user) +(declare handler-menu) +(declare handler-menu-user) +(declare render-menu) +(declare comp-home) +(declare handler-home) +(declare render-home) +(declare template-login) +(declare handler-login) +(declare render-login) +(declare on-login-submit-clicked) +(declare handler-login-authenticate) +(declare render-login-authenticate) +(declare handler-logout) +(declare render-logout) +(declare template-profile) +(declare handler-profile) +(declare render-profile) +(declare template-profile-view) +(declare handler-profile-view) +(declare render-profile-view) +(declare on-profile-modify-clicked) +(declare template-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 handler-password) +(declare render-password) +(declare on-password-submit-clicked) +(declare handler-password-submit) +(declare render-password-submit) +(declare template-about-us) +(declare handler-about-us) +(declare render-lessons) +(declare template-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 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 template-contact-us) +(declare handler-contact-us) +(declare render-contact-us) +(declare template-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 handler-messages) +(declare render-messages) +(declare on-messages-mode-clicked) +(declare template-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 handler-users) +(declare render-users) +(declare template-users-view) +(declare handler-users-view) +(declare render-users-view) +(declare on-users-add-clicked) +(declare template-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 handler-users-register) +(declare render-users-register) +(declare template-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 handler-users-modify) +(declare render-users-modify) +(declare on-users-modify-submit-clicked) +(declare handler-users-modify-submit) +(declare render-users-modify-submit) +(declare on-users-toggle-active-clicked) +(declare handler-users-toggle-active) +(declare render-users-toggle-active) +(declare on-users-delete-clicked) +(declare handler-users-delete) +(declare render-users-delete) +(declare on-menu-clicked) +(declare handler-location) +(declare goto-location) +(declare goto-register) +(declare reset-app) +(declare reset-about-us-category) + +(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)) + +;; helper functions + +(defn date-sql-to-pretty [sql-date] + (first (str/split (time-format/unparse pretty-formatter (time-format/parse sql-formatter (first (str/split sql-date ".")))) " Z"))) + +(defn markdown-to-html [markdown] + (let [converter (js/showdown.Converter.)] + (.makeHtml converter markdown))) + +(defn reduce-checkboxes [selector] + "Reduces the names of all checked checkboxes to a pipe-separated + list. Assumes that the checkboxes are named via the convention + `chk_something-more'. The important thing is the underscore + 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 + :else "")) + (map (fn [elem] + (let [this (jquery (str "#" (dommy/attr elem :id)))] + (when (-> this (.prop "checked")) + (second (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://github.com/ckonstanski/resume/tree/master" + :target "_blank"} + "Source code on GitHub"]]]) + +;; 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))) + +;; notifications + +(defn notifications [jsonobj] + (ck-notifications/reset-message (get jsonobj "message")) + (ck-notifications/reset-errormsg (get jsonobj "errormsg"))) + +(defn auth-notifications [jsonobj] + (cond (empty? (get jsonobj "errormsg")) + (notifications jsonobj) + :else + (do + (render-home "" (get jsonobj "errormsg")) + (render-menu)))) + +;; menu + +(defn comp-menu-main [] + [:div {:class "well"} + [:ul {:class "nav nav-pills"} + (for [menuitem @menu-main-state] + [:li {:key (str "li_" (get menuitem "id")) + :class "nav-item"} + [:a {:class (cond (= (str/upper-case (get menuitem "handler")) + (str/upper-case @location-state)) + "nav-link active" + :else + "nav-link") + :key (get menuitem "id") + :on-click #(on-menu-clicked (get menuitem "handler"))} + (get menuitem "label")]])]]) + +(defn comp-menu-user [] + [:div {:class "dropdown"} + [:button {:class "btn btn-primary dropdown-toggle" + :type "button" + :id "button-menu-user" + :data-toggle "dropdown" + :aria-haspopup "true" + :aria-expanded "false"} + @menu-user-label] + [:div {:class "dropdown-menu" :aria-labelledby "button-menu-user"} + (for [menuitem @menu-user-state] + [:a {:key (get menuitem "id") + :class "dropdown-item" + :on-click #(on-menu-clicked (get menuitem "handler"))} + (get menuitem "label")])]]) + +(defn handler-menu [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (reset! menu-main-state (get jsonobj "menuitems")))) + +(defn handler-menu-user [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (reset! menu-user-state (get jsonobj "menuitems")) + (reset! menu-user-label (get jsonobj "label")))) + +(defn render-menu [] + (GET "/menu" {:handler handler-menu}) + (GET "/menu/user" {:handler handler-menu-user})) + +;; home + +(hiccups/defhtml template-home [jsonobj] + [:div + [: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%" + :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)))) + +(defn render-home + ([] + (GET "/home" {:handler handler-home})) + ([message errormsg] + (POST "/home" + {:format :raw + :params {:message message + :errormsg errormsg} + :handler handler-home}))) + +;; 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 handler-login [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj)))) + +(defn render-login [] + (GET "/login" {:handler handler-login})) + +;; login-authenticate + +(defn on-login-submit-clicked [] + (when (-> (jquery "#login-form") + (.get "0") + (.checkValidity)) + (render-login-authenticate))) + +(defn handler-login-authenticate [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (cond (get jsonobj "errormsg") + (goto-location "/login") + (get jsonobj "message") + (do + (reset-location "/home") + (render-home) + (render-menu))))) + +(defn render-login-authenticate [] + (POST "/login/authenticate" + {:format :raw + :params {:username (dommy/value (dommy/sel1 :#username)) + :pwd (dommy/value (dommy/sel1 :#pwd))} + :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))) + +(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 handler-profile [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-profile jsonobj)) + (render-profile-view))) + +(defn render-profile [] + (GET "/profile" {:handler handler-profile})) + +;; 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 handler-profile-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#content) (template-profile-view jsonobj)))) + +(defn render-profile-view [] + (GET "/profile/view" {:handler handler-profile-view})) + +;; profile-modify + +(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 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")))) + +(defn render-profile-modify [] + (POST "/profile/modify" {:handler handler-profile-modify})) + +;; profile-modify-submit + +(defn on-profile-modify-submit-clicked [] + (when (-> (jquery "#profile-modify-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "hide") + (render-profile-modify-submit))) + +(defn handler-profile-modify-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/profile"))) + +(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))} + :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 handler-password [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-password jsonobj)))) + +(defn render-password [] + (GET "/password" {:handler handler-password})) + +;; password-submit + +(defn on-password-submit-clicked [] + (when (-> (jquery "#password-form") + (.get "0") + (.checkValidity)) + (render-password-submit))) + +(defn handler-password-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/password"))) + +(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))} + :handler handler-password-submit})) + +;; about-us (lessons, gigs, programming) + +(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 handler-about-us [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (reset-about-us-category (get jsonobj "category")) + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-about-us jsonobj)) + (render-about-us-view))) + +(defn render-lessons [] + (GET "/lessons" {:handler handler-about-us})) + +(defn render-gigs [] + (GET "/gigs" {:handler handler-about-us})) + +(defn render-programming [] + (GET "/programming" {:handler handler-about-us})) + +;; 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 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"))))) + +(defn render-about-us-view [] + (GET (str "/" @about-us-category-state "/view") + {:handler handler-about-us-view})) + +;; about-us-modify + +(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 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")))) + +(defn render-about-us-modify [] + (POST (str "/" @about-us-category-state "/modify") + {:handler handler-about-us-modify})) + +;; about-us-modify-submit + +(defn on-about-us-modify-submit-clicked [] + (when (-> (jquery "#about-us-modify-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "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"))))) + +(defn render-about-us-modify-submit [] + (POST (str "/" @about-us-category-state "/modify/submit") + {:format :raw + :params {:content (dommy/value (dommy/sel1 :#txt-content))} + :handler handler-about-us-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 handler-contact-us [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-contact-us jsonobj)) + (render-contact-us-view))) + +(defn render-contact-us [] + (GET "/contact-us" {:handler handler-contact-us})) + +;; contact-us-view + +(hiccups/defhtml template-contact-us-view [jsonobj] + (ck-form/template-generic-form (get jsonobj "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)))) + +(defn render-contact-us-view [] + (GET "/contact-us/view" {:handler handler-contact-us-view})) + +;; contact-us-submit + +(defn on-contact-us-email-submit-clicked [] + (when (-> (jquery "#contact-us-form") + (.get "0") + (.checkValidity)) + (render-contact-us-email-submit))) + +(defn handler-contact-us-email-submit [response] + (on-menu-clicked "/contact-us")) + +(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))} + :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 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)))) + +(defn render-messages [] + (GET "/messages" {:handler handler-messages})) + +;; messages-results + +(defn on-messages-mode-clicked [read] + (dommy/set-value! (dommy/sel1 :#read) read) + (render-messages-results)) + +(hiccups/defhtml template-messages-results [jsonobj] + (let [results (get jsonobj "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") ")")}]]]))]]))) + +(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)))) + +(defn render-messages-results [] + (POST "/messages/results" + {:format :raw + :params {:read (dommy/value (dommy/sel1 :#read))} + :handler handler-messages-results})) + +;; messages-mark + +(defn on-messages-mark [read id] + (render-messages-mark read id)) + +(defn handler-messages-mark [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/messages"))) + +(defn render-messages-mark [read id] + (POST "/messages/mark" + {:format :raw + :params {:read read + :id 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 handler-users [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-users jsonobj)) + (render-users-view))) + +(defn render-users [] + (GET "/users" {:handler handler-users})) + +;; 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 handler-users-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#content) (template-users-view jsonobj)))) + +(defn render-users-view [] + (GET "/users/view" {:handler handler-users-view})) + +;; users-add + +(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 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")))) + +(defn render-users-add [] + (POST "/users/add" {:handler handler-users-add})) + +;; users-add-submit + +(defn on-users-add-submit-clicked [] + (when (-> (jquery "#users-add-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "hide") + (render-users-add-submit))) + +(defn handler-users-add-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(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))} + :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 handler-users-register [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (dommy/set-html! (dommy/sel1 :#body) (template-users-register jsonobj)) + (render-users-register-form (get jsonobj "hash")))) + +(defn render-users-register [hash] + (POST "/users/register" + {:format :raw + :params {:hash hash} + :handler handler-users-register})) + +;; 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 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)))) + +(defn render-users-register-form [hash] + (POST "/users/register/form" + {:format :raw + :params {:hash hash} + :handler handler-users-register-form})) + +;; users-register-submit + +(defn on-users-register-submit-clicked [] + (when (-> (jquery "#users-register-form") + (.get "0") + (.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))))) + +(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))} + :handler handler-users-register-submit})) + +;; users-modify + +(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 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")))) + +(defn render-users-modify [id] + (POST "/users/modify" + {:format :raw + :params {:id id} + :handler handler-users-modify})) + +;; users-modify-submit + +(defn on-users-modify-submit-clicked [] + (when (-> (jquery "#users-modify-form") + (.get "0") + (.checkValidity)) + (.modal (jquery "#modify") "hide") + (render-users-modify-submit))) + +(defn handler-users-modify-submit [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(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))} + :handler handler-users-modify-submit})) + +;; users-toggle-active + +(defn on-users-toggle-active-clicked [id] + (render-users-toggle-active id)) + +(defn handler-users-toggle-active [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(defn render-users-toggle-active [id] + (POST "/users/toggle-active" + {:format :raw + :params {:id id} + :handler handler-users-toggle-active})) + +;; 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.")) + (render-users-delete id))) + +(defn handler-users-delete [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (auth-notifications jsonobj) + (on-menu-clicked "/users"))) + +(defn render-users-delete [id] + (DELETE (str "/users/delete/" id) + {:format :raw + :handler handler-users-delete})) + +;; location + +(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 "/contact-us") (render-contact-us) + (= handler "/messages") (render-messages) + (= handler "/users") (render-users))) + +(defn handler-location [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (on-menu-clicked (get jsonobj "location")) + (notifications jsonobj))) + +(defn goto-location [location] + (POST "/location" + {:format :raw + :params {:location location} + :handler handler-location})) + +(defn reset-app [] + (set! (.-location js/document) "/")) + +(defn goto-register [hash] + (reset-location "/users/register") + (render-menu) + (render-users-register hash)) diff --git a/lisp/webapps/resume/conf/.gitignore b/lisp/webapps/resume/conf/.gitignore new file mode 100644 index 0000000..14fa7a6 --- /dev/null +++ b/lisp/webapps/resume/conf/.gitignore @@ -0,0 +1 @@ +options.lisp diff --git a/lisp/webapps/resume/conf/options.lisp.example b/lisp/webapps/resume/conf/options.lisp.example new file mode 100644 index 0000000..dd570ee --- /dev/null +++ b/lisp/webapps/resume/conf/options.lisp.example @@ -0,0 +1,13 @@ +(:name "resume" + :url "resume.org" + :document-root "resume" + :title "Resume" + :meta-description "The Resume website written in Common Lisp/Hunchentoot and ClojureScript." + :databases (:db-resume ("127.0.0.1" "resume" "resume" "password")) + :mail-mx "mail.ckons.org" + :mail-from "postmaster@ckons.org" + :mail-postmaster "postmaster@ckons.org" + :mail-webmaster "webmaster@ckons.org" + :mail-info "info@ckons.org" + :mail-login-notify "me@ckons.org" + :mail-authentication ("me@ckons.org" "password")) diff --git a/lisp/webapps/resume/site.lisp b/lisp/webapps/resume/site.lisp new file mode 100644 index 0000000..3e31ac1 --- /dev/null +++ b/lisp/webapps/resume/site.lisp @@ -0,0 +1,206 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :resume) + +(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 "resume.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 .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 ("/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/resume/static/css/stylesheet.css b/lisp/webapps/resume/static/css/stylesheet.css new file mode 100644 index 0000000..659aa54 --- /dev/null +++ b/lisp/webapps/resume/static/css/stylesheet.css @@ -0,0 +1,117 @@ +body { + background-color: #161012; + color: white; + font-size: 14px; +} + +hr { + border: 1px #ffd081 solid; + width: 200px; +} + +a { + color: #ffd081; +} + +.container-fluid { + width: 100%; + margin: 20px auto; +} + +.table { + color: white; +} + +.nav-link { + color: white; + cursor: pointer; + cursor: hand; +} + +.nav-pills { + .nav-link.active, + .show > .nav-link { + background-color: #59200e; + } +} + +.well { + background-color: #2c180d; + border: 1px black solid; + text-align: center; +} + +.btn, +.btn-primary, +.dropdown-toggle { + color: white; + background-color: #59200e; + border-color: #59200e; + &:hover { + color: white; + background-color: #59200e; + border-color: #59200e; + } +} + +.show > .btn-primary.dropdown-toggle { + color: white; + background-color: #59200e; + border-color: #59200e; +} + +.dropdown-menu { + color: white; + background-color: #59200e; +} + +.dropdown-item { + color: white; + background-color: #59200e; +} + +.banner { + height: 90px; + background-image: url("/static/images/violin-strip.jpg"); + background-repeat: repeat; + background-position: left; +} + +.banner-title { + width: *; + color: #59200e; + font-size: 28px; + font-weight: bold; + text-align: center; +} + +.banner-menu { + width: 150px; + text-align: left; + vertical-align: top; +} + +.form-control { + width: 600px; + background-color: #ffd081; +} + +.contact-info { + color: #59200e; + font-size: 15px; + font-weight: bold; + line-height: 0.4; +} + +.modal-content { + background-color: #161012; +} + +#body { + min-height: 500px; +} + +#footer { + font-size: 14px; + text-align: center; +} diff --git a/lisp/webapps/resume/static/images/add.png b/lisp/webapps/resume/static/images/add.png new file mode 100644 index 0000000..1055df8 Binary files /dev/null and b/lisp/webapps/resume/static/images/add.png differ diff --git a/lisp/webapps/resume/static/images/classical-bow.jpg b/lisp/webapps/resume/static/images/classical-bow.jpg new file mode 100644 index 0000000..fce1392 Binary files /dev/null and b/lisp/webapps/resume/static/images/classical-bow.jpg differ diff --git a/lisp/webapps/resume/static/images/delete.png b/lisp/webapps/resume/static/images/delete.png new file mode 100644 index 0000000..ec140b7 Binary files /dev/null and b/lisp/webapps/resume/static/images/delete.png differ diff --git a/lisp/webapps/resume/static/images/document-open.png b/lisp/webapps/resume/static/images/document-open.png new file mode 100644 index 0000000..20b7ca8 Binary files /dev/null and b/lisp/webapps/resume/static/images/document-open.png differ diff --git a/lisp/webapps/resume/static/images/down.png b/lisp/webapps/resume/static/images/down.png new file mode 100644 index 0000000..e2d15bf Binary files /dev/null and b/lisp/webapps/resume/static/images/down.png differ diff --git a/lisp/webapps/resume/static/images/download.png b/lisp/webapps/resume/static/images/download.png new file mode 100644 index 0000000..3973b3c Binary files /dev/null and b/lisp/webapps/resume/static/images/download.png differ diff --git a/lisp/webapps/resume/static/images/edit-redo.png b/lisp/webapps/resume/static/images/edit-redo.png new file mode 100644 index 0000000..3d4db6c Binary files /dev/null and b/lisp/webapps/resume/static/images/edit-redo.png differ diff --git a/lisp/webapps/resume/static/images/edit-undo.png b/lisp/webapps/resume/static/images/edit-undo.png new file mode 100644 index 0000000..367fc5a Binary files /dev/null and b/lisp/webapps/resume/static/images/edit-undo.png differ diff --git a/lisp/webapps/resume/static/images/edit.png b/lisp/webapps/resume/static/images/edit.png new file mode 100644 index 0000000..550dacd Binary files /dev/null and b/lisp/webapps/resume/static/images/edit.png differ diff --git a/lisp/webapps/resume/static/images/emblem-favorite.png b/lisp/webapps/resume/static/images/emblem-favorite.png new file mode 100644 index 0000000..6535d5d Binary files /dev/null and b/lisp/webapps/resume/static/images/emblem-favorite.png differ diff --git a/lisp/webapps/resume/static/images/emblem-nowrite.png b/lisp/webapps/resume/static/images/emblem-nowrite.png new file mode 100644 index 0000000..997fedf Binary files /dev/null and b/lisp/webapps/resume/static/images/emblem-nowrite.png differ diff --git a/lisp/webapps/resume/static/images/instrument-cabinet.jpg b/lisp/webapps/resume/static/images/instrument-cabinet.jpg new file mode 100644 index 0000000..0500829 Binary files /dev/null and b/lisp/webapps/resume/static/images/instrument-cabinet.jpg differ diff --git a/lisp/webapps/resume/static/images/no.png b/lisp/webapps/resume/static/images/no.png new file mode 100644 index 0000000..1dc1b7c Binary files /dev/null and b/lisp/webapps/resume/static/images/no.png differ diff --git a/lisp/webapps/resume/static/images/sort-alpha.png b/lisp/webapps/resume/static/images/sort-alpha.png new file mode 100644 index 0000000..0e4a831 Binary files /dev/null and b/lisp/webapps/resume/static/images/sort-alpha.png differ diff --git a/lisp/webapps/resume/static/images/up.png b/lisp/webapps/resume/static/images/up.png new file mode 100644 index 0000000..55bab86 Binary files /dev/null and b/lisp/webapps/resume/static/images/up.png differ diff --git a/lisp/webapps/resume/static/images/violin-strip.jpg b/lisp/webapps/resume/static/images/violin-strip.jpg new file mode 100644 index 0000000..6149a87 Binary files /dev/null and b/lisp/webapps/resume/static/images/violin-strip.jpg differ diff --git a/lisp/webapps/resume/static/images/yes.png b/lisp/webapps/resume/static/images/yes.png new file mode 100644 index 0000000..b9cadf5 Binary files /dev/null and b/lisp/webapps/resume/static/images/yes.png differ diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp new file mode 100644 index 0000000..41a00da --- /dev/null +++ b/lisp/webapps/webapp-loader.lisp @@ -0,0 +1,177 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :resume) + +(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* 3014) +(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 resume () + "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))))) -- cgit v1.3