diff options
| -rw-r--r-- | mulk-journal.asd | 3 | ||||
| -rw-r--r-- | xml-rpc-functions.lisp | 80 |
2 files changed, 82 insertions, 1 deletions
diff --git a/mulk-journal.asd b/mulk-journal.asd index 50bbaf0..92eee34 100644 --- a/mulk-journal.asd +++ b/mulk-journal.asd @@ -37,5 +37,6 @@ (:file "utils") (:file "journal-content") (:file "journal") - (:file "main")) + (:file "main") + (:file "xml-rpc-functions")) :serial t) diff --git a/xml-rpc-functions.lisp b/xml-rpc-functions.lisp new file mode 100644 index 0000000..0bba5c6 --- /dev/null +++ b/xml-rpc-functions.lisp @@ -0,0 +1,80 @@ +;;;; -*- coding: utf-8; mode: lisp -*- +;;;; Copyright 2009, Matthias Andreas Benkard. + +;;;------------------------------------------------------------------------ +;;; This file is part of The Mulkblog Project. +;;; +;;; The Mulkblog Project is free software. You can redistribute it and/or +;;; modify it under the terms of the Affero General Public License as +;;; published by Affero, Inc.; either version 1 of the License, or +;;; (at your option) any later version. +;;; +;;; The Mulkblog Project is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty +;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the Affero General Public +;;; License in the COPYING file that comes with The Mulkblog Project; if +;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San +;;; Francisco, CA 94107 USA. +;;;------------------------------------------------------------------------ + +(in-package #:mulk.journal) + +(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)))) + (cond ((string= password *xml-rpc-key*) (do-stuff)) + (t (with-wsse-authentication () (do-stuff)))))) + + +(defun mulk.journal.xml-rpc::|metaWeblog.editPost| (postid username password struct publish) + (declare (ignore username publish)) + (flet ((do-stuff () + (with-slots (categories pub-date guid description link comments title) + struct + (create-or-edit-post description title :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)) + (with-slots (title date body categories last-modification id uuid) + (find-entry postid) + (xml-rpc-struct :categories (mapcar #'uuid-of categories) + :pub-date (xml-rpc-time date) + :guid uuid + :description body + :link (link-to :view :post-id postid :absolute t) + :comments (link-to :view :post-id postid :absolute t) + :title title))) + + +(defun create-or-edit-post (body title &key entry-type post-id) + (with-transaction () + (let* ((entry (if post-id + (find-entry post-id) + (make-instance 'journal-entry + :id (make-journal-entry-id) + :uuid (make-uuid) + :date (get-universal-time) + :last-modification nil + :categories () + :comments ())))) + (unless post-id + (setf (last-modification-of entry) + (get-universal-time))) + (setf (body-of entry) (etypecase body + (null "") + (cons (xmls:toxml body :indent t)) + (string body))) + (setf (title-of entry) (or title "")) + (setf (entry-type-of entry) (or entry-type "html")) + (update-records-from-instance entry) + ;; Update static files. + (update-journal))))
\ No newline at end of file |