blob: eef1ca72df942d5d8fd7370ee13fed29c7849046 (
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
|
(define-module (rss-filter feed-handler)
:use-module (rnrs records syntactic)
:use-module (sxml simple)
:use-module (sxml transform)
:use-module (sxml xpath)
:export (make-feed feed-url feed-transformer
parse-rss filter-tree))
(define-record-type feed
(fields url transformer))
(define rss-namespaces
'((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
(dc . "http://purl.org/dc/elements/1.1/")
(syn . "http://purl.org/rss/1.0/modules/syndication/")
(rss . "http://purl.org/rss/1.0/")
(atom . "http://www.w3.org/2005/Atom")
(#f . "http://purl.org/rss/1.0/")
))
(define (parse-rss port)
(xml->sxml port #:namespaces rss-namespaces))
(define (namespaces->sxml namespaces)
(map (lambda (namespace)
(list (string->symbol
(if (not (car namespace))
"xmlns"
(string-append "xmlns:" (symbol->string (car namespace)))))
(cdr namespace)))
namespaces))
(define (filter-tree transformers tree)
(pre-post-order
tree
`(,@transformers
(rdf:RDF . ,(lambda (tag . children)
(cond (((sxpath '(@)) (cons tag children))
(negate null?)
=> (lambda (attributes)
(write attributes (current-error-port)) (newline (current-error-port))
`(,tag
(@ ,@(namespaces->sxml rss-namespaces)
,@(cdar attributes))
,@(cdr children))))
(else
`(,tag (@ ,@(namespaces->sxml rss-namespaces))
,@(cdr children))))))
(*text* . ,(lambda (_ x . xs) x))
(*default* . ,(lambda (item . children)
(cons item children))))) )
|
