blob: 6a842ae8f654f0dd31339ac498990cfc34ba3c05 (
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#!/usr/bin/guile \
-e main -s
!#
;; (add-to-load-path ".")
(add-to-load-path (dirname (current-filename)))
(add-to-load-path "/home/hugo/code/calp/module")
(use-modules
(web client)
(web response)
(sxml simple)
(sxml xpath)
(ice-9 getopt-long)
(ice-9 curried-definitions)
(ice-9 format)
;; following are from calp
(sxml namespace)
((calp util) :select (path-append))
(feed-handler)
)
(define option-spec
`((output (single-char #\o)
(required? #f)
(value #t))))
(define ((handle-feed output-directory) feed)
(define response
;; 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)))))))))
(define (main args)
(define opts (getopt-long args option-spec))
(define output-directory (option-ref opts 'output "."))
(for-each (handle-feed output-directory) (@ (config) feeds)))
|
