💾 Archived View for mederle.de › b › i › atom-feed-generator.org captured on 2022-01-08 at 13:51:50.
View Raw
More Information
⬅️ Previous capture (2021-12-03)
-=-=-=-=-=-=-
# atom-feed-generator.org -- 2021-03-12 21:16
#+Title: Atom Feed Generator for Germinal
#+STARTUP: indent
#+PROPERTY: header-args :tangle "atom.lisp"
# Time-stamp: <2021-03-13 14:28>
Use:
- information from a human-readable feed in Gemini format
- metadata as available
- Emacs timestamps in file, in lieu of that one out of
- date in file metadata
- date in human-readable feed link to file
- file metadata is key-value pairs at end of file, one per line
- author: John Doe
- language: EN
- date (unless timestamp at beginning of file): 2021-03-12T12:00Z
- category: Common Lisp
- do the rest with variables
Use:
- information from a human-readable feed in Gemini format
- do all the rest with variables
- Atom specification :: https://validator.w3.org/feed/docs/atom.html
#+begin_src lisp :tangle no
(defvar *unix-epoch-difference*
(encode-universal-time 0 0 0 1 1 1970 0))
(defun universal-to-unix-time (universal-time)
(- universal-time *unix-epoch-difference*))
(defun unix-to-universal-time (unix-time)
(+ unix-time *unix-epoch-difference*))
(defun get-unix-millis ()
(* (universal-to-unix-time (get-universal-time)) 1000))
(defun dump-date-prefix (stream)
"Creates a prefix of date, tab, plus, tab ahead of json document"
(local-time:format-timestring stream (local-time:now) :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2) ":" (:sec 2) "," (:msec 3) " + ")))
#+end_src
At this point, we're only implementing the simplified version.
Add to defsystem:
- local-time
#+begin_src lisp
(in-package :germinal-med)
#+end_src
- * Extract entry URLs from file
The links in the Gemini feed file are probably relative to the file itself, so we need to find out where the feed file is relative to the capsule root, and from there calculate the absolute path to the entry files.
Pathname arithmetics: ~*germinal-root*~ can be defined with or without a trailing slash. ~cl-fad:pathname-as-directory~ makes sure there is a trailing slash present. ~pathname-directory~ converts this to a Common Lisp path list like ~(:absolute "foo" "bar")~. The feed file can be supplied with or without a leading slash, but as it's always relative to the root of the capsule, we simply get the ~cdr~ of the path list and do away with the ~:absolute~ or ~:relative~ keyword, then append it to the absolute path to the capsule.
#+begin_src lisp
(defun list-entries (feed-file &optional (root *germinal-root*) (server-name *germinal-server-name*))
(let* ((feed-path-directory
(make-pathname :directory
(append
(pathname-directory (fad:pathname-as-directory root))
(cdr (pathname-directory feed-file)))))
(feed-file-absolute (merge-pathnames feed-path-directory (file-namestring feed-file)))
(feed-file-directory-relative (enough-namestring feed-path-directory (fad:pathname-as-directory root)))
(entries))
(with-open-file (in feed-file-absolute :direction :input)
(loop for line = (read-line in nil 'eof)
until (eq line 'eof)
do (when (and (> (length line) 3)
(string= "=> " line :start2 0 :end2 3))
(multiple-value-bind (link/date offset)
(split-sequence:split-sequence #\Space line :start 3 :count 2)
;; check for valid date, otherwise discard
(when (local-time:parse-timestring
(string-trim " []<>()\" " (second link/date))
:fail-on-error nil)
(setf entries (cons (list
(concatenate
'string
"gemini://"
server-name "/"
(namestring (merge-pathnames feed-file-directory-relative (first link/date))))
(local-time:format-timestring
nil
(local-time:parse-timestring (second link/date)))
(string-trim "-: " (subseq line offset))) entries)))))
finally (return (sort entries #'string> :key #'second))))))
#+end_src
#+begin_src lisp
(defconstant +atom-header+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
<feed xmlns=\"http://www.w3.org/2005/Atom\">")
(defconstant +atom-footer+ "</feed>")
(defun make-entry (entry)
"Create xml for single entry. entry is '(url date title)."
(let ((xml (make-string-output-stream)))
(format xml "~% <entry>")
(format xml "~% <title>~A</title>" (third entry))
(format xml "~% <link href=\"~A\" />" (first entry))
(format xml "~% <id>~A</id>" (first entry))
(format xml "~% <updated>~A</updated>" (second entry))
(format xml "~% </entry>~%")
(get-output-stream-string xml)))
(defun make-atom (feed-file &key
(root *germinal-root*)
(server-name *germinal-server-name*)
(atom-url "/feed")
(atom-id (concatenate 'string server-name atom-url)) ; make this unique and constant
(author "Snarky Glogman")
(title "Untitled Feed"))
"Create XML string in atom format from feed file in Gemini feed syntax, i.e. Gemini URL lines with date."
(let* ((entries (list-entries feed-file root server-name))
(last-updated (second (first entries)))
(xml (make-string-output-stream)))
(format xml "~A~%" +atom-header+)
(format xml "~% <title>~A</title>~%" title)
(format xml "~& <link rel=\"self\" href=\"~A\" />" atom-url)
(format xml "~& <updated>~A</updated>~%" last-updated)
(format xml "~& <author><name>~A</name></author>~%" author)
(format xml "~& <id>~A</id>~%" atom-id)
(loop for entry in entries do
(format xml "~A" (make-entry entry)))
(format xml "~%~A~%" +atom-footer+)
(format nil "~A~%" (get-output-stream-string xml))))
#+end_src
#+begin_src lisp
(defun atom-view-de (request &optional name &rest junk)
(declare (ignore junk))
(make-response
20
"application/atom+xml"
(format nil "~A" (make-atom "b/00-inhaltsverzeichnis.gmi"
:atom-url (germinal::path-info request)
:atom-id (germinal::url request)
:author "Wolfgang Mederle"
:title "Deutschsprachige Artikel auf mederle.de"))))
(defun atom-view-en (request &optional name &rest junk)
(declare (ignore junk))
(make-response
20
"application/atom+xml"
(format nil "~A" (make-atom "b/00-table-of-contents.gmi"
:atom-url (germinal::path-info request)
:atom-id (germinal::url request)
:author "Wolfgang Mederle"
:title "English language articles on mederle.de"))))
#+end_src
- * COMMENT Local Definitions for Tests
#+begin_src lisp
(setf *germinal-routes*
'(("/hello/(.*)/?" . hello-world-view)
("/hello/?" . hello-world-view)
("/links" . surfmap-view)
("/feed-de" . atom-view-de)
(".*" . gemini-serve-file-or-directory)))
#+end_src
######################################################################
# Local variables:
# org-confirm-babel-evaluate: nil
# eval: (add-hook 'after-save-hook (lambda () (org-babel-tangle)) nil t)
# End: