Publishing, cashing and timestamps

Carsten Dominik <carsten.dominik@gmail.com> writes:
> Hi Sebastian,
>
> sorry for being slow.  Could you do me a favor and send me the cache patch one
> more time - if possible updated to the current master.
>
> I am just not sure I have the right patch in my hands.

Hi Carsten,

no problem. The patch is attached.

Here is a list of my ChangeLog entries, redated to today:

2010-05-13  Sebastian Rose  <sebastian_rose@gmx.de>

	* org-publish.el (org-publish-cache): Use one big hashmap for
	each project defined in `org-publish-project-alist'. The
	hashmap will hold pairs of our timestamp-filenames and
	timestamps, as well as pairs of source-paths and associated
	plists for arbitrary values. Currently only the files title is
	stored there.

	The caching feature writes the information gathered during
	publishing to disk and re-loads it from there the next time we
	publish the same project.  All those informations will hence
	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 file is named according to the
	project with `.cache' added and lives in
	`org-timestamp-directory'.

	* org-publish.el (initialize-files-alist): This function 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.el (org-publish-validate-link) was not used
	anywhere. Removed.

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

	* org-publish.el (org-publish-get-files): This function is
	not called anymore. Removed.

	* org-publish.el (org-publish-get-project-from-filename) does
	not depend on a list of files anymore. Instead of laoding all
	files of all, we walk `org-publish-project-alist' until we
	find a project, where the properties :base-directory, :recursive,
	:base-extension, :include and :exclude match.

	* org-publish.el (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.

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
@@ -372,23 +335,6 @@ This is a compatibility function for Emacsen without `delete-dups'."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Getting project information out of org-publish-project-alist
 
-(defun org-publish-get-files (projects-alist &optional no-exclusion)
-  "Return the list of all publishable files for PROJECTS-ALIST.
-If NO-EXCLUSION is non-nil, don't exclude files."
-  (let (all-files)
-    ;; add all projects
-    (mapc
-     (lambda(p)
-       (let* ((exclude (plist-get (cdr p) :exclude))
-	      (files (and p (org-publish-get-base-files p exclude))))
-	 ;; add all files from this project
-	 (mapc (lambda(f)
-		 (add-to-list 'all-files
-			      (cons (expand-file-name f) (car p))))
-	       files)))
-     (org-publish-expand-projects projects-alist))
-    all-files))
-
 (defun org-publish-expand-projects (projects-alist)
   "Expand projects in PROJECTS-ALIST.
 This splices all the components into the list."
@@ -456,9 +402,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.
@@ -470,20 +419,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 "\\)$"))))
@@ -505,8 +456,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))
@@ -604,20 +573,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
@@ -628,6 +594,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
@@ -644,7 +614,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.
@@ -652,6 +623,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))
@@ -666,19 +639,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))
@@ -742,9 +716,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
@@ -758,8 +732,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)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -792,7 +765,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)))
@@ -804,7 +777,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)))
@@ -816,13 +788,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))))
 
 
@@ -918,8 +890,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-set 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