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