1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
(define-module (data-source-rss) #:use-module (srfi srfi-19) ;date #:use-module (sxml simple) #:use-module (file-utils) #:export (data-source-rss)) (define (data-source-rss year file) (if (string-suffix? ".sxml" file) (sxml->data-source-rss year (call-with-input-file file read) #f) (let () (define sxml (xml->sxml (get-file-contents file))) (define title (get-title sxml)) (define entries (get-entries sxml)) (sxml->data-source-rss year entries title)))) (define (get-title sxml) (define feed (assoc-ref sxml 'http://www.w3.org/2005/Atom:feed)) (define title (assoc-ref feed 'http://www.w3.org/2005/Atom:title)) (car title)) (define (get-entries sxml) (define feed (assoc-ref sxml 'http://www.w3.org/2005/Atom:feed)) (define entries (filter (lambda (e) (and (list? e) (eq? (car e) 'http://www.w3.org/2005/Atom:entry))) feed)) entries) (define (sxml->data-source-rss year entries title) ;; TODO shift year based on calendar (let* ((start-date (make-date 0 0 0 0 1 1 year 0)) (end-date (make-date 0 0 0 0 31 12 (+ year 1) 0))) (define data (filter identity (map (lambda (e) ;; try to guess title from gitlab ;; reverse order if we have a title (if title (or (web-entry->data title e) (catch-all (lambda () (gitlab-entry->data e)))) (or (catch-all (lambda () (gitlab-entry->data e))) (web-entry->data title e)))) entries))) data)) (define (identity x) x) (define (gitlab-entry->data e) (define link (assoc-ref e 'http://www.w3.org/2005/Atom:link)) (if link (let () (define link-attrs (assoc-ref link '@)) (define link-href (car (assoc-ref link-attrs 'href))) (define updated (car (assoc-ref e 'http://www.w3.org/2005/Atom:updated))) ;2021-07-06T17:37:59Z `((project . ,(gitlab-projectname link-href)) (date . ,(string->date updated "~Y-~m-~dT~H:~M:~S~z")))) #f)) (define (gitlab-projectname str) "Convert \"https://gitlab.gnome.org/World/podcasts/-/issues/73#note_1198570\" to \"podcasts\"" (define prefix 9) ; https://x (define slash1 (string-index str #\/ prefix)) (define slash2 (string-index str #\/ (+ slash1 1))) (define slash3 (string-index str #\/ (+ slash2 1))) (define name (substring str (+ slash2 1) (or slash3 (string-length str)))) name) (define (web-entry->data title e) (define link (assoc-ref e 'http://www.w3.org/2005/Atom:link)) (if link (let () (define link-attrs (assoc-ref link '@)) (define link-href (car (assoc-ref link-attrs 'href))) (define updated (car (assoc-ref e 'http://www.w3.org/2005/Atom:updated))) ;2021-07-06T17:37:59Z `((project . ,title) (link . ,link-href) (date . ,(string->date updated "~Y-~m-~dT~H:~M:~S~z")))) #f)) (define (catch-all thunk) (with-exception-handler (lambda (exn) ;; (format (current-error-port) ;; "Uncaught exception: ~s\n" exn) #f) thunk #:unwind? #t))