cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-23 09:07:37 +01:00
Code Issues

- [script] [generate-gemlog] prevented overwrite of an already published post;

Browse Source 
- [script] [generate-gemlog] added post's meta value: 'skip'.
This commit is contained in:
cage 2024-12-28 11:47:08 +01:00
parent a517aa58f4
commit 23874c00b4
1 changed files with 46 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
data/scripts/generate-gemlog.lisp
View File

@ -55,7 +55,7 @@
;; - date: (the date of the post, format: YYY-MM-DD) ;; - date: (the date of the post, format: YYY-MM-DD)
;; - topics: The post's' topics: a comma separated list of strings ;; - topics: The post's' topics: a comma separated list of strings
;; - skip: do not copy the post to the capsule's directory
;; For example ;; For example
;; […] ;; […]
@ -63,6 +63,7 @@
;; ``` META ;; ``` META
;; date: 2023-08-14 ;; date: 2023-08-14
;; topic: comics, cinema ;; topic: comics, cinema
;; skip
;; ``` ;; ```
(defpackage :generate-gemlog (defpackage :generate-gemlog
@ -84,6 +85,8 @@
(a:define-constant +meta-date-key+ :date :test #'eq) (a:define-constant +meta-date-key+ :date :test #'eq)
(a:define-constant +meta-skip-p+ :skip :test #'eq)
(a:define-constant +meta-key-value-delimiter+ ": *" :test #'string=) (a:define-constant +meta-key-value-delimiter+ ": *" :test #'string=)
(a:define-constant +archive-dir+ "archive" :test #'string=) (a:define-constant +archive-dir+ "archive" :test #'string=)
@ -184,7 +187,9 @@
(cl-ppcre:split +meta-topic-values-delimiters+ (cl-ppcre:split +meta-topic-values-delimiters+
raw-value)))) raw-value))))
(:date (:date
(parse-date raw-value)))))))) (parse-date raw-value))
(:skip
t)))))))
(defun extract-non-meta (parsed) (defun extract-non-meta (parsed)
(remove-if #'meta-node-p parsed)) (remove-if #'meta-node-p parsed))
@ -314,34 +319,45 @@
(lambda (a b) (lambda (a b)
(local-time:timestamp> (post-date a) (local-time:timestamp> (post-date a)
(post-date b))))) (post-date b)))))
(all-topics (collect-topics posts)) (archive-dir-path (strcat output-directory "/" +archive-dir+))
(archive-dir-path (strcat output-directory "/" +archive-dir+))) (effective-posts '()))
(fs:make-directory archive-dir-path) (fs:make-directory archive-dir-path)
(loop for post in posts do (loop for post in posts do
(let* ((file-name (fs:strip-dirs-from-path (original-file-path post))) (let* ((file-name (fs:strip-dirs-from-path (original-file-path post)))
(file-path (fs:cat-parent-dir archive-dir-path file-name))) (file-path (fs:cat-parent-dir archive-dir-path file-name)))
(setf (archive-file-path post) file-path) (cond
(handler-case ((cdr (assoc +meta-skip-p+ (meta post)))
(with-open-file (stream file-path (format t "skipping ~a as instructed by metadata.~%" file-path))
:direction :output ((fs:file-exists-p file-path)
:if-does-not-exist :create (push post effective-posts)
:if-exists :supersede) (setf (archive-file-path post) file-path))
(sexp->gmi (content post) stream) (t
(write-sequence (geminize-preformatted (format nil "~{#~a~^ ~}" (post-topics post))) (setf (archive-file-path post) file-path)
stream) (handler-case
(write-sequence (geminize-link (strcat " " (with-open-file (stream file-path
*post-home-backlink* :direction :output
" " :if-does-not-exist :create
*post-home-backlink-name*)) :if-exists :supersede)
stream) (sexp->gmi (content post) stream)
(write-char #\Newline stream) (write-sequence (geminize-preformatted (format nil "~{#~a~^ ~}" (post-topics post)))
(notify "Processed ~a~%" (original-file-path post))) stream)
(error (e) (write-sequence (geminize-link (strcat " "
(format *error-output* *post-home-backlink*
"skipping ~a, reasons: ~a.~%" " "
file-path *post-home-backlink-name*))
e))))) stream)
(values posts all-topics))) (write-char #\Newline stream)
(push post effective-posts)
(setf (archive-file-path post) file-path)
(notify "Processed ~a~%" (original-file-path post)))
(error (e)
(format *error-output*
"Error! Skipping ~a, reasons: ~a.~%"
file-path
e)))))))
(setf effective-posts (nreverse effective-posts))
(values effective-posts
(collect-topics effective-posts))))
(defun write-links (posts stream) (defun write-links (posts stream)
(flet ((clean-link-filename (filename) (flet ((clean-link-filename (filename)
@ -430,8 +446,10 @@
(defun generate-gemlog (bulk-posts-dir output-directory) (defun generate-gemlog (bulk-posts-dir output-directory)
(multiple-value-bind (all-posts all-topics) (multiple-value-bind (all-posts all-topics)
(create-archive bulk-posts-dir output-directory) (create-archive bulk-posts-dir output-directory)
(make-topic-index all-posts output-directory all-topics) (when (and all-posts all-topics)
(make-gemlog-index all-posts output-directory))) (make-topic-index all-posts output-directory all-topics))
(when all-posts
(make-gemlog-index all-posts output-directory))))
(a:define-constant +bulk-dir-prompt+ "Original posts directory? " :test #'string=) (a:define-constant +bulk-dir-prompt+ "Original posts directory? " :test #'string=)