blob: 748fa7711ea4544c7290cc93b2307e25c087ab6f (
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
|
(define-module (rss-filter)
:export (handle-feed)
:use-module (ice-9 curried-definitions)
:use-module (rss-filter feed-handler)
:use-module (web client)
:use-module (web response)
:use-module (sxml simple)
:use-module (sxml xpath)
:use-module (sxml namespace)
:use-module ((calp util) :select (path-append))
)
(define ((handle-feed output-directory quiet?) feed)
(define response
(begin
(when (not quiet?)
(format (current-error-port) "Fetching ~a~%" (feed-url feed)))
;; TODO follow redirects
(http-get (feed-url feed)
#:streaming? #t)))
(unless (= 200 (response-code response))
(format (current-error-port) "HTTP error ~a"
(response-code response))
(exit 1))
(let* ((feed-content (move-to-namespace (parse-rss (response-body-port response))
'((#f . rss))))
(feed-title (car ((sxpath '(// rss:channel rss:title *text*)) feed-content)))
(safe-title (string-map (lambda (c) (if (char-set-contains? char-set:letter+digit c)
c #\_))
feed-title)))
(let ((output (filter-tree (feed-transformer feed)
feed-content))
(filename (string-append
(path-append output-directory safe-title)
".rss")))
(with-output-to-file filename
(lambda ()
(sxml->xml
;; Removing the rss prefix should be fine, but at least NewNewsWire
;; (for iPad) expects all rss elements to be un-namespaced.
(move-to-namespace output '((rss . #f)))))))))
|
