| 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 snapshots-feed (feed) |
|---|
| 13 | ((source-locator-prefix :accessor source-locator-prefix |
|---|
| 14 | :initarg :source-locator-prefix |
|---|
| 15 | :type string) |
|---|
| 16 | (tm-id :accessor tm-id |
|---|
| 17 | :initarg :tm-id |
|---|
| 18 | :type string))) |
|---|
| 19 | |
|---|
| 20 | (defclass snapshot-entry (entry) |
|---|
| 21 | () |
|---|
| 22 | (:documentation "a snapshot in a snapshot feed")) |
|---|
| 23 | |
|---|
| 24 | (defmethod entry-to-elem ((entry snapshot-entry)) |
|---|
| 25 | (to-link (link entry) "alternate" "application/x-tm+xml;version=1.0")) |
|---|
| 26 | |
|---|
| 27 | (defmethod feed-to-elem ((feed snapshots-feed)) |
|---|
| 28 | (setf (updated feed) (get-most-recent-datetime-for-tm (tm-id feed))) |
|---|
| 29 | (to-elem "e:ServerSrcLocatorPrefix" (source-locator-prefix feed))) |
|---|
| 30 | |
|---|
| 31 | (defmethod entries ((feed snapshots-feed)) |
|---|
| 32 | (loop for revision in (d:get-all-revisions-for-tm (tm-id feed)) |
|---|
| 33 | collect |
|---|
| 34 | (let |
|---|
| 35 | ((link |
|---|
| 36 | (format nil "~a/~a" (link feed) revision))) |
|---|
| 37 | (make-instance 'snapshot-entry |
|---|
| 38 | :id link |
|---|
| 39 | :title (format nil "Snapshot ~a" revision) |
|---|
| 40 | :updated (datetime-in-iso-format revision) |
|---|
| 41 | :link link |
|---|
| 42 | :path (format nil "~a/~a" (path feed) revision))))) |
|---|
| 43 | |
|---|
| 44 | ;; (defun build-snapshots-feed (tm-id) |
|---|
| 45 | ;; "Build a feed of snapshots for the Topic Map with the given tm-id |
|---|
| 46 | ;; from the revisions in the engine" |
|---|
| 47 | ;; ;Strings to be replaced by configuration options in a config file |
|---|
| 48 | ;; (loop for revision in (d:get-all-revisions-for-tm tm-id) |
|---|
| 49 | ;; collect |
|---|
| 50 | ;; (let |
|---|
| 51 | ;; ((link |
|---|
| 52 | ;; (format nil "~a~a" (link *testtm-snapshots-feed*) |
|---|
| 53 | ;; revision))) |
|---|
| 54 | ;; (register-entry |
|---|
| 55 | ;; *testtm-snapshots-feed* |
|---|
| 56 | ;; (make-instance 'snapshot-entry |
|---|
| 57 | ;; :title (format nil "Snapshot ~a" revision) |
|---|
| 58 | ;; :updated (datetime-in-iso-format revision) |
|---|
| 59 | ;; :link link |
|---|
| 60 | ;; :path (format nil "~a" revision))))) |
|---|
| 61 | |
|---|
| 62 | ;; (feed-to-elem *testtm-snapshots-feed*)) |
|---|
