(in-package :cl-user) (restas:define-module #:assboard.web (:use :cl :hunchentoot :assboard.utils :assboard.engine)) (in-package #:assboard.web) ;; Parameters (setf (who:html-mode) :html5) (restas:define-route static/css ("css/:file" :content-type "text/css") (let ((css-path (merge-pathnames "css/" +project-path+))) (merge-pathnames file css-path))) (defclass renderer () ()) (restas::register-pkgmodule-traits 'assboard.web :render-method (lambda () (make-instance 'assboard.web::renderer))) ;; Rendering (defgeneric finalize-page (data) (:documentation "Final rendering step")) (defgeneric render-route-data (route data) (:documentation "Process route-specific data")) (defmethod finalize-page ((data list)) (who:with-html-output-to-string (out nil :prologue t) (:html (:head (:meta :charset "utf-8") (:meta :http-equiv "X-UA-Compatible" :content "IE=edge") (:meta :name "viewport" :content "width=device-width, initial-scale=1") (:title (who:str (getf data :title))) ;;(:link :rel "stylesheet" :href (restas:genurl 'static/css :file "styles.css")) ) (:body (who:str (getf data :menu)) (who:str (getf data :content)))))) (defmethod render-route-data (route (data list)) (list* :title (getf data :title "AssBoard") data)) (defmethod restas:render-object ((designer renderer) (object list)) (let ((full-data (render-route-data (restas:route-symbol restas:*route*) object))) (finalize-page full-data))) (defun posts-list (out posts &key (author t) (status nil)) (who:with-html-output (out) (if posts (who:htm (:ul (loop for post in posts :do (who:htm (:li (:a :href (restas:genurl 'posting :hash (data::posting-hash post)) (who:esc (data::posting-title post))) (when status (who:fmt " [~A]" (data::posting-status post))) (when author (who:htm " by " (:a :href (restas:genurl 'author :author (data::posting-author post)) (who:esc (data::posting-author post)))))))))) (who:htm (:ul (:li "No posts yet")))))) (defmethod render-route-data ((route (eql 'index)) (posts list)) (list :title "AssBoard" :content (who:with-html-output-to-string (out) (:h1 "AssBoard open postings") (posts-list out posts) (:h2 "Add new posting") (:form :method "POST" :action (restas:genurl 'posting/post) (:input :type "text" :name "title" :placeholder "Title") (:br) (:br) (:textarea :name "body" :cols 80 :rows 10 :placeholder "Body") (:br) (:button :type "submit" "Prepare"))))) (restas:define-route index ("") (pomo:query-dao 'data::posting (:select 'hash 'author 'status 'title 'maintainer 'created-on :from 'posting :where (:= 'status "open")))) (defmethod render-route-data ((route (eql 'posting/post)) (data list)) (list :title "Add new posting" :content (who:with-html-output-to-string (out) (:h1 "Add new posting") (if (getf data :error) (who:htm (:h2 "Error adding post:") (:p (who:str (getf data :error)))) (who:htm (:p "To add new posting, clearsign (`gpg --clearsign`) the following text and paste results from '-----BEGIN PGP SIGNED MESSAGE-----' up to '-----END PGP SIGNATURE-----'") (:textarea :disabled t :cols 80 :rows 10 (who:str (getf data :to-sign))) (:form :method "POST" (:textarea :name "clearsigned" :cols 80 :rows 20 :placeholder "clearsigned") (:br) (:button :type "submit" "Post"))))))) (restas:define-route posting/post ("posting/" :method :post) (let ((clearsigned (hunchentoot:post-parameter "clearsigned"))) (if clearsigned (handler-case (let ((posting (process-command clearsigned))) (restas:redirect 'posting :hash (data::posting-hash posting))) (command-error (err) (log:info "Error processing command ~A" err) (list :error err :clearsigned clearsigned))) (let ((title (hunchentoot:post-parameter "title")) (body (hunchentoot:post-parameter "body"))) (if (or (equal title "") (equal body "")) (restas:redirect 'index) (list :to-sign (format-new-posting title body))))))) (defmethod render-route-data ((route (eql 'author)) (data list)) (list :title (format nil "~A's postings @ AssBoard" (getf data :author)) :content (who:with-html-output-to-string (out) (:h1 (who:str (getf data :author)) "'s postings") (who:str (posts-list out (getf data :posts) :author nil :status t))))) (restas:define-route author ("author/:author/") (let ((posts (pomo:query-dao 'data::posting (:select 'hash 'author 'status 'title 'maintainer 'created-on :from 'posting :where (:and (:= 'author author) (:!= 'status "deleted")))))) (if posts (list :author author :posts posts) hunchentoot:+HTTP-NOT-FOUND+))) (defun render/post-subheader (out post) (who:with-html-output (out) (:h2 "by " (:a :href (restas:genurl 'author :author (data::posting-author post)) (who:esc (data::posting-author post))) (who:fmt " [~A]" (data::posting-status post))))) (defmethod restas:render-object ((designer renderer) (object data::posting)) (if (data::posting-deletedp object) (finalize-page (list :title "Posting deleted" :content (who:with-html-output-to-string (out) (:h1 "Posting deleted"))) ) (finalize-page (list :title (format nil "~A by ~A @ AssBoard" (data::posting-title object) (data::posting-author object)) :content (who:with-html-output-to-string (out) (:h1 (who:esc (data::posting-title object))) (render/post-subheader out object) (:div (cl-markdown:markdown (data::posting-body object) :stream out)) (:hr) (:h2 "Edit post") (:form :method "POST" :action (restas:genurl 'posting-edit/post :hash (data::posting-hash object)) (:input :type "text" :name "title" :size 80 :value (data::posting-title object)) (:br) (:br) (:textarea :name "body" :cols 80 :rows 10 (who:esc (data::posting-body object))) (:br) (:input :type "submit" :name "action" :value "Update") " " (:input :type "submit" :name "action" :value "Delete") " " (:input :type "submit" :name "action" :value "Close"))))))) (restas:define-route posting ("posting/:hash/") (let ((post (first (pomo:select-dao 'data::posting (:and (:= 'hash hash)))))) (if post post hunchentoot:+HTTP-NOT-FOUND+))) (defmethod render-route-data ((route (eql 'posting-edit/post)) (data list)) (let ((post (getf data :post))) (list :title (format nil "Update '~A' by ~A @ AssBoard" (data::posting-title post) (data::posting-author post)) :content (who:with-html-output-to-string (out) (:h1 (who:esc (format nil "Update '~A'" (data::posting-title post)))) (render/post-subheader out post) (if (getf data :error) (who:htm (:h2 "Error editing post:") (:p (who:str (getf data :error)))) (who:htm (:p (who:esc (format nil "To ~a posting, clearsign (`gpg --clearsign`) the following text and paste results from '-----BEGIN PGP SIGNED MESSAGE-----' up to '-----END PGP SIGNATURE-----'" (getf data :action)))) (:textarea :disabled t :cols 80 :rows 10 (who:str (getf data :to-sign))) (:form :method "POST" (:input :type "hidden" :name "action" :value (getf data :action)) (:textarea :name "clearsigned" :cols 80 :rows 20 :placeholder "clearsigned") (:br) (:button :type "submit" "Perform")))))))) (restas:define-route posting-edit/post ("posting/:hash/" :method :post) (let ((post (first (pomo:select-dao 'data::posting (:= 'hash hash)))) (clearsigned (hunchentoot:post-parameter "clearsigned")) (action (hunchentoot:post-parameter "action"))) (if post (if clearsigned (handler-case (let ((posting (process-command clearsigned))) (restas:redirect 'posting :hash (data::posting-hash posting))) (command-error (err) (log:warn "Error processing command ~A" err) (list :error err :post post :action action :clearsigned clearsigned))) (let ((title (hunchentoot:post-parameter "title")) (body (hunchentoot:post-parameter "body"))) (if (and (equal action "Edit") (or (equal title "") (equal body ""))) (restas:redirect 'posting :hash hash) (list :post post :action action :to-sign (cond ((equal action "Update") (format-update-posting post title body)) ((equal action "Close") (format-close-posting post)) ((equal action "Delete") (format-delete-posting post))))))) hunchentoot:+HTTP-NOT-FOUND+)))