From: Lucian Mogosanu <lucian.mogosanu@gmail.com>
Date: Sun, 19 Mar 2017 10:47:03 +0000 (+0200)
Subject: blog: Try to skip unmodified posts
X-Git-Tag: v0.10~20
X-Git-Url: https://git.mogosanu.ro/?a=commitdiff_plain;h=1f8c32e9e8466839f8a31972bdc97abd20f8bd25;p=thetarpit.git

blog: Try to skip unmodified posts

Disclaimer: verify this with much caution.
---

diff --git a/blog.lisp b/blog.lisp
index 5841d15..9471fc8 100644
--- a/blog.lisp
+++ b/blog.lisp
@@ -100,23 +100,26 @@
                    (concatenate 'string *lbs-base* relative-wildcard))))
     (assert (not (null postlist)))
     (dolist (x postlist)
-      (format t "[proc] ~s~%" x)
       (let* ((relative-pathname (post-relative-pathname x))
-             (blist (tlbs-make-blist relative-pathname)))
-        ; markdown -> html
-        (pipe-through-pandoc blist)
-        ; process tags
+             (blist (tlbs-make-blist relative-pathname))
+             (in-path (gethash "in-path" blist))
+             (out-path (gethash "out-path" blist)))
+        ;; process tags
         (tlbs-make-tagids blist)
-        ; post template
-        (tlbs-make-post blist)
-        ; default page template
-        (tlbs-make-default blist)
-        ; write to file
-        (tlbs-write-blist blist)
-        ; make sure body is erased when done writing
-        ; XXX: the body might still be needed when generating RSS
-        (setf (gethash "body" blist) nil)
-        ; add to post list
+        (when (file-modified in-path out-path)
+            (format t "[proc] ~s~%" x)
+            ;; markdown -> html
+            (pipe-through-pandoc blist)
+            ;; post template
+            (tlbs-make-post blist)
+            ;; default page template
+            (tlbs-make-default blist)
+            ;; write to file
+            (tlbs-write-blist blist)
+            ;; make sure body is erased when done writing
+            ;; XXX: the body might still be needed when generating RSS
+            (setf (gethash "body" blist) nil))
+        ;; add to post list
         (push blist *posts*))))
   nil)
 
@@ -199,8 +202,11 @@
       (let* ((relative-pathname (post-relative-pathname in-path))
              (out-path (concat-pathnames out-base-dir
                                          relative-pathname)))
-        (format t "[copy] ~s~%" in-path)
-        (tlbs-copy-file in-path out-path))
+        ;; XXX This probably not too reliable, would need to keep some
+        ;; hashes...
+        (when (file-modified in-path out-path)
+            (format t "[copy] ~s~%" in-path)
+            (tlbs-copy-file in-path out-path)))
       (dolist (new-in-path (directory (concat-pathnames in-path #p"*.*")))
         (tlbs-copy-recursively new-in-path out-base-dir))))
 
diff --git a/lbs-utils/utils.lisp b/lbs-utils/utils.lisp
index 620a869..5e59673 100644
--- a/lbs-utils/utils.lisp
+++ b/lbs-utils/utils.lisp
@@ -1,6 +1,6 @@
-;; Tarpit LBS utility library
+;;; Tarpit LBS utility library
 
-; This assumes pathnames are absolute to *lbs-base*
+;; This assumes pathnames are absolute to *lbs-base*
 (defun post-relative-pathname (pathname)
   (enough-namestring pathname (pathname *lbs-base*)))
 
@@ -18,6 +18,13 @@
    :name (pathname-name path2)
    :type (pathname-type path2)))
 
+;; XXX Not sure this should look this way. Probably comparing in-path to
+;; a reference hash of out-path might be better.
+(defun file-modified (in-path out-path)
+  (or (not (probe-file out-path))
+                (> (sb-posix:stat-mtime (sb-posix:stat in-path))
+                   (sb-posix:stat-mtime (sb-posix:stat out-path)))))
+
 ;; General utility functions
 (defun but-last (L)
   (let ((ret nil))