💾 Archived View for mederle.de › b › i › atom.lisp captured on 2022-01-08 at 13:51:52.

View Raw

More Information

⬅️ Previous capture (2021-12-03)

-=-=-=-=-=-=-

(in-package :germinal-med)

(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))))))

(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))))

(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"))))