| 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 | (defmacro parse-feed ((feed-string feed-type) &body make-entry) |
|---|
| 13 | "a convenience macro that captures key parsing elements for |
|---|
| 14 | feeds. As body it takes the action to be performed on each entry in |
|---|
| 15 | the feed (usually a register-entry statement)" |
|---|
| 16 | `(let* |
|---|
| 17 | ((feed-dom |
|---|
| 18 | (dom:document-element |
|---|
| 19 | (cxml:parse-rod ,feed-string (cxml-dom:make-dom-builder)))) |
|---|
| 20 | (feed |
|---|
| 21 | (make-instance ,feed-type |
|---|
| 22 | :id (xpath-fn-string |
|---|
| 23 | (xpath-single-child-elem-by-qname |
|---|
| 24 | feed-dom |
|---|
| 25 | *atom-ns* "id")) |
|---|
| 26 | ;;TODO: verify if that is a good idea |
|---|
| 27 | :tm-id (xpath-fn-string |
|---|
| 28 | (xpath-single-child-elem-by-qname |
|---|
| 29 | feed-dom |
|---|
| 30 | *atom-ns* "id")) |
|---|
| 31 | :link |
|---|
| 32 | (get-attribute |
|---|
| 33 | (xpath-single-child-elem-by-qname feed-dom *atom-ns* "link") |
|---|
| 34 | "href") |
|---|
| 35 | :source-locator-prefix (xpath-fn-string |
|---|
| 36 | (xpath-single-child-elem-by-qname |
|---|
| 37 | feed-dom |
|---|
| 38 | *egovpt-ns* "ServerSrcLocatorPrefix"))))) |
|---|
| 39 | (loop for entry-elem across |
|---|
| 40 | (xpath-child-elems-by-qname feed-dom |
|---|
| 41 | *atom-ns* "entry") |
|---|
| 42 | do |
|---|
| 43 | ,@make-entry) |
|---|
| 44 | feed)) |
|---|
| 45 | |
|---|
| 46 | |
|---|
| 47 | (defun parse-fragments-feed (fragment-feed-string) |
|---|
| 48 | (parse-feed (fragment-feed-string 'fragments-feed) |
|---|
| 49 | (register-entry |
|---|
| 50 | feed |
|---|
| 51 | (make-instance 'fragment-entry |
|---|
| 52 | :id (xpath-fn-string |
|---|
| 53 | (xpath-single-child-elem-by-qname entry-elem *atom-ns* "id")) |
|---|
| 54 | :link |
|---|
| 55 | (get-attribute |
|---|
| 56 | (xpath-single-child-elem-by-qname entry-elem *atom-ns* "link") |
|---|
| 57 | "href") |
|---|
| 58 | :psi |
|---|
| 59 | (xpath-fn-string |
|---|
| 60 | (xpath-single-child-elem-by-qname entry-elem *egovpt-ns* "TopicSI")))))) |
|---|
| 61 | |
|---|
| 62 | (defun parse-snapshots-feed (fragment-feed-string) |
|---|
| 63 | (parse-feed (fragment-feed-string 'snapshots-feed) |
|---|
| 64 | (register-entry |
|---|
| 65 | feed |
|---|
| 66 | (make-instance 'snapshot-entry |
|---|
| 67 | :id (xpath-fn-string |
|---|
| 68 | (xpath-single-child-elem-by-qname entry-elem *atom-ns* "id")) |
|---|
| 69 | :link |
|---|
| 70 | (get-attribute |
|---|
| 71 | (xpath-single-child-elem-by-qname entry-elem *atom-ns* "link") |
|---|
| 72 | "href"))))) |
|---|
| 73 | |
|---|
| 74 | |
|---|
