diff options
| -rwxr-xr-x | journal.lisp | 82 | ||||
| -rw-r--r-- | main.lisp | 2 |
2 files changed, 59 insertions, 25 deletions
diff --git a/journal.lisp b/journal.lisp index a4a6191..8324580 100755 --- a/journal.lisp +++ b/journal.lisp @@ -46,6 +46,7 @@ ((:edit :preview) (values "/~D/preview" post-id)) (:post-comment (values "/~D" post-id)) (:trackback (values "/~D/trackback" post-id)) + (:atom (values "/~D/atom" post-id)) (:save (values "/~D/save" post-id)) (:moderation-page "/moderate") (:css "/../journal.css"))))) @@ -124,6 +125,53 @@ #.(restore-sql-reader-syntax-state)) +(defun show-atom-entry () + #.(locally-enable-sql-reader-syntax) + (revalidate-cache-or-die "application/atom+xml; charset=UTF-8") + (http-add-header "Last-Modified" (http-timestamp (compute-journal-last-modified-date))) + (http-add-header "Content-Language" "de") + (http-send-headers "application/atom+xml; charset=UTF-8") + + (with-xml-output (*standard-output* :encoding "utf-8") + (show-atom-entry-xml journal-entry :full-content t))) + + +(defun show-atom-entry-xml (journal-entry &key full-content include-edit-links) + (flet ((atom-time (time) + (format-date nil + "%4yr%-%2mon%-%2day%T%2hr%:%2min%:%2secZ%" + time + 0))) + (with-xml-output (*standard-output* :encoding "utf-8") + (with-slots (title date body categories last-modification id) + journal-entry + (with-tag ("entry") + (emit-simple-tags :title title + :id (format nil "urn:uuid:~(~A~)" + (uuid-of journal-entry)) + :updated (atom-time (or last-modification date)) + :published (atom-time date)) + (with-tag ("link" `(("rel" "alternate") + ("type" "text/html") + ("href" ,(link-to :view + :post-id id + :absolute t))))) + (when include-edit-links + (with-tag ("link" `(("rel" "service.edit") + ("type" "application/atom+xml") + ("href" ,(link-to :view-atom-entry + :post-id id + :absolute t)) + ("title" ,title))))) + (when full-content + (with-tag ("content" `(("type" "xhtml") + ("xml:lang" "de") + ("xml:base" ,(link-to :index :absolute t)))) + (with-tag ("div" '(("xmlns" "http://www.w3.org/1999/xhtml"))) + (xml-as-is (journal-markup->html (body-of journal-entry)))))))))) + #.(restore-sql-reader-syntax-state)) + + (defun show-atom-feed () #.(locally-enable-sql-reader-syntax) (revalidate-cache-or-die "application/atom+xml; charset=UTF-8") @@ -166,31 +214,15 @@ (dolist (journal-entry (select 'journal-entry :order-by '(([date] :desc)) :flatp t)) - (incf number) - (with-slots (title date body categories last-modification id) - journal-entry - (with-tag ("entry") - (emit-simple-tags :title title - :id (format nil "urn:uuid:~(~A~)" - (uuid-of journal-entry)) - :updated (atom-time (or last-modification date)) - :published (atom-time date)) - (with-tag ("link" `(("rel" "alternate") - ("type" "text/html") - ("href" ,(link-to :view - :post-id id - :absolute t))))) - (when (or (and last-modification - (> last-modification (- (get-universal-time) - (* 30 24 60 60)))) - (<= number 8)) - ;; We only include the body for the most recent - ;; posts in order to save bandwidth. - (with-tag ("content" `(("type" "xhtml") - ("xml:lang" "de") - ("xml:base" ,(link-to :index :absolute t)))) - (with-tag ("div" '(("xmlns" "http://www.w3.org/1999/xhtml"))) - (xml-as-is (journal-markup->html (body-of journal-entry))))))))))))) + ;; We only include the body for the most recent posts in + ;; order to save bandwidth. + (show-atom-entry-xml journal-entry + :full-content (or (and (last-modification-of journal-entry) + (> (last-modification-of journal-entry) + (- (get-universal-time) + (* 30 24 60 60)))) + (<= number 8))) + (incf number)))))) #.(restore-sql-reader-syntax-state)) @@ -53,6 +53,7 @@ ((string= "trackback" (car (last *subpath*))) :post-trackback) ((string= "save" (car (last *subpath*))) :save-entry) ((string= "moderate" (car (last *subpath*))) :moderate) + ((string= "atom" (car (last *subpath*))) :view-atom-entry) (*post-number* :view) (t nil)))) (*method* (keywordify (gethash "REQUEST_METHOD" *http-env*))) @@ -242,6 +243,7 @@ (:view-atom-feed (show-atom-feed)) (:view-comment-feed (show-comment-feed)) (:view-debugging-page (show-debugging-page)) + (:view-atom-entry (show-atom-entry)) (otherwise (show-web-journal))) #.(restore-sql-reader-syntax-state)) |