From 72fa1bd1c400430a21ac284db832a3e2fc2c1599 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sat, 27 Nov 2021 18:12:53 +0100
Subject: Working.

---
 main.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 44 insertions(+), 9 deletions(-)

(limited to 'main.scm')

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))
+        )))))
-- 
cgit v1.2.3