Move stuff to module dir.

1 files changed, 45 insertions, 0 deletions

diff --git a/module/rss-filter.scm b/module/rss-filter.scm
new file mode 100644
index 0000000..748fa77
--- /dev/null
+++ b/module/rss-filter.scm
@@ -0,0 +1,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)))))))))