Add a comment and trackback moderation page.

Ignore-this: 45d484506c4f5f4b0560f6397e5b61a2

darcs-hash:9cc1720d761894eff92ca76970a7c750dccc69d1

2 files changed, 107 insertions, 29 deletions

diff --git a/journal.lisp b/journal.lisp
index 99b8459..a4a6191 100755
--- a/journal.lisp
+++ b/journal.lisp
@@ -47,6 +47,7 @@
         (:post-comment (values "/~D" post-id))
         (:trackback (values "/~D/trackback" post-id))
         (:save (values "/~D/save" post-id))
+        (:moderation-page "/moderate")
         (:css "/../journal.css")))))
 
 
@@ -278,39 +279,13 @@
       (<:div :class :journal-comments
        (<:h2 "Kommentare")
        (dolist (comment comments)
-         (with-slots (author body date id email website)
-             comment
-           (<:div :class :journal-comment
-                  :id (format nil "comment-~D" id)
-            (<:div :class :journal-comment-header
-             (<:as-html (format nil "(~A) "
-                                (format-date nil "%day%.%mon%.%yr%, %hr%:%min%" date)))
-             (<:a :href website :rel "nofollow"
-              (<:as-html (format nil "~A" author)))
-             (<:as-html " meint: "))
-            (<:div :class :journal-comment-body
-             (<:as-html (render-comment-body body))))))))
+         (show-comment comment))))
 
     (when (and comments-p (not (null trackbacks)))
       (<:div :class :journal-comments
        (<:h2 "Trackbacks")
        (dolist (trackback trackbacks)
-         (with-slots (title excerpt date id url blog-name)
-             trackback
-           (<:div :class :journal-comment
-                  :id (format nil "trackback-~D" id)
-            (<:div :class :journal-comment-header
-                   (<:as-html (format nil "(~A) "
-                                      (format-date nil "%day%.%mon%.%yr%, %hr%:%min%" date)))
-                   (<:strong (<:as-html (format nil "~A " (or blog-name url))))
-                   (if (null title)
-                       (<:a :href url :rel "nofollow" (<:as-html "schreibt hierzu:"))
-                       (progn
-                         (<:as-html "schreibt hierzu im Artikel ")
-                         (<:a :href url :rel "nofollow" (<:as-html (format nil "~A" title)))
-                         (<:as-html ":"))))
-            (<:div :class :journal-comment-body
-             (<:as-html (render-comment-body excerpt))))))))
+         (show-trackback trackback))))
 
     (when comments-p
       (<:as-is (format nil "<!--
@@ -491,6 +466,90 @@
   #.(restore-sql-reader-syntax-state))
 
 
+(defun show-comment (comment)
+  (with-slots (author body date id email website)
+      comment
+    (<:div :class :journal-comment
+           :id (format nil "comment-~D" id)
+     (<:div :class :journal-comment-header
+      (<:as-html (format nil "(~A) "
+                         (format-date nil "%day%.%mon%.%yr%, %hr%:%min%" date)))
+      (<:a :href website :rel "nofollow"
+       (<:as-html (format nil "~A" author)))
+      (<:as-html " meint: "))
+     (<:div :class :journal-comment-body
+      (<:as-html (render-comment-body body))))))
+
+(defun show-trackback (trackback)
+  (with-slots (title excerpt date id url blog-name)
+      trackback
+    (<:div :class :journal-comment
+           :id (format nil "trackback-~D" id)
+     (<:div :class :journal-comment-header
+            (<:as-html (format nil "(~A) "
+                               (format-date nil "%day%.%mon%.%yr%, %hr%:%min%" date)))
+            (<:strong (<:as-html (format nil "~A " (or blog-name url))))
+            (if (null title)
+                (<:a :href url :rel "nofollow" (<:as-html "schreibt hierzu:"))
+                (progn
+                  (<:as-html "schreibt hierzu im Artikel ")
+                  (<:a :href url :rel "nofollow" (<:as-html (format nil "~A" title)))
+                  (<:as-html ":"))))
+     (<:div :class :journal-comment-body
+      (<:as-html (render-comment-body excerpt))))))
+
+(defun show-moderation-page ()
+  #.(locally-enable-sql-reader-syntax)
+  (revalidate-cache-or-die "text/html; charset=UTF-8")
+  (with-web-journal (nil)
+    (<:h2 (<:as-html "Trackbacks"))
+    (dolist (trackback (select 'journal-trackback :flatp t :order-by '([date]) :where (clsql:sql-null [spam_p])))
+      (<:hr)
+      (<:form :action (link-to :moderation-page)
+              :method "post"
+              :accept-charset "UTF-8"
+              :enctype "application/x-www-form-urlencoded"
+              :style "display: inline"
+        (<:input :type "hidden" :name "id" :value (prin1-to-string (id-of trackback)))
+        (<:input :type "hidden" :name "type" :value "trackback")
+        (<:input :type "hidden" :name "acceptp" :value "f")
+        (<:button :type "submit" (<:as-is "Verwerfen")))
+      (<:form :action (link-to :moderation-page)
+              :method "post"
+              :accept-charset "UTF-8"
+              :enctype "application/x-www-form-urlencoded"
+              :style "display: inline"
+        (<:input :type "hidden" :name "id" :value (prin1-to-string (id-of trackback)))
+        (<:input :type "hidden" :name "type" :value "trackback")
+        (<:input :type "hidden" :name "acceptp" :value "t")
+        (<:button :type "submit" (<:as-is "Annehmen")))
+      (<:div (<:as-html "Zu: ") (<:a :href (link-to :view :post-id (id-of (entry-of trackback)) :absolute t) (<:as-html (title-of (entry-of trackback)))))
+      (show-trackback trackback))
+    (<:h2 (<:as-html "Kommentare"))
+    (dolist (comment (select 'journal-comment :flatp t :order-by '([date]) :where (clsql:sql-null [spam_p])))
+      (<:hr)
+      (<:form :action (link-to :moderation-page)
+              :method "post"
+              :accept-charset "UTF-8"
+              :enctype "application/x-www-form-urlencoded"
+              :style "display: inline"
+        (<:input :type "hidden" :name "id" :value (prin1-to-string (id-of comment)))
+        (<:input :type "hidden" :name "type" :value "comment")
+        (<:input :type "hidden" :name "acceptp" :value "f")
+        (<:button :type "submit" (<:as-is "Verwerfen")))
+      (<:form :action (link-to :moderation-page)
+              :method "post"
+              :accept-charset "UTF-8"
+              :enctype "application/x-www-form-urlencoded"
+              :style "display: inline"
+        (<:input :type "hidden" :name "id" :value (prin1-to-string (id-of comment)))
+        (<:input :type "hidden" :name "type" :value "comment")
+        (<:input :type "hidden" :name "acceptp" :value "t")
+        (<:button :type "submit" (<:as-is "Annehmen")))
+      (<:div (<:as-html "Zu: ") (<:a :href (link-to :view :post-id (id-of (entry-of comment)) :absolute t) (<:as-html (title-of (entry-of comment)))))
+      (show-comment comment)))
+  #.(restore-sql-reader-syntax-state))
+
 (defun preview-entry (title body id)
   (with-web-journal (title)
     (<:form :action (link-to :save :post-id id)
diff --git a/main.lisp b/main.lisp
index 763030d..1d806a8 100644
--- a/main.lisp
+++ b/main.lisp
@@ -52,6 +52,7 @@
                                       ((string= "preview" (car (last *subpath*))) :preview-entry)
                                       ((string= "trackback" (car (last *subpath*))) :post-trackback)
                                       ((string= "save" (car (last *subpath*))) :save-entry)
+                                      ((string= "moderate" (car (last *subpath*))) :moderate)
                                       (*post-number*                      :view)
                                       (t                                  nil))))
          (*method*          (keywordify (gethash "REQUEST_METHOD" *http-env*)))
@@ -96,6 +97,7 @@
 
 
 (defun dispatch-admin-action ()
+  #.(locally-enable-sql-reader-syntax)
   (case *action*
     (:preview-entry (let ((entry (and *post-number*
                                       (find-entry *post-number*))))
@@ -124,7 +126,24 @@
                            (title-of entry) (getf *query* :title))
                      (update-records-from-instance entry)))
                  (show-web-journal))
-    (otherwise (show-web-journal))))
+    (:moderate (let* ((id (getf *query* :id nil))
+                      (type (getf *query* :type nil))
+                      (acceptp (getf *query* :acceptp nil))
+                      (table (if (string= type "trackback")
+                                 'journal_trackback
+                                 'journal_comment)))
+                 (with-transaction ()
+                   (when (and id type acceptp (string= acceptp "t"))
+                     (update-records table
+                                     :where [= [id] id]
+                                     :av-pairs `((spam_p "f"))))
+                   (when (and id type acceptp (string= acceptp "f"))
+                     (update-records table
+                                     :where [= [id] id]
+                                     :av-pairs `((spam_p "t")))))
+                 (show-moderation-page)))
+    (otherwise (show-web-journal)))
+  #.(restore-sql-reader-syntax-state))
 
 
 (defun dispatch-user-action ()