blob: 0bba5c661a2b20676b2f138442aea194b1efad7a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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))))
|
