blob: d38e7ea6adde75537e0c88cf6969a089828f6dc4 (
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
#!/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)
((xdg basedir) :prefix xdg-)
)
(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)))))))))
(define option-spec
`((output (single-char #\o)
(required? #f)
(value #t))
(help (single-char #\h))
(config-dir (required? #f)
(value #t))
(quiet (value #f))))
(define (display-help)
(format #t "Usage: ~a [--config-dir conf-dir] [--output /tmp/output]~%"
(car (command-line))))
(define (display-no-config config-dir)
(format #t "Configuration directory [~a] doesn't exist, or is unreadable~%"
config-dir))
(define (main args)
(define opts (getopt-long args option-spec))
(define output-directory (option-ref opts 'output "."))
(define config-dir
(option-ref opts 'config-dir
(path-append (xdg-config-home)
"rss-filter")))
(define quiet? (option-ref opts 'quiet #f))
(when (option-ref opts 'help #f)
(display-help)
(exit 0))
(unless (file-exists? config-dir)
(display-no-config config-dir)
(exit 1))
(add-to-load-path config-dir)
(for-each (handle-feed output-directory quiet?) (@ (config) feeds)))
|
