3 Commits fac63f9fe3 ... 5fb3019aae

Author SHA1 Message Date
  Jaidyn Levesque 5fb3019aae Begin UNIX client: Support outputting entries of feed-file to stdout 2 months ago
  Jaidyn Levesque e1c80f7e78 Support for multi-file outputs (e.g, maildir) 2 months ago
  Jaidyn Levesque 56ce38a617 Handling of Atom relative & feed-self URLs 2 months ago
1 changed files with 125 additions and 34 deletions
  1. 125 34
      feedsnake.scm

+ 125 - 34
feedsnake.scm

@@ -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