diff options
| -rw-r--r-- | mulkcms-hunchentoot.lisp | 8 | ||||
| -rw-r--r-- | mulkcms.lisp | 132 | ||||
| -rw-r--r-- | schema.sql | 15 | ||||
| -rw-r--r-- | static-files/style/admin.css | 40 | ||||
| -rw-r--r-- | templates/article_summary_page.html | 44 |
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) @@ -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} |