From d5005613677cdf45dbd1cf167aaaa8a22d576573 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Thu, 10 Mar 2011 16:23:40 +0100
Subject: Handle simple article requests.

---
 mulkcms.lisp | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 90 insertions(+), 6 deletions(-)

(limited to 'mulkcms.lisp')

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))))))))))
-- 
cgit v1.2.3