|
@@ -38,8 +38,8 @@
|
|
|
(updated-feed-string read-feed entries-since entry->string)
|
|
|
|
|
|
(import scheme
|
|
|
- (chicken base) (chicken condition) (chicken io) (chicken port)
|
|
|
- srfi-1 srfi-19 srfi-69
|
|
|
+ (chicken base) (chicken condition) (chicken io) (chicken pathname) (chicken port)
|
|
|
+ srfi-1 srfi-13 srfi-19 srfi-69
|
|
|
date-strings
|
|
|
feedsnake-helpers
|
|
|
http-client
|
|
@@ -130,7 +130,7 @@
|
|
|
;; Parse an atom feed into a feedsnake-friendly alist
|
|
|
(define (atom-doc->feedsnake-feed atom)
|
|
|
`((title ,(last (feed-title atom)))
|
|
|
- (urls ,(feed-links atom))
|
|
|
+ (url ,(atom-feed-preferred-url atom))
|
|
|
(authors ,(map author-name (feed-authors atom)))
|
|
|
(updated ,(feed-updated atom))
|
|
|
(entry-updated ,(atom-feed-latest-entry-date atom))
|
|
@@ -140,6 +140,7 @@
|
|
|
(feed-entries atom)))))
|
|
|
|
|
|
|
|
|
+
|
|
|
;; Parse an atom entry into a feedsnake entry :>
|
|
|
(define (atom-entry->feedsnake-entry entry atom)
|
|
|
(let ([published (rfc339-string->date (entry-published entry))]
|
|
@@ -150,9 +151,19 @@
|
|
|
(updated ,(or updated published))
|
|
|
(published ,(or published updated))
|
|
|
(summary ,(last (entry-summary entry)))
|
|
|
- (urls ,(map link-uri (entry-links entry)))
|
|
|
+ (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
|
|
|
+(define (atom-feed-preferred-url atom)
|
|
|
+ (car
|
|
|
+ (filter
|
|
|
+ (lambda (link)
|
|
|
+ (string=? (link-relation link) "self"))
|
|
|
+ (feed-links atom))))
|
|
|
|
|
|
|
|
|
;; Get an atom feed's latest date for an entry's updating/publishing
|
|
@@ -168,6 +179,15 @@
|
|
|
(map entry-date (feed-entries atom)))))
|
|
|
|
|
|
|
|
|
+;; Convert an atom-link into a proper, valid url
|
|
|
+(define (atom-link->string link atom)
|
|
|
+ (if (string-contains (link-uri link) "://")
|
|
|
+ (link-uri link)
|
|
|
+ (string-append (pathname-directory (atom-feed-preferred-url atom))
|
|
|
+ "/"
|
|
|
+ (link-uri link))))
|
|
|
+
|
|
|
+
|
|
|
;; Download a file over HTTP to the given port.
|
|
|
(define (fetch-http url out-port)
|
|
|
(call-with-input-request
|
|
@@ -180,14 +200,16 @@
|
|
|
|
|
|
;; The UNIX-style frontend for feedsnake
|
|
|
(module feedsnake-unix
|
|
|
- (update-feed-file latest-entries all-entries write-entry write-entries feed-files *mbox-template*)
|
|
|
+ (main 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)
|
|
|
- (chicken process-context) (chicken process-context posix)
|
|
|
+ (chicken base) (chicken condition) (chicken file) (chicken file posix)
|
|
|
+ (chicken io) (chicken process-context) (chicken process-context posix)
|
|
|
srfi-1 srfi-19
|
|
|
date-strings
|
|
|
feedsnake feedsnake-helpers
|
|
|
+ getopt-long
|
|
|
+ named-format
|
|
|
xattr)
|
|
|
|
|
|
|
|
@@ -205,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"))
|
|
@@ -219,16 +241,6 @@
|
|
|
"\n"))
|
|
|
(multifile-output? #f)))
|
|
|
|
|
|
-
|
|
|
-(define *html-template*
|
|
|
- `((entry-template
|
|
|
- "<li><b>~{{~A||Unnamed post||title}}</b> <i>~{{~A||||updated}}<i> <p>~{{~A||No summary||summary}}</p></li>")
|
|
|
- (multifile-output? #f)
|
|
|
- (output-header "<!DOCTYPE html>\n<html>\n<head>\n<title>~{{~A||Unnamed feed||title}}</title>\n</head>\n<body>")
|
|
|
- (output-footer "</body></html>")
|
|
|
- (multifile-output? #f)))
|
|
|
-
|
|
|
-
|
|
|
(define *default-template*
|
|
|
(append *maildir-template*
|
|
|
'((output-dir "./"))))
|
|
@@ -237,27 +249,77 @@
|
|
|
'((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) "")]
|
|
|
- [entry-w-env-vars (append (get-environment-variables) entry)])
|
|
|
+(define *help-msg*
|
|
|
+ (string-append
|
|
|
+ "usage: feedsnake [-h] FILE...\n"
|
|
|
+ "Feedsnake is a program for converting Atom feeds into mbox/maildir files.\n"
|
|
|
+ "Any Atom feeds passed as an argument will be output in mbox format.\n\n"))
|
|
|
+
|
|
|
+(define *opts*
|
|
|
+ '((help
|
|
|
+ "Print a usage message"
|
|
|
+ (single-char #\h))))
|
|
|
+;; (outdir
|
|
|
+;; "Output directory, used for multi-file templates (e.g., maildir)"
|
|
|
+;; (single-char #\d)
|
|
|
+;; (value (required DIR)))
|
|
|
+;; (output
|
|
|
+;; "Output file, used for single-file templates (e.g., mbox). Defaults to stdout."
|
|
|
+;; (single-char #\o)
|
|
|
+;; (value (required FILE)))
|
|
|
+;; (template
|
|
|
+;; "Output template for feed ('mbox' or 'maildir'). Defaults to 'mbox'."
|
|
|
+;; (single-char #\t)
|
|
|
+;; (value (required TEMPLATE)))))
|
|
|
+
|
|
|
+
|
|
|
+;; The `main` procedure that should be called to run feedsnake-unix for use as script.
|
|
|
+;; TODO: accept piped-in feeds
|
|
|
+(define (main)
|
|
|
+ (let ([args (getopt-long (command-line-arguments) *opts*)])
|
|
|
+ (if (alist-ref 'help args)
|
|
|
+ (help)
|
|
|
+ (map (lambda (free-arg)
|
|
|
+ (if (file-exists? free-arg)
|
|
|
+ (map (lambda (entry)
|
|
|
+ (write-entry entry *mbox-template* (open-output-file* fileno/stdout)))
|
|
|
+ (all-entries free-arg))))
|
|
|
+ (alist-ref '@ args)))))
|
|
|
+
|
|
|
+
|
|
|
+;; Prints cli usage to stderr.
|
|
|
+(define (help)
|
|
|
+ (write-string *help-msg* #f (open-output-file* fileno/stderr))
|
|
|
+ (write-string (usage *opts*) #f (open-output-file* fileno/stderr)))
|
|
|
+
|
|
|
+
|
|
|
+;; Writes a given feed entry to the out-port, as per the feedsnake-unix-format template alist
|
|
|
+(define (write-entry entry template-alist out-port)
|
|
|
+ (write-string
|
|
|
+ (entry->string (append (get-environment-variables) entry)
|
|
|
+ (alist-car-ref 'entry-template template-alist))
|
|
|
+ #f
|
|
|
+ out-port))
|
|
|
+
|
|
|
+
|
|
|
+;; Write an entry to the given file (directory for multifile; normal file otherwise)
|
|
|
+(define (write-entry-to-file entry template-alist out-path)
|
|
|
+ (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) #:text #:append)])
|
|
|
(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
|
|
|
- out-port))
|
|
|
+ (write-entry entry template out-port))
|
|
|
file-mode)))
|
|
|
|
|
|
|
|
@@ -268,6 +330,35 @@
|
|
|
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))))
|
|
|
+
|
|
|
+
|
|
|
+;; Output path for entry with a single-file template
|
|
|
+(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))
|
|
|
+
|
|
|
+
|
|
|
+;; Output path for an entry w multifile template
|
|
|
+(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
|