summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--mulkcms-hunchentoot.asd6
-rw-r--r--mulkcms-hunchentoot.lisp30
-rw-r--r--mulkcms.asd21
-rw-r--r--mulkcms.lisp96
-rw-r--r--package-hunchentoot.lisp1
-rw-r--r--templates/journal_page.html2
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}