summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--xml-rpc-functions.lisp44
1 files changed, 27 insertions, 17 deletions
diff --git a/xml-rpc-functions.lisp b/xml-rpc-functions.lisp
index 55363a7..6851c84 100644
--- a/xml-rpc-functions.lisp
+++ b/xml-rpc-functions.lisp
@@ -28,9 +28,11 @@
(defun mulk.journal.xml-rpc::metaWeblog.newPost (blogid username password struct publish)
(declare (ignore blogid username publish))
(flet ((do-stuff ()
- (with-slots (categories pub-date guid description link comments title)
- struct
- (create-or-edit-post description title))))
+ (let ((props (xml-rpc-struct-alist struct)))
+ (assert (cdr (assoc :DESCRIPTION props)))
+ (assert (cdr (assoc :TITLE props)))
+ (create-or-edit-post (cdr (assoc :DESCRIPTION props))
+ (cdr (assoc :TITLE props))))))
(cond ((string= password *xml-rpc-key*) (do-stuff))
(t (with-wsse-authentication () (do-stuff))))))
@@ -41,31 +43,38 @@
(string (parse-integer postid))
(number postid)))
(flet ((do-stuff ()
- (with-slots (categories pub-date guid description link comments title)
- struct
- (create-or-edit-post description title :post-id postid))))
+ (let ((props (xml-rpc-struct-alist struct)))
+ (assert (cdr (assoc :DESCRIPTION props)))
+ (assert (cdr (assoc :TITLE props)))
+ (create-or-edit-post (cdr (assoc :DESCRIPTION props))
+ (cdr (assoc :TITLE props))
+ :post-id postid))))
(cond ((string= password *xml-rpc-key*) (do-stuff))
(t (with-wsse-authentication () (do-stuff))))))
-(defun mulk.journal.xml-rpc::metaWeblog.getPost (postid username password)
- (declare (ignore username password))
- (setq postid (etypecase postid
- (string (parse-integer postid))
- (number postid)))
+(defun convert-entry-to-rss-item (entry)
(with-slots (title date body categories last-modification id uuid)
- (find-entry postid)
+ entry
(xml-rpc-struct :CATEGORIES (map 'vector #'uuid-of categories)
:pubDate (xml-rpc-time date)
:GUID uuid
:POSTID (format nil "~D" id)
- :DESCRIPTION (htmlise-entry (find-entry postid))
- :LINK (link-to :view :post-id postid :absolute t)
- :permaLink (link-to :view :post-id postid :absolute t)
- :COMMENTS (link-to :view :post-id postid :absolute t)
+ :DESCRIPTION (htmlise-entry entry)
+ :LINK (link-to :view :post-id id :absolute t)
+ :permaLink (link-to :view :post-id id :absolute t)
+ :COMMENTS (link-to :view :post-id id :absolute t)
:TITLE title)))
+(defun mulk.journal.xml-rpc::metaWeblog.getPost (postid username password)
+ (declare (ignore username password))
+ (setq postid (etypecase postid
+ (string (parse-integer postid))
+ (number postid)))
+ (convert-entry-to-rss-item (find-entry postid)))
+
+
(defun mulk.journal.xml-rpc::metaWeblog.getCategories (blogid username password)
(declare (ignore blogid username password))
#())
@@ -104,7 +113,8 @@
(setf (entry-type-of entry) (or entry-type "html"))
(update-records-from-instance entry)
;; Update static files.
- (update-journal))))
+ (update-journal)
+ (convert-entry-to-rss-item entry))))
(defun mulk.journal.xml-rpc::|pingback.ping| (source-uri target-uri)