diff options
Diffstat (limited to 'mulkcms.lisp')
| -rw-r--r-- | mulkcms.lisp | 91 |
1 files changed, 57 insertions, 34 deletions
diff --git a/mulkcms.lisp b/mulkcms.lisp index 546283d..ee236fb 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -4,6 +4,8 @@ (list *database-name* *database-user* *database-password* *database-host* :pooled-p t :use-ssl :try)) +(defvar *requested-characteristics*) + (unless (member "html-human-date" *template-formatters* :key #'car :test #'equal) (setq *template-formatters* (list* (cons "html-human-date" 'format-human-date) @@ -74,12 +76,8 @@ (string= "true" (apply #'akismet-check-comment comment-data))))) -(defun requested-characteristics () - nil) - - -(defun call-with-cache (path last-update content-type thunk) - (let* ((chars (requested-characteristics)) +(defun call-with-cache (path last-update content-type characteristics thunk) + (let* ((chars characteristics) (charstring (prin1-to-string chars)) (charbytes (flexi-streams:string-to-octets charstring @@ -117,8 +115,9 @@ generated-content)))) -(defmacro with-cache ((path last-update &optional content-type) &body body) - `(call-with-cache ,path ,last-update ,content-type +(defmacro with-cache ((path last-update &optional content-type characteristics) + &body body) + `(call-with-cache ,path ,last-update ,content-type ,characteristics (lambda () ,@body))) @@ -300,6 +299,7 @@ (format out "ROW(~A, ~A)::characteristic" (sql-escape (car ch)) (sql-escape (cdr ch)))) + (setq first2-p t) (format out "])")) (format out "]::characteristic_list[])"))) @@ -444,7 +444,11 @@ ORDER BY min(date) DESC" :column) -(defun find-journal-archive-request-handler (path full-p &optional action characteristics) +(defun find-journal-archive-request-handler (path full-p + &optional + action + (characteristics + *requested-characteristics*)) (declare (ignore action)) (when (member path '("journal" "journal/" "feed" "feed/" @@ -457,8 +461,9 @@ (if (member path '("feed" "feed/" "journal/feed" "journal/feed") :test #'string=) - "application/atom+xml; charset=utf-8" - "text/html; charset=utf-8")) + "application/atom+xml; charset=UTF-8" + "text/html; charset=UTF-8") + characteristics) (let* (#+portable-mulkcms (articles (find-journal-articles)) #+portable-mulkcms @@ -661,7 +666,11 @@ (char= (char string (1- (length string))) #\}))) (parse-row-or-array string)) -(defun find-article-summary-handler (path params &optional action characteristics) +(defun find-article-summary-handler (path params + &optional + action + (characteristics + *requested-characteristics*)) (declare (ignore characteristics action)) (when (string= path "admin/articles") (lambda () @@ -757,7 +766,11 @@ (values char value))) -(defun find-article-request-handler (path params &optional action characteristics) +(defun find-article-request-handler (path params + &optional + action + (characteristics + *requested-characteristics*)) (with-db (when-let ((article (query "SELECT article FROM article_aliases WHERE alias = $1" @@ -866,11 +879,14 @@ (:view (lambda () (with-db - (with-cache (path (query "SELECT max(date) - FROM article_revisions - WHERE article = $1" - article - :single)) + (with-cache (path + (query "SELECT max(date) + FROM article_revisions + WHERE article = $1" + article + :single) + "text/html; charset=UTF-8" + characteristics) (let* ((page-template-name (query "SELECT page_template FROM articles JOIN article_types ON articles.type = article_types.id @@ -984,19 +1000,26 @@ (defun find-request-handler (path params) - (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) - (t :view))) - (find-article-request-handler - path - params - (cond ((assoc "edit" params :test #'equal) :edit) - ((assoc "comment-feed" params :test #'equal) :view-comment-feed) - ((assoc "atom" params :test #'equal) :view-atom-entry) - (t :view))) - (find-transaction-key-handler path))) + (let ((*requested-characteristics* + (append (when-let (langstr (or (cdr (assoc "lang" params :test #'equal)) + (cdr (assoc "hl" params :test #'equal)))) + (let ((langs (split-sequence #\| langstr))) + (mapcar (lambda (x) (list (cons "language" x))) + langs))) + *default-characteristics-precedence-list*))) + (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) + (t :view))) + (find-article-request-handler + path + params + (cond ((assoc "edit" params :test #'equal) :edit) + ((assoc "comment-feed" params :test #'equal) :view-comment-feed) + ((assoc "atom" params :test #'equal) :view-atom-entry) + (t :view))) + (find-transaction-key-handler path)))) |