diff options
| -rw-r--r-- | main.lisp | 52 |
1 files changed, 29 insertions, 23 deletions
@@ -250,11 +250,11 @@ (format t "<?xml version=\"1.0\" encoding=\"utf-8\"?>~&<response>~&<error>1</error>~&<message>No URI was provided.</message>~&</response>")))))) (:view-atom-entry (with-wsse-authentication () - (cond ((string= *method* "GET") + (cond ((eq *method* :get) (if *post-number* (show-atom-entry) (show-atom-feed :include-edit-links t :full-content t))) - ((member *method* '("POST" "PUT") :test 'equal) + ((member *method* '(:post :put)) (with-transaction () (let* ((entry (if (string= *method* "PUT") (find-entry *post-number*) @@ -268,27 +268,33 @@ (when (string= *method* "PUT") (setf (last-modification-of entry) (get-universal-time))) - (let* ((post-data (with-output-to-string (out) - (loop for line = (read-line *standard-input* nil nil nil) - while line - do (write-line line out)))) - (xml (xmls:parse post-data)) - (entry-elements (cddr xml)) - (content-element (find "content" entry-elements :key 'car :test 'equal)) - (content (caddr content-element)) - (title-element (find "title" entry-elements :key 'cat :test 'equal)) - (content-type (cadr (assoc "type" (cadr content-element)))) - (content-mode (cadr (assoc "type" (cadr content-element))))) - (when content-element - (setf (body-of entry) (etypecase content - (null "") - (cons (xmls:toxml content :indent t)) - (string content)))) - (when title-element - (setf (title-of entry) (or (caddr title-element) ""))) - (setf (entry-type-of entry) "html")) - (update-records-from-instance entry))) - (show-atom-entry))))) + (flet ((tag-equal (tag1 tag2) + (equal (if (consp tag1) (car tag1) tag1) + (if (consp tag2) (car tag2) tag2)))) + (let* ((post-data (with-output-to-string (out) + (loop for line = (read-line *standard-input* nil nil nil) + while line + do (write-line line out)))) + (xml (xmls:parse post-data)) + (entry-elements (cddr xml)) + (content-element (find "content" entry-elements :key 'car :test #'tag-equal)) + (content (caddr content-element)) + (title-element (find "title" entry-elements :key 'car :test #'tag-equal)) + (title-type (cadr (assoc "type" (cadr title-element)))) + (content-type (cadr (assoc "type" (cadr content-element)))) + (content-mode (cadr (assoc "type" (cadr content-element))))) + (when content-element + (setf (body-of entry) (etypecase content + (null "") + (cons (xmls:toxml content :indent t)) + (string content)))) + (when title-element + (setf (title-of entry) (or (caddr title-element) ""))) + (setf (entry-type-of entry) "html"))) + (update-records-from-instance entry) + (setq *post-number* (id-of entry)))) + (show-atom-entry)) + (t (debug-log "Oops. Method was:") (debug-log *method*))))) (:view-atom-feed (show-atom-feed)) (:view-comment-feed (show-comment-feed)) (:view-debugging-page (show-debugging-page)) |