diff options
| -rwxr-xr-x | main.scm | 54 | ||||
| -rw-r--r-- | module/rss-filter.scm | 45 | ||||
| -rw-r--r-- | module/rss-filter/feed-handler.scm (renamed from feed-handler.scm) | 2 |
3 files changed, 49 insertions, 52 deletions
@@ -2,63 +2,15 @@ -e main -s !# -;; (add-to-load-path ".") -(add-to-load-path (dirname (current-filename))) +(add-to-load-path (string-append (dirname (current-filename)) "/module")) (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) - + (ice-9 getopt-long) ((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))) - + ((rss-filter) :select (handle-feed))) - (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 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))))))))) diff --git a/feed-handler.scm b/module/rss-filter/feed-handler.scm index 1096fd4..eef1ca7 100644 --- a/feed-handler.scm +++ b/module/rss-filter/feed-handler.scm @@ -1,4 +1,4 @@ -(define-module (feed-handler) +(define-module (rss-filter feed-handler) :use-module (rnrs records syntactic) :use-module (sxml simple) :use-module (sxml transform) |