commit ba95673e7a8ed15fb7802fc66905db1820f8c528
parent 1127d5150c85cc8e8d72abbd5dadcac712b74ad1
Author: Decay <decaydjk@tilde.town>
Date: Sat, 23 May 2020 11:43:47 -0700
RSS Support!
We now have basic RSS support, please read the README file and the
expanded configuration comments in src/miniblog.lisp to get started!
Diffstat:
8 files changed, 270 insertions(+), 87 deletions(-)
diff --git a/README b/README
@@ -67,13 +67,17 @@ Configuration is simple, executable Common Lisp in the file ~/.miniblogrc. A sam
This will set the timezone of your posts to Pacific and your blog title to "Decay's Miniblog". There are other configurable globals (please see src/miniblog.lisp for the complete list) and since .miniblogrc is (load)ed it can contain any arbitrary executable Lisp code.
+## RSS Support
+
+Miniblog now has basic RSS 2.0 support! At minimum you will need to configure *BLOG-TITLE*, *BLOG-DESCRIPTION* and *BLOG-LINK* as described in src/miniblog.lisp to provide the basic RSS channel elements.
+
## Contributing
-Email your pull requests to decaydjk@tilde.town over local mail! If you have requests or suggestions, hit me up as well and let's talk about it!
+Email your pull requests to decaydjk@tilde.town over local mail, or decay@todayiwilllaunchmyinfantsonintoorbit.com over standard email! If you have requests or suggestions, hit me up as well and let's talk about it!
## Bugs/Issues
-Right now the automatic regeneration is pretty simpleminded. It should work correctly on adds or deletes but in case you run into a tricky edge case you can always request a full regeneration.
+Right now the automatic regeneration is pretty simpleminded. It should work correctly on adds or deletes but in case you run into a tricky edge case you can always request a full regeneration. Also, the rss.xml will not currently be removed if it's present but has been deconfigured, it will just no longer be updated which may not be what you want.
Some improvements that would be nice:
diff --git a/miniblog.asd b/miniblog.asd
@@ -7,7 +7,7 @@ tool. It allows simple creation and management of posts written in
Markdown, created and edited through your favorite text editor. By default
it uses sqlite3 as a persistence backend and pushes all generated content
into date-structured directories as a normal HTML."
- :version "0.0.1"
+ :version "0.1.0"
:author "DecayDJK <decaydjk@tilde.town>"
:license "GPLv3 or later"
:depends-on ("uiop"
diff --git a/src/content.lisp b/src/content.lisp
@@ -4,10 +4,14 @@
(register-emb "default-template"
(make-pathname :name "template" :type "lhtml"
:directory (pathname-directory this-file)
+ :defaults this-file))
+ (register-emb "rss"
+ (make-pathname :name "rss" :type "lxml"
+ :directory (pathname-directory this-file)
:defaults this-file)))
(defun make-generator (&key title root-uri header links stylesheet)
- (lambda (entries &key year month archive-date-list tz)
+ (lambda (entries &key year month archive-date-list tz enable-rss)
(execute-emb
"default-template"
:env (list
@@ -16,6 +20,7 @@
:header header
:links links
:stylesheet stylesheet
+ :enable-rss enable-rss
:posts entries
:year year
:month month
@@ -24,6 +29,38 @@
:short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*))
:long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))))))
+(defun strip-html-tags (content)
+ (format nil "~{~A~}"
+ (mapcar
+ (lambda (s)
+ (let ((chunks (split ">" s)))
+ (or (second chunks) (first chunks))))
+ (split "<" content))))
+
+(defun make-rss-generator (&key title link description image-url language
+ copyright managing-editor webmaster category)
+ (if (and title link description)
+ (lambda (entries &key tz)
+ (execute-emb
+ "rss"
+ :env (list
+ :title title
+ :link link
+ :description description
+ :image-url image-url
+ :language language
+ :copyright copyright
+ :managing-editor managing-editor
+ :webmaster webmaster
+ :category category
+ :posts entries
+ :build-date (now)
+ :content-formatter (miniblog.format:make-content-formatter)
+ :content-stripper #'strip-html-tags
+ :rfc-822-date-formatter (miniblog.format:make-rfc-822-date-formatter (or tz *default-timezone*)))))
+ (lambda (entries &key tz)
+ (declare (ignore entries tz)))))
+
(defun year-month-of-entry (entry &key tz)
(if (not entry)
(error "Entry cannot be nil")
@@ -76,68 +113,83 @@
(mapcar #'get-year-month-pair-for-entry entries)
:test #'year-month-pairs-equal-p)))
-(defun gen-all (entries &key generator tz)
+(defun gen-all (entries &key generator rss-generator tz)
+ "Generate a list of all monthly pages as well as the index and RSS feed"
(labels
- ((gen-all-years (entries archive-date-list generator tz)
+ ((gen-all-years (entries archive-date-list generator tz enable-rss)
(let ((rest-entries (copy-list entries))
(content '()))
(loop for year-month in archive-date-list do
(let ((month-content
- (gen-month-impl rest-entries archive-date-list
- (car year-month) (cdr year-month)
- :generator generator
- :tz tz)))
+ (gen-month rest-entries
+ (car year-month) (cdr year-month)
+ :enable-rss enable-rss
+ :archive-date-list archive-date-list
+ :generator generator
+ :tz tz)))
(setf rest-entries (cdr month-content))
(setf content
(nconc content (list (car month-content))))))
content)))
- (let ((archive-date-list (get-archive-date-list entries tz)))
+ (let ((archive-date-list (get-archive-date-list entries tz))
+ (rss-content (gen-rss-feed entries
+ :generator rss-generator
+ :tz tz)))
(cons
- (list :index :index (gen-index-impl entries
- archive-date-list
- :generator generator
- :tz tz))
- (gen-all-years
- entries archive-date-list
- generator tz)))))
+ (list :rss nil rss-content)
+ (cons
+ (list :index nil (gen-index entries
+ :enable-rss rss-content
+ :archive-date-list archive-date-list
+ :generator generator
+ :tz tz))
+ (gen-all-years
+ entries archive-date-list
+ generator tz rss-content))))))
+
+(defun top-ten (entries)
+ (if (>= (length entries) 10)
+ (subseq entries 0 10)
+ entries))
+
+(defun gen-rss-feed (entries &key generator tz)
+ "Generate the RSS feed content with the same posts as the index page"
+ (let ((index-entries (top-ten entries)))
+ (funcall (or generator (make-rss-generator))
+ index-entries
+ :tz tz)))
-(defun gen-index-impl (entries archive-date-list &key generator tz)
+(defun gen-index (entries &key generator tz archive-date-list enable-rss)
+ "Generate the index (front page) with the latest ten posts"
(if (not entries)
(funcall (or generator (make-generator)) nil :tz tz)
- (let* ((index-entries
- (subseq entries 0
- (if (>= (length entries) 10)
- 10
- (length entries)))))
+ (let ((archive-date-list (or archive-date-list
+ (get-archive-date-list entries tz)))
+ (index-entries (top-ten entries)))
(funcall (or generator (make-generator))
index-entries
+ :enable-rss enable-rss
:archive-date-list archive-date-list
:tz tz))))
-(defun gen-index (entries &key generator tz)
- (gen-index-impl entries (get-archive-date-list entries tz)
- :generator generator :tz tz))
-
-(defun gen-month-impl (entries archive-date-list year month
- &key generator tz)
- (let* ((entries-at-month (monthcdr entries year month tz))
- (collected (collect-entries-for-month
- entries-at-month year month tz))
- (month-entries (car collected))
- (rest-entries (cdr collected)))
- (cons
- (if month-entries
- (list year month
- (funcall (or generator (make-generator))
- month-entries
- :year year
- :month month
- :archive-date-list archive-date-list
- :tz tz))
- nil)
- rest-entries)))
-
-(defun gen-month (entries year month &key generator tz)
- (gen-month-impl entries (get-archive-date-list entries tz) year month
- :generator generator :tz tz))
-
+(defun gen-month (entries year month &key generator tz archive-date-list enable-rss)
+ "Generate a page with all posts for the given year and month"
+ (let ((archive-date-list (or archive-date-list
+ (get-archive-date-list entries tz))))
+ (let* ((entries-at-month (monthcdr entries year month tz))
+ (collected (collect-entries-for-month
+ entries-at-month year month tz))
+ (month-entries (car collected))
+ (rest-entries (cdr collected)))
+ (cons
+ (if month-entries
+ (list year month
+ (funcall (or generator (make-generator))
+ month-entries
+ :year year
+ :month month
+ :enable-rss enable-rss
+ :archive-date-list archive-date-list
+ :tz tz))
+ nil)
+ rest-entries))))
diff --git a/src/format.lisp b/src/format.lisp
@@ -15,6 +15,13 @@
(lambda (content)
(nth 1 (multiple-value-list (markdown content :stream nil)))))
+(defun make-rfc-822-date-formatter (&optional (timezone *default-timezone*))
+ "Return an RFC 822/1123-style date formatter for RSS items"
+ (lambda (datetime)
+ (format-timestring nil datetime
+ :format +rfc-1123-format+
+ :timezone timezone)))
+
(defun make-short-date-formatter (&optional (timezone *default-timezone*))
"Return the default short-date formatter (see +short-date-format+)"
(lambda (datetime)
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -1,13 +1,32 @@
(in-package :miniblog)
-(defvar *blog-header* nil)
-(defvar *blog-links* nil)
-(defvar *blog-stylesheet* nil)
+;;; The following are basic configuration elements. Most have sensible defaults.
(defvar *blog-title* "Miniblog")
-(defvar *blog-timezone* *default-timezone*)
-(defvar *public-html*)
-(defvar *root-uri*)
-(defvar *generator*)
+(defvar *blog-header* nil) ; Raw filename of an HTML chunk to throw at the top
+ ; of the body, eg "<h2>My Blog</h2>"
+(defvar *blog-links* nil) ; A list of cons cells of the format (text . url)
+ ; Populates the left-hand menu.
+(defvar *blog-stylesheet* nil) ; Optional external CSS stylesheet.
+(defvar *blog-timezone* *default-timezone*) ; Timezone in local-time form, eg
+ ; (local-time:find-timezone-by-location-name "US/Pacific")
+(defvar *public-html*) ; HTML root in pathname form, defaults to "~/public_html"
+ ; If it's set to a string in .miniblogrc, will be
+ ; translated with uiop:parse-native-namestring
+(defvar *root-uri*) ; Absolute or relative root uri, defaults to "~username"
+(defvar *generator*) ; Function to generate content page, see content.lisp
+(defvar *rss-generator*) ; Function to generate RSS feed, see content.lisp
+
+;;; The following are all used to populate RSS channel elements.
+;;; *BLOG-DESCRIPTION* and *BLOG-LINK* are the minimum required for an
+;;; RSS feed to be generated. See https://validator.w3.org/feed/docs/rss2.html
+(defvar *blog-description* "Powered by Common Lisp")
+(defvar *blog-link* nil)
+(defvar *blog-image-url* nil)
+(defvar *blog-language* nil)
+(defvar *blog-category* nil)
+(defvar *blog-copyright* nil)
+(defvar *blog-managing-editor* nil)
+(defvar *blog-webmaster* nil)
(defparameter +command-line-spec+
'((("add" #\a) :type boolean :optional t :documentation "Add new post")
@@ -36,18 +55,37 @@
(defun get-username ()
(uiop:getenv "USER"))
-(defun make-generator (&optional title)
+(defun make-generators ()
(setf *generator*
- (miniblog.content:make-generator :title title :root-uri *root-uri*
+ (miniblog.content:make-generator :title *blog-title*
+ :root-uri *root-uri*
:header *blog-header*
:links *blog-links*
- :stylesheet *blog-stylesheet*)))
+ :stylesheet *blog-stylesheet*))
+ (setf *rss-generator*
+ (miniblog.content:make-rss-generator :title *blog-title*
+ :link *blog-link*
+ :description *blog-description*
+ :image-url *blog-image-url*
+ :language *blog-language*
+ :copyright *blog-copyright*
+ :managing-editor *blog-managing-editor*
+ :webmaster *blog-webmaster*
+ :category *blog-category*)))
(defun get-index-file-for-path (path)
(merge-pathnames
(make-pathname :name "index" :type "html")
path))
+(defun get-index-file ()
+ (get-index-file-for-path *public-html*))
+
+(defun get-rss-file ()
+ (merge-pathnames
+ (make-pathname :name "rss" :type "xml")
+ *public-html*))
+
(defun get-monthly-path (year month)
(merge-pathnames
(make-pathname :directory
@@ -55,35 +93,48 @@
(format nil "~2,'0d" month)))
*public-html*))
-(defun regenerate-file (entry)
+(defun get-path-and-description-for-entry (entry)
(let* ((year (nth 0 entry))
- (month (nth 1 entry))
- (content (nth 2 entry))
- (path (if (eql year :index)
- *public-html*
- (get-monthly-path year month)))
- (description (if (eql year :index)
- "index"
- (format nil "archive for ~d/~2,'0d" year month))))
+ (month (nth 1 entry)))
+ (cond
+ ((eql year :index) (values (get-index-file) "index"))
+ ((eql year :rss) (values (get-rss-file) "RSS feed"))
+ (t (values
+ (get-index-file-for-path (get-monthly-path year month))
+ (format nil "archive for ~d/~2,'0d" year month))))))
+
+(defun regenerate-file (entry)
+ (multiple-value-bind (path description)
+ (get-path-and-description-for-entry entry)
(format t "Regenerating ~a...~%" description)
(ensure-directories-exist path)
- (with-open-file (output (get-index-file-for-path path)
- :direction :output :if-exists :supersede)
- (princ content output)
- (fresh-line output))))
+ (let ((year (nth 0 entry))
+ (content (nth 2 entry)))
+ (if (and (eql year :rss) (null content))
+ (format t "Can't generate valid RSS feed, skipping...~%")
+ (with-open-file (output path :direction :output :if-exists :supersede)
+ (princ content output)
+ (fresh-line output))))))
(defun regenerate-index-and-given-month (entries year month)
- (regenerate-file (list :index :index
- (miniblog.content:gen-index entries
- :generator *generator*
- :tz *blog-timezone*)))
- (regenerate-file (car (miniblog.content:gen-month entries year month
- :generator *generator*
- :tz *blog-timezone*))))
+ (let ((rss-content (miniblog.content:gen-rss-feed entries
+ :generator *rss-generator*
+ :tz *blog-timezone*)))
+ (regenerate-file (list :rss nil rss-content))
+ (regenerate-file (list :index nil
+ (miniblog.content:gen-index entries
+ :enable-rss rss-content
+ :generator *generator*
+ :tz *blog-timezone*)))
+ (regenerate-file (car (miniblog.content:gen-month entries year month
+ :enable-rss rss-content
+ :generator *generator*
+ :tz *blog-timezone*)))))
(defun regenerate-all (entries)
(let ((all (miniblog.content:gen-all entries
:generator *generator*
+ :rss-generator *rss-generator*
:tz *blog-timezone*)))
(mapcar #'regenerate-file all)))
@@ -200,7 +251,9 @@
(user-homedir-pathname))
:direction :input :if-does-not-exist nil)
(if config
- (load config))))
+ (load config)))
+ (if (stringp *public-html*)
+ (setf *public-html* (uiop:parse-native-namestring (uiop:native-namestring *public-html*)))))
(defun get-db-filename ()
(namestring (merge-pathnames
@@ -210,7 +263,7 @@
(defun miniblog (&key add get edit delete list start n regen-all help)
(init-tz)
(set-config-and-defaults)
- (make-generator *blog-title*)
+ (make-generators)
(miniblog.db:init :sqlite3 :database-name (get-db-filename))
(cond (add (add-new regen-all))
(get (get-post get))
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -3,6 +3,7 @@
(defpackage :miniblog.format
(:use :cl :cl-markdown :local-time)
(:export #:make-content-formatter
+ #:make-rfc-822-date-formatter
#:make-short-date-formatter
#:make-long-date-formatter))
@@ -16,11 +17,17 @@
#:get-entries #:update-entry #:delete-entry))
(defpackage :miniblog.content
- (:use :cl :local-time :cl-emb)
- (:export #:make-generator
+ (:use :cl :local-time :cl-emb :str)
+ (:export #:make-generator #:make-rss-generator
#:year-month-of-entry #:year-month-of-latest-entry
- #:gen-all #:gen-index #:gen-month))
+ #:gen-all #:gen-index #:gen-month #:gen-rss-feed))
(defpackage :miniblog
(:use :cl :command-line-arguments :local-time)
- (:export #:entry-point))
+ (:export #:entry-point
+ *blog-title* *blog-header* *blog-links* *blog-stylesheet*
+ *blog-timezone* *public-html* *root-uri*
+ *generator* *rss-generator*
+ *blog-description* *blog-link* *blog-image-url* *blog-language*
+ *blog-category* *blog-copyright* *blog-managing-editor*
+ *blog-webmaster*))
diff --git a/src/rss.lxml b/src/rss.lxml
@@ -0,0 +1,46 @@
+<rss version="2.0">
+ <channel>
+ <title><% @var title %></title>
+ <link><% @var link %></link>
+ <description><% @var description %></description>
+ <generator>Miniblog</generator>
+ <docs>https://validator.w3.org/feed/docs/rss2.html</docs>
+ <lastBuildDate>
+ <%= (funcall (getf env :rfc-822-date-formatter) (getf env :build-date)) %>
+ </lastBuildDate>
+ <% @if image-url %>
+ <image>
+ <url><% @var image-url %></url>
+ <title><% @var title %></title>
+ <link><% @var link %></link>
+ </image>
+ <% @endif %>
+ <% @if language %>
+ <language><% @var language %></language>
+ <% @endif %>
+ <% @if copyright %>
+ <copyright><% @var copyright %></copyright>
+ <% @endif %>
+ <% @if managing-editor %>
+ <managingEditor><% @var managing-editor %></managingEditor>
+ <% @endif %>
+ <% @if webmaster %>
+ <webmaster><% @var webmaster %></webmaster>
+ <% @endif %>
+ <% @if category %>
+ <category><% @var category %></category>
+ <% @endif %>
+ <% @if posts %>
+ <% (loop for (id created-at updated-at title content username last-updated-by) in (getf env :posts) do %>
+ <item>
+ <% (let* ((short-date (funcall (getf env :rfc-822-date-formatter) updated-at)) (formatted-content (funcall (getf env :content-formatter) content)) (stripped-content (funcall (getf env :content-stripper) formatted-content)) (truncated-content (str:substring 0 200 stripped-content))) %>
+ <title><%= title %></title>
+ <link><% @var link %>#<%= id %></link>
+ <description><%= (if (equal stripped-content truncated-content) stripped-content (concatenate 'string truncated-content "...")) %></description>
+ <pubDate><%= short-date %></pubDate>
+ <% ) %>
+ </item>
+ <% ) %>
+ <% @endif %>
+ </channel>
+</rss>
diff --git a/src/template.lhtml b/src/template.lhtml
@@ -12,6 +12,7 @@
section#miniblog-left { float: left; width: 15%; }
section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; }
nav#miniblog-nav { float: left; width: 20%; }
+ div#miniblog-rss { clear: both; }
table.calendar { padding: 10px; float: left; }
table.calendar td { width: 25%; }
@media screen and (max-aspect-ratio: 1/1) {
@@ -23,6 +24,11 @@
<% @if stylesheet %>
<link rel="stylesheet" type="text/css" href="<% @var stylesheet %>">
<% @endif %>
+ <% @if enable-rss %>
+ <link rel="alternate" type="application/rss+xml"
+ title="RSS feed for <%= (or (getf env :title) "Miniblog") %>"
+ href="<% @var root-uri %>rss.xml">
+ <% @endif %>
</head>
<body>
<header id="miniblog-header">
@@ -50,6 +56,7 @@
(progn
(setf short-date curr-short-date)
(format t "<h1>~A</h1>~%" short-date)))) %>
+ <a name="<%= id %>"></a>
<h2><%= title %></h2>
<article>
<%= (funcall (getf env :content-formatter) content) %>
@@ -98,6 +105,13 @@
(format t "</tr>~%")))
(format t "</table>~%"))) %>
<% @endif %>
+ <% @if enable-rss %>
+ <div id="miniblog-rss">
+ <a href="<% @var root-uri %>rss.xml" target="_blank">
+ Subscribe to <%= (or (getf env :title) "Miniblog") %>
+ </a>
+ </div>
+ <% @endif %>
</nav>
</body>
</html>
