diff options
| -rw-r--r-- | mulkcms-hunchentoot.asd | 6 | ||||
| -rw-r--r-- | mulkcms-hunchentoot.lisp | 30 | ||||
| -rw-r--r-- | mulkcms.asd | 21 | ||||
| -rw-r--r-- | mulkcms.lisp | 96 | ||||
| -rw-r--r-- | package-hunchentoot.lisp | 1 | ||||
| -rw-r--r-- | templates/journal_page.html | 2 |
6 files changed, 137 insertions, 19 deletions
diff --git a/mulkcms-hunchentoot.asd b/mulkcms-hunchentoot.asd new file mode 100644 index 0000000..f8dfeda --- /dev/null +++ b/mulkcms-hunchentoot.asd @@ -0,0 +1,6 @@ +(asdf:defsystem mulkcms-hunchentoot + :serial t + :version "0.0.1" + :depends-on (:mulkcms :hunchentoot) + :components ((:file "package-hunchentoot") + (:file "mulkcms-hunchentoot"))) diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 0767fe7..205534f 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -1,2 +1,32 @@ (in-package #:mulkcms-hunchentoot) +(define-easy-handler handle-admin-request (action) + ;; XXX + ) + +(defun dispatch-static-file-request (request) + ;; FIXME Can use paths like "/../mulkcms.lisp" or "//boot/initrd.img". + ;; That's bad. + (let* ((relative-path (subseq (script-name request) 1)) + (file (merge-pathnames relative-path *static-files*))) + (and (probe-file file) (lambda () (handle-static-file file))))) + +(defun dispatch-mulkcms-request (request) + (let* ((relative-path (subseq (script-name request) 1))) + (mulkcms::find-mulkcms-request-handler relative-path))) + +(defun setup-handlers () + (setq *dispatch-table* + (list* 'dispatch-static-file-request + (create-prefix-dispatcher "/admin" 'handle-admin-request) + 'dispatch-mulkcms-request + *dispatch-table*)) + (setq *default-handler* 'handle-mulkcms-request)) + +(defun start-server () + (setq hunchentoot:*hunchentoot-default-external-format* + (flexi-streams:make-external-format :utf-8)) + (setup-handlers) + (hunchentoot:start (make-instance 'hunchentoot:acceptor + :port *server-port* + :address *server-address*))) diff --git a/mulkcms.asd b/mulkcms.asd index b4544d8..97520b8 100644 --- a/mulkcms.asd +++ b/mulkcms.asd @@ -2,18 +2,15 @@ ;;; Copyright 2011, Matthias Andreas Benkard. -(defsystem mulkcms +(asdf:defsystem mulkcms + :author "Matthias Andreas Benkard" + :description "" + :license "Affero GPL 3.0" :serial t :version "0.0.1" :depends-on (:cl-who :cl-json :alexandria :postmodern :split-sequence - :cl-ppcre :cl-fad :cxml :closure-html :json-template) - :components ((:file "site") - (:file "package") - (:file "mulkcms"))) - - -(defsystem mulkcms-hunchentoot - :serial t - :version "0.0.1" - :depends-on (:mulkcms :hunchentoot) - :components ((:file "mulkcms-hunchentoot"))) + :cl-ppcre :cl-fad :cxml :closure-html :json-template :cxml-stp) + :components ((:file "package") + (:file "site") + (:file "mulkcms") + (:file "lingva"))) diff --git a/mulkcms.lisp b/mulkcms.lisp index fbbbb56..9ff05ee 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -1,11 +1,95 @@ (in-package #:mulkcms) (defparameter *database-connection-spec* - (list *database-name* *database-user* *database-password* *database-host*)) + (list *database-name* *database-user* *database-password* *database-host* + :pooled-p t :use-ssl :try)) -(unless (member "html" *template-formatters* :key #'car :test #'equal) - (push `("html" . ,(lambda (x) (cl-who:escape-string (string x)))) - *template-filters*) - (push `("html-attr-value" . ,(lambda (x) (cl-who:escape-string (string x)))) - *template-filters*)) +(unless (member "html-human-date" *template-formatters* :key #'car :test #'equal) + (setq *template-formatters* + (list* (cons "html-human-date" 'format-human-date) + (cons "html-iso-date" 'format-iso-date) + (cons "article-html" 'format-article) + *template-formatters*))) + +(defun call-with-db (thunk) + (call-with-connection *database-connection-spec* thunk)) + +(defmacro with-db (&body body) + `(call-with-db (lambda () ,@body))) + +(defun find-template (template-name) + (first (directory (make-pathname :name template-name + :type :wild + :directory *templates*)))) + +(defun format-human-date (date) + ;; FIXME + "(some date)") + +(defun format-iso-date (date) + ;; FIXME + "(some date)") + +(defun template (template-name) + (parse-template-string (read-file-into-string (find-template template-name)))) + +(defun format-article (article-params) + (let ((article-template (template "article"))) + (expand-template article-template article-params))) + +(defun find-mulkcms-request-handler (path &optional action) + (with-db + (when-let ((article (query "SELECT article FROM article_aliases + WHERE alias = $1" + path + :single))) + (lambda () + (with-db + (let* ((page-template-name (query "SELECT page_template FROM articles + JOIN article_types + ON articles.type = article_types.id + WHERE articles.id = $1" + article + :single!)) + (revisions (query "SELECT author, date, format, status, + global_id, title, content + FROM article_revisions + WHERE article = $1 + ORDER BY date DESC" + article + :lists)) + (revision-data (first revisions)) + (page-skeleton (template "page_skeleton")) + (page-template (template page-template-name))) + (destructuring-bind (author date format status global-id title content) + revision-data + (let* ((template-params (list :title title + :root *base-uri* + :site-name *site-name* + :site-subtitle "" + :link "" + ;; Article stuff + )) + (article-params (list :publishing-date date + :title title + :body content + ;;FIXME + :link "" + :commentary nil + :edit-link "" + :edit-button-label "Edit" + :comment-feed "" + :comment-feed-label "Comment feed" + :comments-label "Comments" + :comments-link "" + :comments-heading "Comments")) + (head (expand-template page-template (list* :head t + :articles (list article-params) + template-params))) + (body (expand-template page-template (list* :body t + :articles (list article-params) + template-params)))) + (expand-template page-skeleton (list :title title + :head head + :body body)))))))))) diff --git a/package-hunchentoot.lisp b/package-hunchentoot.lisp index 1380237..c1e8bba 100644 --- a/package-hunchentoot.lisp +++ b/package-hunchentoot.lisp @@ -1,4 +1,5 @@ (cl:defpackage #:mulkcms-hunchentoot (:use #:common-lisp #:hunchentoot #:cl-who #:cl-ppcre #:alexandria #:cl-fad #:mulkcms) + (:nicknames #:mulkcms-ht) (:shadow #:copy-file #:copy-stream)) diff --git a/templates/journal_page.html b/templates/journal_page.html index 3106ca7..037146d 100644 --- a/templates/journal_page.html +++ b/templates/journal_page.html @@ -9,7 +9,7 @@ <div id="articles"> {.repeated section articles} - {article|article-html} + {@|article-html} {.end} </div> {.end} |