blob: 12b9b7e8458119ad16310f7b2468e9bbce86a22c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
(in-package #:mulkcms)
(defparameter *database-connection-spec*
(list *database-name* *database-user* *database-password* *database-host*
:pooled-p t :use-ssl :try))
(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 paramify-article (revision-data &optional (comments nil commentary-p))
(destructuring-bind (rid article date title content author format status
global-id &rest args)
revision-data
(declare (ignore args rid))
(list :publishing-date date
:title title
:body content
;;FIXME
:link ""
:commentary (if commentary-p (list :comments comments) nil)
:edit-link ""
:edit-button-label "Edit"
:comment-feed ""
:comment-feed-label "Comment feed"
:comments-label "Comments"
:comments-link ""
:comments-heading "Comments")))
(defun paramify-comment (comment-revision-data)
(destructuring-bind (crid comment date content author format status
article-revision &rest args)
comment-revision-data
(declare (ignore args crid article-revision status format comment))
(list :publishing-date date
:body content
:author author
;;FIXME
:link ""
:edit-link ""
:edit-button-label "Edit"
:generic-commenter-name "Someone")))
(defun find-mulkcms-request-handler (path &optional action characteristics)
(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 *
FROM article_revisions
WHERE article = $1
ORDER BY date DESC"
article
:lists))
(comment-data (query "SELECT id FROM comments WHERE article = $1"
article
:column))
(comment-revision-data
(remove-if #'null
(mapcar (lambda (cid)
(first
(query "SELECT *
FROM comment_revisions
WHERE comment = $1
AND status IN ('approved', 'trusted')
ORDER BY date DESC"
cid
:lists)))
comment-data)))
(comments (mapcar #'paramify-comment comment-revision-data))
(revision-data (first revisions))
(page-skeleton (template "page_skeleton"))
(page-template (template page-template-name))
(template-params (list :title (fourth revision-data)
:root *base-uri*
:site-name *site-name*
:site-subtitle ""
:link ""))
(article-params (paramify-article revision-data 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 (fourth revision-data)
:head head
:body body))))))))
|
