[Orgmode] Org-publish-cache - speed up publishing

[Sebastian Rose]

Hi Carsten and Friends of Org-mode,


appended is the ongoing caching stuff as patch against the current
master.

Please everyone: test this patch and report not _if_ it breaks
something, but _what_ it actually breaks :-P
It is meant to make life as a "publisher" easier (or at least faster
... or longer even?).



* What it does

It writes the information gathered during publishing to disk and
re-loads it from there the next time you publish the same project.

All those informations, currently titles and publishing-timestamps,
will survive a restart of emacs.

One cache file per publishing project is used. The contents of that file
is the elisp that fills the new variable `org-publish-cache'. The cache
is loaded using `load-file', once a project is to be published.

The cache file is named like the project with `.cache' appended and
lives in `org-timestamp-directory' [1]


`org-publish-cache' stores key value pairs:

  - "timestamp-filename" => time of last publishing as integer
    "timestamp-filename" is that sha1 hash of the filename,
    publishing-directory and publishing-function.

  - Absolute filename => plist
    Currently this plist holds just one property: `:title'
    to speed up sitemap generation.


The publishing is meant to keep working the exact way it did before.


Some minor quirks remain:

  - The cache file is written, even if
    `org-publish-use-timestamps-flag' is nil.

  - `org-publish-cache-file-needs-publishing' could replace
    `org-publish-needed-p' or it's body could go there.

  - In case of an error, the cache is not always written and
    cleared. This causes no trouble though.

  - We should add functions to clear the cache from old stuff. Now it's
    growing each time a file is added or renamed, but it won't shrink
    once a file is removed.
    The only way to clear the cache is to remove all cache files using
    `org-publish-remove-all-timestamps'



* Changes/Fixes:

  - Function `initialize-files-alist' and the variable
    `org-publish-files-alist' are not used anymore in favour of the
    reloadable cache and the functions for handling it. Removed
    therefor.

  - `org-publish-validate-link' was not used. Removed.

  - `org-publish-get-base-files'
    Added the variable `sitemap-requested' to avoid sorting where
    possible (see end of `org-publish-get-base-files-1').

  - `org-publish-get-project-from-filename'
    does not depend on a list of files anymore. Before, all files of
    all projects had to be loaded which took too much time here (my
    org-publish-project-alist is constantly growing).
    Instead of that, we walk `org-publish-project-alist' until we find
    a project, where the properties :base-directory, :recursive,
    :base-extension, :include and :exclude match.

    This must especially be tested in different setups, since a failure
    might expose private files to the public.

  - `org-publish-file'
    takes an additional parameter to avoid superfloues loading and
    writing of the cache file when used to publish a part of a project.

  - Everting below.



* Internal usage of the cache:

   - org-publish-reset-cache ()
     Ensure the cache is nil.

   - org-publish-initialize-cache (project-name)
     Initialize the cache for a certain project.

   - org-publish-write-cache-file ()
     Write the cache to file.

  To get and set values, four functions are provided:

    - org-publish-cache-set (key value)
      Simple key => value association.
    - org-publish-cache-get (key)
      Dito.

    - org-publish-cache-set-file-property (file prop value)
      Set a property to value in plist associated with file.
    - org-publish-cache-get-file-property (file prop value)
      Get a property's value out of plist associated with file.

  Helpers:

    - org-publish-cache-ctime-of-src (filename)
      Return the ctime of file filename as integer.





diff --git a/lisp/org-publish.el b/lisp/org-publish.el
index 328d961..43a36db 100644
--- a/lisp/org-publish.el
+++ b/lisp/org-publish.el
@@ -257,29 +257,19 @@ You can overwrite this default per project in your
   "Return path to timestamp file for filename FILENAME."
   (setq filename (concat filename "::" (or pub-dir "") "::"
                         (format "%s" (or pub-func ""))))
-  (concat (file-name-as-directory org-publish-timestamp-directory)
-         "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+  (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
 
 (defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
   "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC.
-TRUE-PUB-DIR is there the file will truely end up.  Currently we are not using
+TRUE-PUB-DIR is where the file will truely end up.  Currently we are not using
 this - maybe it can eventually be used to check if the file is present at
 the target location, and how old it is.  Right ow we cannot do this, because
 we do not know under what file name the file will be stored - the publishing
 function can still decide about that independently."
   (let ((rtn
         (if org-publish-use-timestamps-flag
-            (if (file-exists-p org-publish-timestamp-directory)
-                ;; first handle possible wrong timestamp directory
-                (if (not (file-directory-p org-publish-timestamp-directory))
-                    (error "Org publish timestamp: %s is not a directory"
-                           org-publish-timestamp-directory)
-                  ;; there is a timestamp, check if FILENAME is newer
-                  (file-newer-than-file-p
-                   filename (org-publish-timestamp-filename
-                             filename pub-dir pub-func)))
-              (make-directory org-publish-timestamp-directory)
-              t)
+            (org-publish-cache-file-needs-publishing
+             filename pub-dir pub-func)
           ;; don't use timestamps, always return t
           t)))
     (if rtn
@@ -291,20 +281,9 @@ function can still decide about that independently."
 (defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
   "Update publishing timestamp for file FILENAME.
 If there is no timestamp, create one."
-  (let ((timestamp-file (org-publish-timestamp-filename
-                        filename pub-dir pub-func))
-       newly-created-timestamp)
-    (if (not (file-exists-p timestamp-file))
-       ;; create timestamp file if needed
-       (with-temp-buffer
-         (make-directory (file-name-directory timestamp-file) t)
-         (write-file timestamp-file)
-         (setq newly-created-timestamp t)))
-    ;; Emacs 21 doesn't have `set-file-times'
-    (if (and (fboundp 'set-file-times)
-            (not newly-created-timestamp))
-       (set-file-times timestamp-file)
-      (call-process "touch" nil 0 nil (expand-file-name timestamp-file)))))
+  (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+       (stamp (org-publish-cache-ctime-of-src filename)))
+    (org-publish-cache-set key stamp)))
 
 (defun org-publish-remove-all-timestamps ()
   "Remove all files in the timstamp directory."
@@ -312,17 +291,12 @@ If there is no timestamp, create one."
        files)
     (when (and (file-exists-p dir)
               (file-directory-p dir))
-      (mapc 'delete-file (directory-files dir 'full "[^.]\\'")))))
+      (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+      (org-publish-reset-cache))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Mapping files to project names
-
-(defvar org-publish-files-alist nil
-  "Alist of files and their parent projects.
-Each element of this alist is of the form:
-
-  (file-name . project-name)")
+;;;
 
 (defvar org-publish-initial-buffer nil
   "The buffer `org-publish' has been called from.")
@@ -330,21 +304,10 @@ Each element of this alist is of the form:
   "Temporary list of files to be published.")
 
 ;; Here, so you find the variable right before it's used the first time:
-(defvar org-publish-file-title-cache nil
-  "List of absolute filenames and titles.")
+(defvar org-publish-cache nil
+  "This will cache all the timestamps and titles for
+files in publishing projects. Blocks could hash sha1 values here.")
 
-(defun org-publish-initialize-files-alist (&optional refresh)
-  "Set `org-publish-files-alist' if it is not set.
-Also set it if the optional argument REFRESH is non-nil."
-  (interactive "P")
-  (when (or refresh (not org-publish-files-alist))
-    (setq org-publish-file-title-cache nil)
-    (setq org-publish-files-alist
-         (org-publish-get-files org-publish-project-alist))))
-
-(defun org-publish-validate-link (link &optional directory)
-  "Check if LINK points to a file in the current project."
-  (assoc (expand-file-name link directory) org-publish-files-alist))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Compatibility aliases
@@ -452,9 +415,12 @@ matching the regexp SKIP-DIR when recursing through 
BASE-DIR."
                          (and skip-file (string-match skip-file fnd))
                          (not (file-exists-p (file-truename f)))
                          (not (string-match match fnd)))
+
                (pushnew f org-publish-temp-files)))))
-       (sort (directory-files base-dir t (unless recurse match))
-             'org-publish-compare-directory-files)))
+       (if sitemap-requested
+           (sort (directory-files base-dir t (unless recurse match))
+                 'org-publish-compare-directory-files)
+         (directory-files base-dir t (unless recurse match)))))
 
 (defun org-publish-get-base-files (project &optional exclude-regexp)
   "Return a list of all files in PROJECT.
@@ -466,20 +432,22 @@ matching filenames."
         (include-list (plist-get project-plist :include))
         (recurse (plist-get project-plist :recursive))
         (extension (or (plist-get project-plist :base-extension) "org"))
-     ;; sitemap-... variables are dynamically scoped for
-     ;; org-publish-compare-directory-files:
-     (sitemap-sort-folders
-          (if (plist-member project-plist :sitemap-sort-folders)
-              (plist-get project-plist :sitemap-sort-folders)
-            org-publish-sitemap-sort-folders))
-     (sitemap-alphabetically
-      (if (plist-member project-plist :sitemap-alphabetically)
-          (plist-get project-plist :sitemap-alphabetically)
-        org-publish-sitemap-sort-alphabetically))
-         (sitemap-ignore-case
-       (if (plist-member project-plist :sitemap-ignore-case)
-           (plist-get project-plist :sitemap-ignore-case)
-         org-publish-sitemap-sort-ignore-case))
+        ;; sitemap-... variables are dynamically scoped for
+        ;; org-publish-compare-directory-files:
+        (sitemap-requested
+         (plist-get project-plist :auto-sitemap))
+        (sitemap-sort-folders
+         (if (plist-member project-plist :sitemap-sort-folders)
+             (plist-get project-plist :sitemap-sort-folders)
+           org-publish-sitemap-sort-folders))
+        (sitemap-alphabetically
+         (if (plist-member project-plist :sitemap-alphabetically)
+             (plist-get project-plist :sitemap-alphabetically)
+           org-publish-sitemap-sort-alphabetically))
+        (sitemap-ignore-case
+         (if (plist-member project-plist :sitemap-ignore-case)
+             (plist-get project-plist :sitemap-ignore-case)
+           org-publish-sitemap-sort-ignore-case))
         (match (if (eq extension 'any)
                     "^[^\\.]"
                  (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
@@ -501,8 +469,26 @@ matching filenames."
 
 (defun org-publish-get-project-from-filename (filename &optional up)
   "Return the project FILENAME belongs."
-  (let* ((project-name (cdr (assoc (expand-file-name filename)
-                                  org-publish-files-alist))))
+  (let* ((filename (expand-file-name filename))
+        project-name)
+
+    (catch 'p-found
+      (dolist (prj org-publish-project-alist)
+       (unless (plist-get (cdr prj) :components)
+         ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+         (let* ((r (plist-get (cdr prj) :recursive))
+                (b (expand-file-name (plist-get (cdr prj) :base-directory)))
+                (x (plist-get (cdr prj) :base-extension))
+                (e (plist-get (cdr prj) :exclude))
+                (i (plist-get (cdr prj) :include))
+                (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+           (when (or
+                  (and i (string-match i filename))
+                  (and
+                   (not (and e (string-match e filename)))
+                   (string-match xm filename)))
+             (setq project-name (car prj))
+             (throw 'p-found project-name))))))
     (when up
       (dolist (prj org-publish-project-alist)
        (if (member project-name (plist-get (cdr prj) :components))
@@ -600,20 +586,17 @@ See `org-publish-org-to' to the list of arguments."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Publishing files, sets of files, and indices
 
-(defun org-publish-file (filename &optional project)
-  "Publish file FILENAME from PROJECT."
+(defun org-publish-file (filename &optional project no-cache)
+  "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-publish-projects'."
   (let* ((project
          (or project
              (or (org-publish-get-project-from-filename filename)
-                 (if (y-or-n-p
-                      (format "%s is not in a project.  Re-read the list of 
projects files? "
-                              (abbreviate-file-name filename)))
-                     ;; If requested, re-initialize the list of projects files
-                     (progn (org-publish-initialize-files-alist t)
-                            (or (org-publish-get-project-from-filename 
filename)
-                                (error "File %s not part of any known project"
-                                       (abbreviate-file-name filename))))
-                   (error "Can't publish file outside of a project")))))
+                 (error "File %s not part of any known project"
+                        (abbreviate-file-name filename)))))
         (project-plist (cdr project))
         (ftname (file-truename filename))
         (publishing-function
@@ -624,6 +607,10 @@ See `org-publish-org-to' to the list of arguments."
         (pub-dir (file-name-as-directory
                   (file-truename (plist-get project-plist 
:publishing-directory))))
         tmp-pub-dir)
+
+    (unless no-cache
+      (org-publish-initialize-cache (car project)))
+
     (setq tmp-pub-dir
          (file-name-directory
           (concat pub-dir
@@ -640,7 +627,8 @@ See `org-publish-org-to' to the list of arguments."
                                  tmp-pub-dir)
        (funcall publishing-function project-plist filename tmp-pub-dir)
        (org-publish-update-timestamp
-        filename pub-dir publishing-function)))))
+        filename pub-dir publishing-function)))
+    (unless no-cache (org-publish-write-cache-file))))
 
 (defun org-publish-projects (projects)
   "Publish all files belonging to the PROJECTS alist.
@@ -648,6 +636,8 @@ If :auto-sitemap is set, publish the sitemap too.
 If :makeindex is set, also produce a file theindex.org."
   (mapc
    (lambda (project)
+     ;; Each project uses it's own cache file:
+     (org-publish-initialize-cache (car project))
      (let*
         ((project-plist (cdr project))
          (exclude-regexp (plist-get project-plist :exclude))
@@ -662,19 +652,20 @@ If :makeindex is set, also produce a file theindex.org."
        (when preparation-function (run-hooks 'preparation-function))
        (if sitemap-p (funcall sitemap-function project sitemap-filename))
        (while (setq file (pop files))
-        (org-publish-file file project))
+        (org-publish-file file project t))
        (when (plist-get project-plist :makeindex)
         (org-publish-index-generate-theindex.inc
          (plist-get project-plist :base-directory))
         (org-publish-file (expand-file-name
                            "theindex.org"
                            (plist-get project-plist :base-directory))
-                          project))
-       (when completion-function (run-hooks 'completion-function))))
+                          project t))
+       (when completion-function (run-hooks 'completion-function))
+     (org-publish-write-cache-file)))
    (org-publish-expand-projects projects)))
 
 (defun org-publish-org-sitemap (project &optional sitemap-filename)
-  "Create an sitemap of pages in set defined by PROJECT.
+  "Create a sitemap of pages in set defined by PROJECT.
 Optionally set the filename of the sitemap with SITEMAP-FILENAME.
 Default for SITEMAP-FILENAME is 'sitemap.org'."
   (let* ((project-plist (cdr project))
@@ -738,9 +729,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
 
 (defun org-publish-find-title (file)
   "Find the title of file in project."
-  (if (member file org-publish-file-title-cache)
-      (cadr (member file org-publish-file-title-cache))
-  (let* ((visiting (find-buffer-visiting file))
+  (or
+   (org-publish-cache-get-file-property file :title nil t)
+   (let* ((visiting (find-buffer-visiting file))
         (buffer (or visiting (find-file-noselect file)))
         title)
     (with-current-buffer buffer
@@ -754,8 +745,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
                  (file-name-nondirectory (file-name-sans-extension file))))))
     (unless visiting
       (kill-buffer buffer))
-    (setq org-publish-file-title-cache
-          (append org-publish-file-title-cache (list file title)))
+    (org-publish-cache-set-file-property file :title title)
     title)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -788,7 +778,7 @@ directory and force publishing all files."
   (interactive "P")
   (when force
     (org-publish-remove-all-timestamps))
-  (org-publish-initialize-files-alist force)
+  ;;  (org-publish-initialize-files-alist force)
   (save-window-excursion
     (let ((org-publish-use-timestamps-flag
           (if force nil org-publish-use-timestamps-flag)))
@@ -800,7 +790,6 @@ directory and force publishing all files."
   "Publish the current file.
 With prefix argument, force publish the file."
   (interactive "P")
-  (org-publish-initialize-files-alist force)
   (save-window-excursion
     (let ((org-publish-use-timestamps-flag
           (if force nil org-publish-use-timestamps-flag)))
@@ -812,13 +801,13 @@ With prefix argument, force publish the file."
 With a prefix argument, force publishing of all files in
 the project."
   (interactive "P")
-  (org-publish-initialize-files-alist force)
   (save-window-excursion
     (let ((project (org-publish-get-project-from-filename (buffer-file-name) 
'up))
          (org-publish-use-timestamps-flag
           (if force nil org-publish-use-timestamps-flag)))
       (if (not project)
          (error "File %s is not part of any known project" (buffer-file-name)))
+      ;; FIXME: force is not used here?
       (org-publish project))))
 
 
@@ -914,8 +903,138 @@ the project."
          (save-buffer))
        (kill-buffer ibuffer)))))
 
-(provide 'org-publish)
 
+;; Caching functions:
+
+(defun org-publish-write-cache-file (&optional free-cache)
+  "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+  (unless org-publish-cache
+    (error "%s" "`org-publish-write-cache-file' called, but no cache present"))
+
+  (let ((cache-file (org-publish-cache-get ":cache-file:")))
+    (unless cache-file
+      (error "%s" "Cannot find cache-file name in 
`org-publish-write-cache-file'"))
+    (with-temp-file cache-file
+      (let ((print-level nil)
+            (print-length nil))
+        (insert
+         "(setq org-publish-cache\n  "
+        (replace-regexp-in-string "\\([^\\ \t]\"\\) \\([^ \t]\\)" "\\1\n\\2"
+                                  (format "%S" org-publish-cache))
+         ")\n")))
+    (when free-cache (org-publish-reset-cache))))
+
+(defun org-publish-initialize-cache (project-name)
+  "Initialize the projects cache if not intialized yet
+and return it."
+
+  (unless project-name
+    (error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
+          " in `org-publish-initialize-cache'"))
+
+  (unless (file-exists-p org-publish-timestamp-directory)
+    (make-directory org-publish-timestamp-directory))
+  (if (not (file-directory-p org-publish-timestamp-directory))
+      (error "Org publish timestamp: %s is not a directory"
+            org-publish-timestamp-directory))
+
+  (unless (and org-publish-cache
+              (string= (org-publish-cache-get ":project:") project-name))
+    (when org-publish-cache (org-publish-reset-cache))
+    (let* ((cache-file (concat
+                       (expand-file-name org-publish-timestamp-directory)
+                       project-name
+                       ".cache"))
+          (cexists (file-exists-p cache-file)))
+      (if cexists (load-file cache-file))
+      (unless org-publish-cache
+       (setq org-publish-cache
+             #s(hash-table test equal weakness nil size 100 data ()))
+       (org-publish-cache-set ":project:" project-name)
+       (org-publish-cache-set ":cache-file:" cache-file org-publish-cache))
+      (unless cexists (org-publish-write-cache-file nil))))
+  org-publish-cache)
+
+(defun org-publish-reset-cache ()
+  "Empty org-publish-cache and reset it nil."
+  (message "%s" "Resetting org-publish-cache")
+  (if (hash-table-p org-publish-cache)
+      (clrhash org-publish-cache))
+  (setq org-publish-cache nil))
+
+(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir 
pub-func)
+  "Check the timestamp of the last publishing of FILENAME.
+Return `t', if the file needs publishing"
+  (unless org-publish-cache
+    (error "%s" "`org-publish-cache-file-needs-publishing' called, but no 
cache present"))
+  (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+        (pstamp (org-publish-cache-get key)))
+    (if (null pstamp)
+       t
+      (let ((ctime (org-publish-cache-ctime-of-src filename)))
+       (< pstamp ctime)))))
+
+(defun org-publish-cache-set-file-property (filename property value &optional 
project-name)
+  "Set the VALUE for a PORPERTY of file FILENAME in publishing cache
+to VALUE. Use cache file of PROJECT-NAME.
+If the entry does not exist, it will be created.
+Return VALUE."
+  ;; Evtl. load the requested cache file:
+  (if project-name (org-publish-initialize-cache project-name))
+  (let ((pl (org-publish-cache-get filename)))
+    (if pl
+       (progn
+         (plist-put pl property value)
+         value)
+      (org-publish-cache-get-file-property
+       filename property value nil project-name))))
+
+(defun org-publish-cache-get-file-property
+  (filename property &optional default no-create project-name)
+  "Return the value for a PORPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
+DEFAULT, if the value does not yet exist.
+If the entry will be created, unless NO-CREATE is not nil."
+  ;; Evtl. load the requested cache file:
+  (if project-name (org-publish-initialize-cache project-name))
+  (let ((pl (org-publish-cache-get filename))
+       (retval nil))
+    (if pl
+       (if (plist-member pl property)
+           (setq retval (plist-get pl property))
+         (setq retval default))
+      ;; no pl yet:
+      (unless no-create
+       (org-publish-cache-put filename (list property default)))
+      (setq retval default))
+    retval))
+
+(defun org-publish-cache-get (key)
+  "Return the value stored in `org-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+  (unless org-publish-cache
+    (error "%s" "`org-publish-cache-get' called, but no cache present"))
+  (gethash key org-publish-cache))
+
+(defun org-publish-cache-set (key value)
+  "Store KEY VLAUE pair in `org-publish-cache'.
+Returns value on success, else nil."
+  (unless org-publish-cache
+    (error "%s" "`org-publish-cache-set' called, but no cache present"))
+  (puthash key value org-publish-cache))
+
+(defun org-publish-cache-ctime-of-src (filename)
+  "Get the files ctime as integer."
+  (let ((src-attr (file-attributes filename)))
+    (+
+     (lsh (car (nth 5 src-attr)) 16)
+     (cadr (nth 5 src-attr)))))
+
+
+
+(provide 'org-publish)
 
 ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb
 



Best wishes

   Sebastian



== Footnotes:

[1] I would love to drop `org-timestamp-directory' in favour of a `.org'
    in the `:base-directory' of a project. We now have that index
    feature, tag-files and certainly more to come...