summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2009-10-08 15:13:47 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2009-10-08 15:13:47 +0200
commit28c73ca74250aa95438f6ae88dcde759df225336 (patch)
tree1838ced159fee4525d8e1f598bbe72325be4f752
parentb78afdb907940e989129845be28888f3dbc8b297 (diff)
Add a comment and trackback moderation page.
Ignore-this: 45d484506c4f5f4b0560f6397e5b61a2 darcs-hash:9cc1720d761894eff92ca76970a7c750dccc69d1
-rwxr-xr-xjournal.lisp115
-rw-r--r--main.lisp21
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 ()