| 1 | ;;+----------------------------------------------------------------------------- |
|---|
| 2 | ;;+ Isidorus |
|---|
| 3 | ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff |
|---|
| 4 | ;;+ |
|---|
| 5 | ;;+ Isidorus is freely distributable under the LLGPL license. |
|---|
| 6 | ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and |
|---|
| 7 | ;;+ trunk/docs/LGPL-LICENSE.txt. |
|---|
| 8 | ;;+----------------------------------------------------------------------------- |
|---|
| 9 | |
|---|
| 10 | (in-package :atom) |
|---|
| 11 | |
|---|
| 12 | (defclass fragment-entry (entry) |
|---|
| 13 | ((summary :accessor summary :initarg :summary) |
|---|
| 14 | (psi :accessor psi :initarg :psi)) |
|---|
| 15 | (:documentation "a fragment in a fragment feed")) |
|---|
| 16 | |
|---|
| 17 | (defclass fragments-feed (feed) |
|---|
| 18 | ((source-locator-prefix :accessor source-locator-prefix |
|---|
| 19 | :initarg :source-locator-prefix |
|---|
| 20 | :type string) |
|---|
| 21 | (tm-id :accessor tm-id |
|---|
| 22 | :initarg :tm-id |
|---|
| 23 | :type string))) |
|---|
| 24 | |
|---|
| 25 | (defmethod entry-to-elem ((entry fragment-entry)) |
|---|
| 26 | (to-link (link entry) "alternate" "application/x-tm+xml;version=1.0") |
|---|
| 27 | (to-elem "a:summary" (summary entry)) |
|---|
| 28 | (to-elem "e:TopicSI" (psi entry))) |
|---|
| 29 | |
|---|
| 30 | (defmethod feed-to-elem ((feed fragments-feed)) |
|---|
| 31 | (setf (updated feed) (get-most-recent-datetime-for-tm (tm-id feed))) |
|---|
| 32 | (to-elem "e:ServerSrcLocatorPrefix" (source-locator-prefix feed))) |
|---|
| 33 | |
|---|
| 34 | (defmethod entries ((feed fragments-feed)) |
|---|
| 35 | "Unlike for the other feed types, entries can be calculated" |
|---|
| 36 | (remove |
|---|
| 37 | nil |
|---|
| 38 | (with-writer-lock |
|---|
| 39 | (loop for fragment in |
|---|
| 40 | (mapcan #'d:get-fragments (rest (d:get-all-revisions))) |
|---|
| 41 | collect |
|---|
| 42 | (let |
|---|
| 43 | ((tm (d:get-item-by-item-identifier (tm-id feed) :revision 0)) |
|---|
| 44 | (xtm-link (format nil "~a/~a" |
|---|
| 45 | (link feed) (d:unique-id fragment))) |
|---|
| 46 | (psi (d:uri (first (d:psis (d:topic fragment)))))) |
|---|
| 47 | (when (d:in-topicmap tm (d:topic fragment)) |
|---|
| 48 | (make-instance 'fragment-entry |
|---|
| 49 | :id xtm-link |
|---|
| 50 | :title psi |
|---|
| 51 | :psi psi |
|---|
| 52 | :path (format nil "~a/~a" (path feed) (d:unique-id fragment)) |
|---|
| 53 | :updated (datetime-in-iso-format (d:revision fragment)) |
|---|
| 54 | :link xtm-link |
|---|
| 55 | :summary (format nil "Fragment for topic ~a" psi)))))))) |
|---|
| 56 | |
|---|
| 57 | |
|---|
| 58 | ;; (defun build-fragments-feed (tm-id) |
|---|
| 59 | ;; "Build a feed of changes for the Topic Map identified by tm-id from the revisions in the engine" |
|---|
| 60 | ;; (loop for fragment in |
|---|
| 61 | ;; (mapcan #'d:get-fragments (rest (d:get-all-revisions))) |
|---|
| 62 | ;; collect |
|---|
| 63 | ;; (register-entry |
|---|
| 64 | ;; *testtm-fragments-feed* |
|---|
| 65 | ;; (let |
|---|
| 66 | ;; ((xtm-link (format nil "~a~a" |
|---|
| 67 | ;; (link *testtm-fragments-feed*) (d:unique-id fragment))) |
|---|
| 68 | ;; (psi (d:uri (first (d:psis (d:topic fragment)))))) |
|---|
| 69 | |
|---|
| 70 | ;; (make-instance 'fragment-entry |
|---|
| 71 | ;; :title psi |
|---|
| 72 | ;; :psi psi |
|---|
| 73 | ;; :path (format nil "~a" (d:unique-id fragment)) |
|---|
| 74 | ;; :updated (datetime-in-iso-format (d:revision fragment)) |
|---|
| 75 | ;; :xtm-link xtm-link |
|---|
| 76 | ;; :description (format nil "Fragment for topic with psi~a" psi))))) |
|---|
| 77 | ;; (feed-to-elem *testtm-fragments-feed*)) |
|---|
