Add --since option to UNIX client
This commit is contained in:
parent
7ff742e99a
commit
89612f3d54
117
feedsnake.scm
117
feedsnake.scm
|
@ -19,15 +19,48 @@
|
||||||
(load "named-format.scm")
|
(load "named-format.scm")
|
||||||
|
|
||||||
|
|
||||||
|
;; Module for misc. helper functions used by both feedsnake & feedsnake-unix
|
||||||
|
(module feedsnake-helpers
|
||||||
|
(alist-car-ref date->utc-date current-date-utc)
|
||||||
|
|
||||||
|
(import scheme
|
||||||
|
(chicken base)
|
||||||
|
srfi-19)
|
||||||
|
|
||||||
|
;; Just car's the value of alist-ref (if it exists)
|
||||||
|
(define (alist-car-ref key alist)
|
||||||
|
(let ([value (alist-ref key alist)])
|
||||||
|
(if value
|
||||||
|
(car value)
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
|
||||||
|
;; Convert a date of arbitrary timezone to UTC
|
||||||
|
(define (date->utc-date date)
|
||||||
|
(time-utc->date (date->time-utc date)))
|
||||||
|
|
||||||
|
|
||||||
|
;; The current date, with UTC (-0; Z) timezone
|
||||||
|
(define (current-date-utc)
|
||||||
|
(date->utc-date (current-date)))
|
||||||
|
|
||||||
|
|
||||||
|
) ;; feedsnake-helper module
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; The main feedsnake module; parses atom feeds into alists and strings
|
;; The main feedsnake module; parses atom feeds into alists and strings
|
||||||
(module feedsnake
|
(module feedsnake
|
||||||
(updated-feed-string read-feed entries-since write-entry write-entry-to-file write-entries-to-file all-entries entry->string
|
(updated-feed-string read-feed filter-entries write-entry
|
||||||
|
write-entry-to-file write-entries-to-file all-entries entry->string
|
||||||
*maildir-template* *mbox-template*)
|
*maildir-template* *mbox-template*)
|
||||||
|
|
||||||
(import scheme
|
(import scheme
|
||||||
(chicken base) (chicken condition) (chicken io) (chicken file) (chicken process-context) (chicken pathname) (chicken port)
|
(chicken base) (chicken condition) (chicken io) (chicken file)
|
||||||
|
(chicken process-context) (chicken pathname) (chicken port)
|
||||||
srfi-1 srfi-13 srfi-19 srfi-69
|
srfi-1 srfi-13 srfi-19 srfi-69
|
||||||
date-strings
|
date-strings
|
||||||
|
feedsnake-helpers
|
||||||
http-client
|
http-client
|
||||||
named-format
|
named-format
|
||||||
xattr
|
xattr
|
||||||
|
@ -87,17 +120,16 @@
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
|
||||||
;; A list of entries updated since the given date
|
(define (filter-entries feed filter)
|
||||||
(define (entries-since feed date-utc)
|
|
||||||
(let ([entry-date (lambda (entry) (car (alist-ref 'updated entry)))]
|
(let ([entry-date (lambda (entry) (car (alist-ref 'updated entry)))]
|
||||||
[since-entries '()])
|
[entries '()])
|
||||||
(map
|
(map
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(if (date>=? (entry-date entry) date-utc)
|
(if (apply filter (list entry))
|
||||||
(set! since-entries
|
(set! entries
|
||||||
(append since-entries (list entry)))))
|
(append entries (list entry)))))
|
||||||
(car (alist-ref 'entries feed)))
|
(car (alist-ref 'entries feed)))
|
||||||
since-entries))
|
entries))
|
||||||
|
|
||||||
|
|
||||||
;; Returns either the updated string of a feed (in comparison to old string),
|
;; Returns either the updated string of a feed (in comparison to old string),
|
||||||
|
@ -230,15 +262,15 @@
|
||||||
|
|
||||||
|
|
||||||
;; List of entries updated/published since last feed parsing
|
;; List of entries updated/published since last feed parsing
|
||||||
(define (latest-entries feed-path)
|
;;(define (latest-entries feed-path)
|
||||||
(let* ([feed (call-with-input-file feed-path read-feed)]
|
;; (let* ([feed (call-with-input-file feed-path read-feed)]
|
||||||
[xattr-last-update (get-xattr feed-path "user.feedsnake.parsed")]
|
;; [xattr-last-update (get-xattr feed-path "user.feedsnake.parsed")]
|
||||||
[last-update (if xattr-last-update
|
;; [last-update (if xattr-last-update
|
||||||
(rfc339-string->date xattr-last-update)
|
;; (rfc339-string->date xattr-last-update)
|
||||||
(date->utc-date (make-date 0 0 0 0 01 01 1971)))])
|
;; (date->utc-date (make-date 0 0 0 0 01 01 1971)))])
|
||||||
(set-xattr feed-path "user.feedsnake.parsed"
|
;; (set-xattr feed-path "user.feedsnake.parsed"
|
||||||
(date->rfc339-string (current-date-utc)))
|
;; (date->rfc339-string (current-date-utc)))
|
||||||
(entries-since feed last-update)))
|
;; (entries-since feed last-update)))
|
||||||
|
|
||||||
|
|
||||||
;; List of all entries of the feed
|
;; List of all entries of the feed
|
||||||
|
@ -311,15 +343,6 @@
|
||||||
|
|
||||||
;; Misc. functions
|
;; Misc. functions
|
||||||
;; ————————————————————————————————————————
|
;; ————————————————————————————————————————
|
||||||
|
|
||||||
;; Just car's the value of alist-ref (if it exists)
|
|
||||||
(define (alist-car-ref key alist)
|
|
||||||
(let ([value (alist-ref key alist)])
|
|
||||||
(if value
|
|
||||||
(car value)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
|
|
||||||
;; Download a file over HTTP to the given port.
|
;; Download a file over HTTP to the given port.
|
||||||
(define (fetch-http url out-port)
|
(define (fetch-http url out-port)
|
||||||
(call-with-input-request
|
(call-with-input-request
|
||||||
|
@ -327,15 +350,6 @@
|
||||||
(lambda (in-port) (copy-port in-port out-port))))
|
(lambda (in-port) (copy-port in-port out-port))))
|
||||||
|
|
||||||
|
|
||||||
;; Convert a date of arbitrary timezone to UTC
|
|
||||||
(define (date->utc-date date)
|
|
||||||
(time-utc->date (date->time-utc date)))
|
|
||||||
|
|
||||||
|
|
||||||
;; The current date, with UTC (-0; Z) timezone
|
|
||||||
(define (current-date-utc)
|
|
||||||
(date->utc-date (current-date)))
|
|
||||||
|
|
||||||
) ;; feedsnake module
|
) ;; feedsnake module
|
||||||
|
|
||||||
|
|
||||||
|
@ -347,8 +361,8 @@
|
||||||
(import scheme
|
(import scheme
|
||||||
(chicken base) (chicken file) (chicken file posix) (chicken io)
|
(chicken base) (chicken file) (chicken file posix) (chicken io)
|
||||||
(chicken process-context) (chicken process-context posix)
|
(chicken process-context) (chicken process-context posix)
|
||||||
srfi-1
|
srfi-1 srfi-19
|
||||||
feedsnake
|
feedsnake feedsnake-helpers
|
||||||
getopt-long)
|
getopt-long)
|
||||||
|
|
||||||
|
|
||||||
|
@ -370,11 +384,11 @@
|
||||||
(output
|
(output
|
||||||
"Output file, used for mbox output. Default is stdout."
|
"Output file, used for mbox output. Default is stdout."
|
||||||
(single-char #\o)
|
(single-char #\o)
|
||||||
(value (required FILE)))))
|
(value (required FILE)))
|
||||||
;; (since
|
(since
|
||||||
;; "Output entries after the given date, in YYYY-MM-DD hh:mm:ss format."
|
"Output entries after the given date, in YYYY-MM-DD hh:mm:ss format."
|
||||||
;; (single-char #\s)
|
(single-char #\s)
|
||||||
;; (value (required DATETIME)))))
|
(value (required DATETIME)))))
|
||||||
|
|
||||||
|
|
||||||
;; Prints cli usage to stderr.
|
;; Prints cli usage to stderr.
|
||||||
|
@ -405,15 +419,26 @@
|
||||||
[feed-path (first feed-pair)]
|
[feed-path (first feed-pair)]
|
||||||
[output-dir (alist-ref 'outdir args)]
|
[output-dir (alist-ref 'outdir args)]
|
||||||
[output (or (alist-ref 'output args) output-dir)]
|
[output (or (alist-ref 'output args) output-dir)]
|
||||||
[template (if output-dir *maildir-template* *mbox-template*)])
|
[template (if output-dir *maildir-template* *mbox-template*)]
|
||||||
|
[since-string (alist-ref 'since args)]
|
||||||
|
[since (if since-string
|
||||||
|
(date->utc-date (string->date since-string "~Y-~m-~d ~H:~M:~S"))
|
||||||
|
#f)]
|
||||||
|
[entry-date (lambda (entry)
|
||||||
|
(or (alist-car-ref 'updated entry)
|
||||||
|
(alist-car-ref 'published entry)))]
|
||||||
|
[filter (lambda (entry)
|
||||||
|
(if since
|
||||||
|
(date>=? (entry-date entry) since)
|
||||||
|
#t))])
|
||||||
(cond
|
(cond
|
||||||
[output
|
[output
|
||||||
(write-entries-to-file (all-entries feed) template output)]
|
(write-entries-to-file (filter-entries feed filter) template output)]
|
||||||
[(not output)
|
[(not output)
|
||||||
(map (lambda (entry)
|
(map (lambda (entry)
|
||||||
(write-entry entry template
|
(write-entry entry template
|
||||||
(open-output-file* fileno/stdout)))
|
(open-output-file* fileno/stdout)))
|
||||||
(all-entries feed))])))
|
(filter-entries feed filter))])))
|
||||||
|
|
||||||
|
|
||||||
;; Supposed config root of the user (as per XDG, or simple ~/.config)
|
;; Supposed config root of the user (as per XDG, or simple ~/.config)
|
||||||
|
|
Ŝarĝante…
Reference in New Issue