iens

commit 49392aadbbb511c7c463e29fff7d6685f098dd6e
parent eaf1758f70db117b1156833787cf5678143c6236
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date:   Sun, 10 May 2026 19:38:20 +0000

Feed generation primitives are shared
Diffstat:
M
src/common.scm
 | 
61
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/iens.scm
 | 
52
+---------------------------------------------------

2 files changed, 62 insertions(+), 51 deletions(-)
diff --git a/src/common.scm b/src/common.scm
@@ -178,3 +178,64 @@
     (if result
         result
         default-value)))
+
+;;;;;;;;;;;;;;;;;;;;
+;; Feed Generation
+
+(define (atom-content type descr notes)
+  (cond ((null? descr) `(atom:content ,notes))
+        ((null? type)  `(atom:content ,descr))
+        ((equal? type "markdown-li")
+          (let ((acc (open-output-string))
+                (prev-output (current-output-port)))
+            (current-output-port acc)
+            (let ((result (markdown->html (substring descr 3))))
+              (current-output-port prev-output)
+              (if result
+                  `(atom:content (@ (type "html")) ,(get-output-string acc))
+                  `(atom:content ,descr)))))
+        (else `(atom:content (@ (type ,type)) ,descr))))
+
+(define (feed->sxml entry-id-prefix id url type descr notes ptime ctime mtime)
+  `(atom:entry
+     (atom:id ,(string-append entry-id-prefix (number->string id)))
+     (atom:title ,url)
+     (atom:updated ,(rfc-3339 mtime))
+     (atom:published ,(rfc-3339 (if (null? ptime) ctime ptime)))
+     (atom:link (@ (rel "related") (href ,url)))
+     ,(atom-content type descr notes)
+     ,@(query (map-rows (lambda (x) `(atom:category (@ (term ,(car x))))))
+              (sql db "SELECT tag.name FROM tagrel
+                       OUTER LEFT JOIN tag ON tagrel.tag_id=tag.id
+                       WHERE url_id=? ORDER BY tag.name;")
+              id)))
+
+(define (optional-feed-element key value)
+  (if value (list (list key value)) '()))
+
+(define (write-feed mtime title self rows)
+  (let ((author-name  (get-config/default "author-name" "Unknown Author"))
+        (author-email (get-config         "author-email"))
+        (author-uri   (get-config         "author-uri"))
+        (id-prefix    (get-config/default "entry-id-prefix" "")))
+    (write-string
+      (serialize-sxml
+        `(*TOP* (@ (*NAMESPACES* (atom "http://www.w3.org/2005/Atom")))
+           (*PI* xml "version='1.0' encoding='utf-8'")
+           (atom:feed
+             (atom:title ,title)
+             (atom:author
+               (atom:name ,author-name)
+               ,@(optional-feed-element 'atom:email author-email)
+               ,@(optional-feed-element 'atom:uri   author-uri))
+             (atom:id ,self)
+             (atom:link (@ (rel "self") (href ,self)))
+             (atom:updated ,(rfc-3339 mtime))
+             ,@(map (lambda (r) (apply feed->sxml (cons id-prefix r))) rows)))
+        ns-prefixes: '((*default* . "http://www.w3.org/2005/Atom"))))))
+
+(define (feed-rows selector)
+  (query fetch-rows
+         (sql/transient db (string-append "SELECT id,url,type,description,
+                                                  notes,ptime,ctime,mtime
+                                           FROM entry " selector ";"))))
diff --git a/src/iens.scm b/src/iens.scm
@@ -1245,58 +1245,8 @@
 ;;;;;;;;;;;;;;;;;;;;
 ;; Feed Generation
 
-(define (atom-content type descr notes)
-  (cond ((null? descr) `(atom:content ,notes))
-        ((null? type)  `(atom:content ,descr))
-        ((equal? type "markdown-li")
-          (let ((acc (open-output-string))
-                (prev-output (current-output-port)))
-            (current-output-port acc)
-            (let ((result (markdown->html (substring descr 3))))
-              (current-output-port prev-output)
-              (if result
-                  `(atom:content (@ (type "html")) ,(get-output-string acc))
-                  `(atom:content ,descr)))))
-        (else `(atom:content (@ (type ,type)) ,descr))))
-
-(define (feed->sxml id url type descr notes ptime ctime mtime)
-  `(atom:entry
-     (atom:id ,(string-append config-entry-id-prefix (number->string id)))
-     (atom:title ,url)
-     (atom:updated ,(rfc-3339 mtime))
-     (atom:published ,(rfc-3339 (if (null? ptime) ctime ptime)))
-     (atom:link (@ (rel "related") (href ,url)))
-     ,(atom-content type descr notes)
-     ,@(query (map-rows (lambda (x) `(atom:category (@ (term ,(car x))))))
-              (sql db "SELECT tag.name FROM tagrel
-                       OUTER LEFT JOIN tag ON tagrel.tag_id=tag.id
-                       WHERE url_id=? ORDER BY tag.name;")
-              id)))
-
-(define (write-feed mtime title self rows)
-  (write-string
-    (serialize-sxml
-      `(*TOP* (@ (*NAMESPACES* (atom "http://www.w3.org/2005/Atom")))
-         (*PI* xml "version='1.0' encoding='utf-8'")
-         (atom:feed
-           (atom:title ,title)
-           (atom:author
-             (atom:name ,(if config-author-name
-                             config-author-name
-                             "Unknown Author"))
-             ,@(if config-author-email `((atom:email ,config-author-email)) '())
-             ,@(if config-author-uri `((atom:uri ,config-author-uri)) '()))
-           (atom:id ,self)
-           (atom:link (@ (rel "self") (href ,self)))
-           (atom:updated ,(rfc-3339 mtime))
-           ,@(map (lambda (row) (apply feed->sxml row)) rows)))
-      ns-prefixes: '((*default* . "http://www.w3.org/2005/Atom")))))
-
 (define (generate-feed forced feed-id filename url selector title mtime)
-  (let* ((rows (query fetch-rows
-                      (sql db (string-append "SELECT id,url,type,description,
-                                                     notes,ptime,ctime,mtime
-                                              FROM entry " selector ";"))))
+  (let* ((rows (feed-rows selector)))
          (generate?
            (cond ((null? rows)
                    (when config-verbose