Handle simple article requests.

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}