summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--mulkcms-hunchentoot.lisp8
-rw-r--r--mulkcms.lisp132
-rw-r--r--schema.sql15
-rw-r--r--static-files/style/admin.css40
-rw-r--r--templates/article_summary_page.html44
5 files changed, 220 insertions, 19 deletions
diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp
index befdc09..5562fba 100644
--- a/mulkcms-hunchentoot.lisp
+++ b/mulkcms-hunchentoot.lisp
@@ -1,10 +1,5 @@
(in-package #:mulkcms-hunchentoot)
-#+(or)
-(define-easy-handler handle-admin-request (action)
- ;; XXX
- )
-
(defun dispatch-static-file-request (request)
(let* ((relative-path (subseq (script-name request) 1))
(file (merge-pathnames relative-path *static-files*)))
@@ -23,8 +18,7 @@
(defun setup-handlers ()
(setq *dispatch-table*
- (list* (create-prefix-dispatcher "/admin" 'handle-admin-request)
- 'dispatch-mulkcms-request
+ (list* 'dispatch-mulkcms-request
'dispatch-static-file-request
*dispatch-table*))
(setq *default-handler*
diff --git a/mulkcms.lisp b/mulkcms.lisp
index 9df7237..b2c88d3 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -18,7 +18,7 @@
article
:single))
-(defun link-to (action &key comment-id article-id (absolute nil))
+(defun link-to (action &key comment-id article-id revision-id (absolute nil))
;; Taken from Mulkblog.
(with-output-to-string (out)
(format out "~A" (if absolute *base-uri* ""))
@@ -35,7 +35,8 @@
(article-id (values "/~A" article-base))
(t "/")))
(:view-comments (values "/~A#comments" article-base))
- ((:edit :preview) (values "/~A?edit" article-base))
+ ((:edit :preview) (cond (revision-id (values "/~A?edit&revision=~D" article-base revision-id))
+ (t (values "/~A?edit" article-base))))
(:post-comment (values "/~A" article-base))
(:trackback (values "/~A?trackback" article-base))
(:view-atom-entry (values "/~A?atom" article-base))
@@ -407,11 +408,11 @@
(with-db
(let ((user-id (query (format nil
"SELECT id
- FROM users u
- JOIN passwords p ON u.id = p.user
- WHERE p.password = $2
- AND u.name = $1
- AND ~A"
+ FROM users u
+ JOIN passwords p ON u.id = p.user
+ WHERE p.password = $2
+ AND u.name = $1
+ AND ~A"
(ecase require
((nil) "true")
((:admin) "u.status = 'admin'")
@@ -424,6 +425,111 @@
(funcall thunk user-id)
(hunchentoot:require-authorization "MulkCMS"))))))
+(defun parse-row-or-array (string)
+ (let ((output (list)))
+ (with-input-from-string (in string)
+ (read-char in)
+ (loop for char = (read-char in nil nil nil)
+ while (and char (not (member char (list #\} #\)))))
+ do (push (with-output-to-string (out)
+ (if (char= char #\")
+ (loop for c = (read-char in)
+ if (char= c #\\)
+ do (format out "~C" (read-char in))
+ else if (member c (list #\"))
+ do (if (char= (peek-char nil in) #\")
+ (progn
+ (format out "\"")
+ (read-char in))
+ (progn
+ (read-char in)
+ (return)))
+ else
+ do (format out "~C" c))
+ (progn
+ (format out "~C" char)
+ (loop for c = (read-char in)
+ until (member c (list #\) #\, #\}))
+ do (format out "~C" c)))))
+ output)))
+ (nreverse output)))
+
+(defun parse-row (string)
+ (assert (and (char= (char string 0) #\()
+ (char= (char string (1- (length string))) #\))))
+ (parse-row-or-array string))
+
+(defun parse-array (string)
+ (assert (and (char= (char string 0) #\{)
+ (char= (char string (1- (length string))) #\})))
+ (parse-row-or-array string))
+
+(defun find-article-summary-handler (path params &optional action characteristics)
+ (declare (ignore characteristics params action))
+ (print path)
+ (when (string= path "admin/articles")
+ (lambda ()
+ (with-authorization (user-id :require :admin)
+ (declare (ignore user-id))
+ (with-db
+ (labels ((paramify-revision-row (row article-id)
+ (destructuring-bind (id title date characteristics)
+ row
+ (list :id id
+ :title title
+ :date date
+ :link (link-to :edit :article-id article-id :revision-id id)
+ :characteristics (parse-array characteristics))))
+ (paramify-article-row (row)
+ (destructuring-bind (id revisions aliases)
+ row
+ (let ((revision-data (mapcar (lambda (x)
+ (paramify-revision-row x id))
+ (mapcar #'parse-row
+ (parse-array revisions)))))
+ (list :id id
+ :aliases aliases
+ :revisions revision-data
+ :revision-num (length revision-data))))))
+ (let* ((articles (query "SELECT a.id,
+ array_agg(DISTINCT
+ ROW(r.id,
+ r.title,
+ r.date,
+ r.characteristics)),
+ array_agg(DISTINCT aa.alias)
+ FROM articles a
+ LEFT OUTER JOIN article_aliases aa
+ ON aa.article = a.id
+ LEFT OUTER JOIN article_branch_tips bt
+ ON bt.article = a.id
+ LEFT OUTER JOIN
+ (SELECT r.id AS id,
+ r.title AS title,
+ r.date AS date,
+ array_agg(DISTINCT
+ ROW(ch.characteristic,
+ ch.value))
+ AS characteristics
+ FROM article_revisions r
+ LEFT OUTER JOIN article_revision_characteristics ch
+ ON ch.revision = r.id
+ GROUP BY r.id, r.title, r.date)
+ AS r
+ ON bt.revision = r.id
+ GROUP BY a.id"
+ :rows))
+ (article-data (mapcar #'paramify-article-row articles)))
+ (expand-page (template "article_summary_page")
+ "Articles"
+ (list :id-label "Article"
+ :aliases-label "Aliases"
+ :branch-label "Branch"
+ :branch-title-label "Title"
+ :characteristics-label "Characteristics"
+ :date-label "Date"
+ :articles article-data)))))))))
+
(defun find-article-request-handler (path params &optional action characteristics)
(with-db
(when-let ((article (query "SELECT article FROM article_aliases
@@ -445,7 +551,9 @@
(cdr (assoc "content" params :test #'equal))
user-id
"html"
- (if (hunchentoot:post-parameter "publish-p")
+ (if (assoc "publish-p"
+ params
+ :test #'equal)
"syndicated"
"draft")
:row)
@@ -462,9 +570,6 @@
(editor-template (template "edit_page")))
(assert (not (null revision)))
(when (assoc "save" params :test #'equal)
- (print (parse-integer (cdr (assoc "revision"
- params
- :test #'equal))))
(query "INSERT INTO article_revision_parenthood(parent, child)
VALUES ($1, $2)"
(parse-integer (cdr (assoc "revision"
@@ -521,7 +626,10 @@
(defun find-request-handler (path params)
- (or (find-journal-archive-request-handler
+ (or (find-article-summary-handler
+ path
+ params)
+ (find-journal-archive-request-handler
path
(assoc "full" params :test #'equal)
(cond ((assoc "feed" params :test #'equal) :view-feed)
diff --git a/schema.sql b/schema.sql
index 17de70a..6eb4141 100644
--- a/schema.sql
+++ b/schema.sql
@@ -275,6 +275,11 @@ CREATE AGGREGATE most_recent_revision (article_revisions) (
);
+CREATE OR REPLACE FUNCTION branch_tips(articles) AS $$
+
+$$ LANGUAGE SQL STABLE;
+
+
CREATE VIEW article_comment_counts AS
SELECT a.id AS article,
count(c.*) AS comment_count
@@ -296,4 +301,14 @@ CREATE VIEW article_publishing_dates AS
GROUP BY article;
+CREATE VIEW article_branch_tips AS
+ SELECT article AS article,
+ article_revisions.id AS revision
+ FROM (SELECT id FROM article_revisions
+ EXCEPT
+ SELECT parent FROM article_revision_parenthood)
+ AS branch_tips
+ JOIN article_revisions USING (id);
+
+
COMMIT;
diff --git a/static-files/style/admin.css b/static-files/style/admin.css
new file mode 100644
index 0000000..6ed0cb2
--- /dev/null
+++ b/static-files/style/admin.css
@@ -0,0 +1,40 @@
+table, td, th, tr.major-row {
+ border-color: #666;
+ border-width: 2px;
+}
+
+table {
+ border-collapse: collapse;
+ border-style: solid;
+}
+
+td, th {
+ border-right-style: solid;
+ border-left-style: solid;
+ border-top-style: none;
+ border-bottom-style: none;
+}
+
+tr.major-row {
+ border-top-style: solid;
+}
+
+tr.minor-row {
+ border-top-style: solid;
+ border-width: 2px;
+ border-color: #bbb;
+}
+
+table {
+ border-collapse: collapse
+}
+
+td {
+ vertical-align: top;
+ padding-left: 6px;
+ padding-right: 6px;
+}
+
+td.article-id, td.revision-id {
+ text-align: right;
+}
diff --git a/templates/article_summary_page.html b/templates/article_summary_page.html
new file mode 100644
index 0000000..f2b222a
--- /dev/null
+++ b/templates/article_summary_page.html
@@ -0,0 +1,44 @@
+{.section head}
+ <link href="/style/admin.css" rel="stylesheet" type="text/css"/>
+{.end}
+
+{.section body}
+<table>
+ <thead>
+ <th>{id-label}</th>
+ <th>{aliases-label}</th>
+ <th>{branch-label}</th>
+ <th>{branch-title-label}</th>
+ <th>{date-label}</th>
+ <th>{characteristics-label}</th>
+ </thead>
+
+ <tbody>
+ {.repeated section articles}
+ <tr class="major-row">
+ <td class="article-id"
+ rowspan="{revision-num|html-attr-value}">{id|html}</td>
+ <td class="article-aliases"
+ rowspan="{revision-num|html-attr-value}">
+ {.repeated section aliases}
+ {@|html}
+ {.alternates with}
+ <br />
+ {.end}
+ </td>
+ {.repeated section revisions}
+ <td class="revision-id">{id|html}</a></td>
+ <td class="revision-title">
+ <a href="{link|html-attr-value}">{title|html}</a>
+ </td>
+ <td class="revision-date">{date|html}</td>
+ <td class="revision-characteristics">{characteristics|html}</td>
+ {.alternates with}
+ </tr>
+ <tr class="minor-row">
+ {.end}
+ </tr>
+ {.end}
+ </tbody>
+</table>
+{.end}