From e1c80f7e78950b8e5935863934862b15a1ee0f55 Mon Sep 17 00:00:00 2001
From: Jaidyn Levesque <10477760+JadedCtrl@users.noreply.github.com>
Date: Wed, 30 Nov 2022 22:32:03 -0600
Subject: [PATCH] Support for multi-file outputs (e.g, maildir)
---
feedsnake.scm | 66 +++++++++++++++++++++++++++++++++------------------
1 file changed, 43 insertions(+), 23 deletions(-)
diff --git a/feedsnake.scm b/feedsnake.scm
index c3bc035..ce25d1d 100644
--- a/feedsnake.scm
+++ b/feedsnake.scm
@@ -86,6 +86,7 @@
(define (entry->string entry template)
+ (print (entry-templating-parameters entry template))
(named-format
template
(append entry
@@ -154,7 +155,7 @@
(urls ,(map (lambda (link) (atom-link->string link atom))
(entry-links entry)))
(authors ,(if (null? entry-authors) feed-authors entry-authors))
- (feed-title ,(feed-title atom)))))
+ (feed-title ,(last (feed-title atom))))))
;; The preferred/given URL for an atom feed
@@ -200,7 +201,7 @@
;; The UNIX-style frontend for feedsnake
(module feedsnake-unix
- (update-feed-file latest-entries all-entries write-entry write-entries feed-files *mbox-template*)
+ (update-feed-file latest-entries all-entries write-entry write-entries entry-output-path feed-files *mbox-template* *maildir-template*)
(import scheme
(chicken base) (chicken condition) (chicken file) (chicken io)
@@ -208,6 +209,7 @@
srfi-1 srfi-19
date-strings
feedsnake feedsnake-helpers
+ named-format
xattr)
@@ -225,7 +227,7 @@
"~{{~A||localhost||TO_HOST||HOSTNAME}}>"
"\n"
"Subject: ~{{~A||Unnamed post||title}}\n"
- "Date: ~{{~A||||updated||published}}\n"
+ "Date: ~{{~A||||updated-rfc228||published-rfc228}}\n"
"\n"
"~{{~{~a~^, ~}~%***~%||||urls}}\n"
"~{{~A||||summary}}\n"))
@@ -239,16 +241,6 @@
"\n"))
(multifile-output? #f)))
-
-(define *html-template*
- `((entry-template
- "
~{{~A||Unnamed post||title}} ~{{~A||||updated}} ~{{~A||No summary||summary}}
")
- (multifile-output? #f)
- (output-header "\n\n\n~{{~A||Unnamed feed||title}}\n\n")
- (output-footer "")
- (multifile-output? #f)))
-
-
(define *default-template*
(append *maildir-template*
'((output-dir "./"))))
@@ -257,26 +249,27 @@
'((output-dir "./")))
(define *default-multifile-values*
- '((filename-template "~{{~A||||updated||published}}.~{{~A||you||USER}}@~{{~A||localhost|HOSTNAME}}.~{{~A||||title||title}}")))
+ '((filename-template "~{{~A||||updated||published}}.~{{~A||you||USER}}@~{{~A||localhost|HOSTNAME}}")
+ (multifile-output? #t)))
(define *default-singlefile-values*
- '())
+ '((filename-template "feed.out")
+ (multifile-output? #f)))
;; Writes a given feed entry to the out-path, as per the feedsnake-unix-format template alist
(define (write-entry entry template-alist out-path)
- (let ([file-mode (if (alist-car-ref 'multifile-output? template-alist) #:text #:append)]
- [header (or (alist-car-ref 'output-header template-alist) "")]
- [footer (or (alist-car-ref 'output-footer template-alist) "")]
+ (let ([template (if (alist-car-ref 'multifile-output? template-alist)
+ (append template-alist *default-multifile-values* *default-values*)
+ (append template-alist *default-singlefile-values* *default-values*))]
+ [file-mode (if (alist-car-ref 'multifile-output? template-alist) #:text #:append)]
[entry-w-env-vars (append (get-environment-variables) entry)])
(call-with-output-file
- out-path
+ (entry-output-path entry template out-path)
(lambda (out-port)
(write-string
- (string-append header
- (entry->string entry-w-env-vars (alist-car-ref 'entry-template template-alist))
- footer)
- #f
+ (entry->string entry-w-env-vars (alist-car-ref 'entry-template template))
+ #f
out-port))
file-mode)))
@@ -288,6 +281,33 @@
entries))
+;; Decides the correct output path for an entry, given the template's filename rules etc.
+(define (entry-output-path entry template-alist base-out-path)
+ (let ([multifile? (alist-car-ref 'multifile-output? template-alist)])
+ (if multifile?
+ (multifile-entry-path entry template-alist base-out-path)
+ (singlefile-entry-path entry template-alist base-out-path))))
+
+
+(define (singlefile-entry-path entry template-alist base-out-path)
+ (if (directory-exists? base-out-path)
+ (signal
+ (make-property-condition
+ 'exn 'location 'file
+ 'message (string-append base-out-path " shouldn't be a directory.")))
+ base-out-path))
+
+
+(define (multifile-entry-path entry template-alist base-out-path)
+ (let* ([file-leaf (named-format (alist-car-ref 'filename-template template-alist) entry)])
+ (if (create-directory base-out-path)
+ (string-append base-out-path "/" file-leaf)
+ (signal
+ (make-property-condition
+ 'exn 'location 'file
+ 'message (string-append base-out-path " either isn't accessible or isn't a directory."))))))
+
+
;; Switch the cached version of the feed with a newer version, if available
(define (update-feed-file feed-path)
(let* ([old-string (call-with-input-file feed-path