From dcf596791d3afc7ad6d54b038965b758669d9843 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Tue, 22 Mar 2011 18:52:17 +0100
Subject: Add a comment moderation page.

---
 mulkcms.lisp                           | 63 +++++++++++++++++++++++++++++++---
 templates/article.html                 | 10 +-----
 templates/comment.html                 |  9 +++++
 templates/comment_moderation_page.html | 28 +++++++++++++++
 4 files changed, 97 insertions(+), 13 deletions(-)
 create mode 100644 templates/comment.html
 create mode 100644 templates/comment_moderation_page.html

diff --git a/mulkcms.lisp b/mulkcms.lisp
index 989d5bf..43f1dfc 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -13,6 +13,7 @@
                (cons "html-short-human-date" 'format-short-human-date)
                (cons "html-iso-date"   'format-iso-date)
                (cons "article-html"    'format-article)
+               (cons "comment-html"    'format-comment)
                *template-formatters*)))
 
 
@@ -301,6 +302,10 @@
   (let ((article-template (template "article")))
     (expand-template article-template article-params)))
 
+(defun format-comment (comment-params)
+  (let ((comment-template (template "comment")))
+    (expand-template comment-template comment-params)))
+
 (defun paramify-article-data (revision-data &optional (comments nil commentary-p))
   (destructuring-bind (rid article date title content author format status
                        global-id
@@ -504,7 +509,7 @@
                        article-revision submitter-ip user-agent
                        &rest args)
       comment-revision-data
-    (declare (ignore args crid status format submitter-ip user-agent))
+    (declare (ignore args status format submitter-ip user-agent))
     (destructuring-bind (author-name author-website)
         (query "SELECT name, website FROM users WHERE id = $1"
                author
@@ -515,6 +520,9 @@
                             article-revision
                             :single!)))
         (list :publishing-date date
+              :revision-id crid
+              :comment-id comment
+              :article-revision article-revision
               :body (format-comment-content content)
               :author author-name
               ;;FIXME
@@ -793,6 +801,54 @@
                (char= (char string (1- (length string))) #\})))
   (parse-row-or-array string))
 
+(defun find-comment-moderation-handler (path params
+                                        &optional
+                                        action
+                                        (characteristics
+                                         *requested-characteristics*))
+  (declare (ignore characteristics action))
+  (when (string= path "admin/comments")
+    (dynamic-lambda (*propagated-params*) ()
+      (with-authorization (user-id :require :admin)
+        (declare (ignore user-id))
+        (with-db
+          (when-let (status
+                     (cond
+                       ((assoc "mark-as-spam" params :test #'equal) "spam")
+                       ((assoc "reject"       params :test #'equal) "rejected")
+                       ((assoc "approve"      params :test #'equal) "approved")
+                       (t nil)))
+            (query "UPDATE comment_revisions
+                       SET status = $2
+                     WHERE id = $1"
+                   (parse-integer (cdr (assoc "revision-id" params :test #'equal)))
+                   status
+                   :none))
+          (let* ((comments (query "SELECT *
+                                     FROM comment_revisions
+                                    WHERE status IN ('pending')"
+                                  :rows))
+                 (comment-data (mapcar #'paramify-comment comments))
+                 (comment-data-with-article-data
+                  (mapcar (lambda (comment)
+                            (let ((revision (query "SELECT *
+                                                      FROM article_revisions
+                                                     WHERE id = $1"
+                                                   (getf comment :article-revision)
+                                                   :row)))
+                              (list* :article (paramify-article revision)
+                                     comment)))
+                          comment-data)))
+            (expand-page (template "comment_moderation_page")
+                         "Comments Awaiting Moderation"
+                         (list :spam-label "Mark as spam"
+                               :reject-label "Reject"
+                               :approve-label "Approve"
+                               :site-name *site-name*
+                               :title "Comments Awaiting Moderation"
+                               :comments comment-data-with-article-data))))))))
+
+
 (defun find-article-summary-handler (path params
                                      &optional
                                      action
@@ -1153,9 +1209,8 @@
                                                       (list "lang" "hl")
                                                       :test #'equal))
                                             params)))
-    (or (find-article-summary-handler
-         path
-         params)
+    (or (find-article-summary-handler path params)
+        (find-comment-moderation-handler path params)
         (find-journal-archive-request-handler
          path
          (assoc "full" params :test #'equal)
diff --git a/templates/article.html b/templates/article.html
index bd8b10a..2df9654 100644
--- a/templates/article.html
+++ b/templates/article.html
@@ -44,15 +44,7 @@
   <h2>{comments-heading|html}</h2>
 
   {.repeated section comments}
-    <div class="comment">
-      <div class="comment-header">
-        {publishing-date|html-human-date}
-        <a rel="nofollow" {.section author-link}href="{@|html-attr-value}"{.end}>{.section author}{@|html}{.or}{generic-commenter-name|html}{.end}</a>:
-      </div>
-      <div class="comment-body">
-        {body}
-      </div>
-    </div>
+    {@|comment-html}
   {.end}
 
   {.section comment-submission}
diff --git a/templates/comment.html b/templates/comment.html
new file mode 100644
index 0000000..dbcb759
--- /dev/null
+++ b/templates/comment.html
@@ -0,0 +1,9 @@
+<div class="comment">
+  <div class="comment-header">
+    {publishing-date|html-human-date}
+    <a rel="nofollow" {.section author-link}href="{@|html-attr-value}"{.end}>{.section author}{@|html}{.or}{generic-commenter-name|html}{.end}</a>:
+  </div>
+  <div class="comment-body">
+    {body}
+  </div>
+</div>
diff --git a/templates/comment_moderation_page.html b/templates/comment_moderation_page.html
new file mode 100644
index 0000000..3e13bd9
--- /dev/null
+++ b/templates/comment_moderation_page.html
@@ -0,0 +1,28 @@
+{.section head}
+<link rel="stylesheet" type="text/css"
+      href="{root|html-attr-value}style/journal.css" />
+{.end}
+
+{.section body}
+  <h1 id="main-title">{site-name|html}</h1>
+  <div id="main-subtitle">{title}</div>
+
+  {.repeated section comments}
+  <div class="comment-for-moderation" style="border: 1px solid #444; margin: 10px; padding: 5px;">
+    <form id="editing-form" method="POST" accept-charset="UTF-8">
+      <input type="hidden" name="revision-id" value="{revision-id}" />
+      <div>
+        <input type="submit" name="mark-as-spam" value="{spam-label|html-attr-value}" /> |
+        <input type="submit" name="reject" value="{reject-label|html-attr-value}" /> |
+        <input type="submit" name="approve" value="{approve-label|html-attr-value}" />
+      </div>
+    </form>
+
+    <p>
+      Comment on article
+      <a href="{article.link|html-attr-value}">“{article.title}”</a>:
+    </p>
+    {@|comment-html}
+  </div>
+  {.end}
+{.end}
-- 
cgit v1.2.3