diff options
Diffstat (limited to 'main.scm')
| -rwxr-xr-x | main.scm | 53 |
1 files changed, 44 insertions, 9 deletions
@@ -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)) + ))))) |