summaryrefslogtreecommitdiff
path: root/main.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2021-11-27 18:12:53 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2021-11-27 18:12:53 +0100
commit72fa1bd1c400430a21ac284db832a3e2fc2c1599 (patch)
tree5109bd3f179b5c93ed910ccd6ea02deaae78da4c /main.scm
parentAdd --output option. (diff)
downloadrss-filter-72fa1bd1c400430a21ac284db832a3e2fc2c1599.tar.gz
rss-filter-72fa1bd1c400430a21ac284db832a3e2fc2c1599.tar.xz
Working.
Diffstat (limited to 'main.scm')
-rwxr-xr-xmain.scm53
1 files changed, 44 insertions, 9 deletions
diff --git a/main.scm b/main.scm
index ee3cd60..7ea1172 100755
--- a/main.scm
+++ b/main.scm
@@ -2,6 +2,8 @@
-e main -s
!#
+(add-to-load-path "/home/hugo/code/calp/module")
+
(use-modules
(web client)
(web response)
@@ -10,6 +12,9 @@
(sxml transform)
(ice-9 regex)
(ice-9 getopt-long)
+
+ ;; following are from calp
+ (sxml namespace)
)
@@ -24,18 +29,43 @@
(if (string-match "^\\[\\$\\]" title)
'() tag))))))))
+(define rss-namespaces
+ '((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
+ (dc . "http://purl.org/dc/elements/1.1/")
+ (syn . "http://purl.org/rss/1.0/modules/syndication/")
+ (rss . "http://purl.org/rss/1.0/")
+ (#f . "http://purl.org/rss/1.0/")
+ ))
+
(define (parse-rss port)
- (xml->sxml port
- #:namespaces
- '((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
- (dc . "http://purl.org/dc/elements/1.1/")
- (syn . "http://purl.org/rss/1.0/modules/syndication/")
- (rss . "http://purl.org/rss/1.0/"))) )
+ (xml->sxml port #:namespaces rss-namespaces))
+
+(define (namespaces->sxml namespaces)
+ (map (lambda (namespace)
+ (list (string->symbol
+ (if (not (car namespace))
+ "xmlns"
+ (string-append "xmlns:" (symbol->string (car namespace)))))
+ (cdr namespace)))
+ namespaces))
+
(define (filter-tree transformers tree)
(pre-post-order
tree
`(,@transformer
+ (rdf:RDF . ,(lambda (tag . children)
+ (cond (((sxpath '(@)) (cons tag children))
+ (negate null?)
+ => (lambda (attributes)
+ (write attributes (current-error-port)) (newline (current-error-port))
+ `(,tag
+ (@ ,@(namespaces->sxml rss-namespaces)
+ ,@(cdar attributes))
+ ,@(cdr children))))
+ (else
+ `(,tag (@ ,@(namespaces->sxml rss-namespaces))
+ ,@(cdr children))))))
(*text* . ,(lambda (_ x . xs) x))
(*default* . ,(lambda (item . children)
(cons item children))))) )
@@ -61,6 +91,11 @@
(with-output-to-file (option-ref opts 'output #f)
(lambda ()
(sxml->xml
- (filter-tree
- transformer
- (parse-rss (response-body-port response)))))))
+ ;; Removing the rss prefix should be fine, but at least NewNewsWire
+ ;; (for iPad) expects all rss elements to be un-namespaced.
+ (move-to-namespace
+ (filter-tree
+ transformer
+ (parse-rss (response-body-port response)))
+ '((rss . #f))
+ )))))