summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2009-10-09 00:21:57 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2009-10-09 00:21:57 +0200
commitb5c022c52d12ee814c51223b752229ed44718c3c (patch)
treed5ac440cc39488c68ce7499f8ffc124d2511a745
parentf1528c036b79ca90df67d2e84bb7c2c1d048c482 (diff)
Fix Atom posting and putting behaviour.
Ignore-this: 699e88b96861c768a840e5697d34d537 darcs-hash:f336d3040ad229cc6c7b6f1fbcfe70e30b774435
-rw-r--r--main.lisp52
1 files changed, 29 insertions, 23 deletions
diff --git a/main.lisp b/main.lisp
index 137c78d..88685e1 100644
--- a/main.lisp
+++ b/main.lisp
@@ -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))