emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[ELPA-diffs] /srv/bzr/emacs/elpa r305: Try to preserve timestamps. Fix C


From: Stefan Monnier
Subject: [ELPA-diffs] /srv/bzr/emacs/elpa r305: Try to preserve timestamps. Fix ChangeLog generation.
Date: Thu, 29 Nov 2012 10:58:17 -0500
User-agent: Bazaar (2.5.0)

------------------------------------------------------------
revno: 305
committer: Stefan Monnier <address@hidden>
branch nick: elpa
timestamp: Thu 2012-11-29 10:58:17 -0500
message:
  Try to preserve timestamps.  Fix ChangeLog generation.
  * admin/update-archive.sh: Don't change timestamp on packages that have the
  same md5.
  * admin/archive-contents.el (batch-prepare-packages): New function.
  (archive--simple-package-p): Ignore ChangeLog as well.  Signal errors if the
  file does not have the expected structure.
  (archive--process-simple-package): Add the ChangeLog's content.
  (archive--make-changelog): Only modify the file if the content changes.
  (archive--process-multi-file-package): Don't make the ChangeLog here, since we
  may not even have the Bzr metadata at hand any more.
  * Makefile (archive-tmp): Preserve symlinks.
  (process-archive): Call new batch-prepare-packages.
  * .bzrignore: Add Changelog and .changelog-witness.
modified:
  .bzrignore
  Makefile
  admin/archive-contents.el
  admin/update-archive.sh
=== modified file '.bzrignore'
--- a/.bzrignore        2011-07-06 17:36:27 +0000
+++ b/.bzrignore        2012-11-29 15:58:17 +0000
@@ -4,3 +4,5 @@
 packages/*/*-autoloads.el
 packages/*/*-pkg.el
 core
+ChangeLog
+packages/.changelog-witness

=== modified file 'Makefile'
--- a/Makefile  2012-10-30 17:49:47 +0000
+++ b/Makefile  2012-11-29 15:58:17 +0000
@@ -25,9 +25,17 @@
 
 archive-tmp: packages
        mkdir -p $(ARCHIVE_TMP)
-       cp -r packages/. $(ARCHIVE_TMP)/packages
+       cp -a packages/. $(ARCHIVE_TMP)/packages
 
 process-archive:
+       # First, refresh the ChangeLog files.  This needs to be done in
+       # the source tree, because it needs the Bzr data!
+       cd packages; \
+       $(EMACS) -batch -l $(CURDIR)/admin/archive-contents.el \
+                       -f batch-prepare-packages
+       # FIXME, we could probably speed this up significantly with
+       # rules like "%.tar: ../%/ChangeLog" so we only rebuild the packages
+       # that have indeed changed.
        cd $(ARCHIVE_TMP)/packages; $(EMACS) -batch -l 
$(CURDIR)/admin/archive-contents.el -f batch-make-archive
        @cd $(ARCHIVE_TMP)/packages; \
        for pt in *; do \
@@ -43,8 +51,7 @@
        rm -rf archive/packages-old
        rm -rf $(ARCHIVE_TMP)
 
-## Deploy the package archive to archive/ including the Org daily and
-## admin scripts:
+## Deploy the package archive to archive/ including the Org daily:
 archive-full: archive-tmp org-fetch
        $(MAKE) $(MFLAGS) process-archive
        #mkdir -p archive/admin

=== modified file 'admin/archive-contents.el'
--- a/admin/archive-contents.el 2012-11-01 04:11:20 +0000
+++ b/admin/archive-contents.el 2012-11-29 15:58:17 +0000
@@ -76,7 +76,7 @@
              ;; Test whether this is a simple or multi-file package.
              (setq simple-p (archive--simple-package-p dir pkg))
              (push (if simple-p
-                       (apply 'archive--process-simple-package
+                       (apply #'archive--process-simple-package
                               dir pkg simple-p)
                      (archive--process-multi-file-package dir pkg))
                    packages)))
@@ -86,6 +86,41 @@
       (pp (nreverse packages) (current-buffer))
       (write-region nil nil "archive-contents"))))
 
+(defun batch-prepare-packages ()
+  "Prepare the `packages' directory inside the Bzr checkout.
+Expects to be called from within the `packages' directory.
+\"Prepare\" here is for subsequent construction of the packages and archive,
+so it is meant to refresh any generated files we may need.
+Currently only refreshes the ChangeLog files."
+  (let* ((wit ".changelog-witness")
+         (prevno (or (with-temp-buffer
+                       (ignore-errors (insert-file-contents wit))
+                       (when (looking-at "[1-9][0-9]*\\'")
+                         (string-to-number (match-string 0))))
+                     1))
+         (new-revno
+          (or (with-temp-buffer
+                (call-process "bzr" nil '(t) nil "revno")
+                (goto-char (point-min))
+                (when (looking-at "[1-9][0-9]*$")
+                  (string-to-number (match-string 0))))
+              (error "bzr revno did not return a number as expected")))
+         (pkgs '()))
+    (unless (= prevno new-revno)
+      (with-temp-buffer
+        (unless (zerop (call-process "bzr" nil '(t) nil "log" "-v"
+                                     (format "-r%d.." (1+ prevno))))
+          (error "Error signaled by bzr log -v -r%d.." (1+ prevno)))
+        (goto-char (point-min))
+        (while (re-search-forward "^  packages/\\([-[:alnum:]]+\\)/" nil t)
+          (cl-pushnew (match-string 1) pkgs :test #'equal))))
+    (dolist (pkg pkgs)
+      (condition-case v
+          (if (file-directory-p pkg)
+              (archive--make-changelog pkg))
+        (error (message "%s" (cadr v)))))
+    (write-region (number-to-string new-revno) nil wit nil 'quiet)))
+
 (defun archive--simple-package-p (dir pkg)
   "Test whether DIR contains a simple package named PKG.
 If so, return a list (VERSION DESCRIPTION REQ COMMENTARY), where
@@ -100,27 +135,32 @@
     (dolist (file (prog1 files (setq files ())))
       (unless (string-match "\\.elc\\'" file)
         (push file files)))
-    (when (and (or (not (file-exists-p pkg-file))
-                  (= (length files) 2))
-              (file-exists-p mainfile))
+    (setq files (delete (concat pkg "-pkg.el") files))
+    (setq files (delete (concat pkg "-autoloads.el") files))
+    (setq files (delete "ChangeLog" files))
+    (cond
+     ((and (or (not (file-exists-p pkg-file))
+               (= (length files) 1))
+           (file-exists-p mainfile))
       (with-temp-buffer
        (insert-file-contents mainfile)
        (goto-char (point-min))
-       (and (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ 
\t]*\\)?$")
-            (progn
-              (setq description (match-string 1))
-              (setq version
-                    (or (archive--strip-rcs-id (lm-header "package-version"))
-                        (archive--strip-rcs-id (lm-header "version"))
-                         "0.0")))
-            (progn
-              ;; Grab the other fields, which are not mandatory.
-              (let ((requires-str (lm-header "package-requires")))
-                (if requires-str
-                    (setq req (mapcar 'archive--convert-require
-                                      (car (read-from-string requires-str))))))
-              (setq commentary (lm-commentary))
-              (list version description req commentary)))))))
+       (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ 
\t]*\\)?$"))
+            (error "Can't parse first line of %s" mainfile)
+          (setq description (match-string 1))
+          (setq version
+                (or (archive--strip-rcs-id (lm-header "package-version"))
+                    (archive--strip-rcs-id (lm-header "version"))
+                    (error "Missing `version' header")))
+          ;; Grab the other fields, which are not mandatory.
+          (let ((requires-str (lm-header "package-requires")))
+            (if requires-str
+                (setq req (mapcar 'archive--convert-require
+                                  (car (read-from-string requires-str))))))
+          (setq commentary (lm-commentary))
+          (list version description req commentary))))
+     ((not (file-exists-p pkg-file))
+      (error "Can find single file nor package desc file in %s" dir)))))
 
 (defun archive--process-simple-package (dir pkg vers desc req commentary)
   "Deploy the contents of DIR into the archive as a simple package.
@@ -147,14 +187,39 @@
   ;; Write DIR/foo.el to foo-VERS.el and delete DIR
   (rename-file (expand-file-name (concat pkg ".el") dir)
               (concat pkg "-" vers ".el"))
+  ;; Add the content of the ChangeLog.
+  (let ((cl (expand-file-name "ChangeLog" dir)))
+    (with-current-buffer (find-file-noselect (concat pkg "-" vers ".el"))
+      (goto-char (point-max))
+      (re-search-backward "^;;;.*ends here")
+      (re-search-backward "^(provide")
+      (skip-chars-backward " \t\n")
+      (insert "\n")
+      (let ((start (point)))
+        (insert-file-contents cl)
+        (unless (bolp) (insert "\n"))
+        (comment-region start (point)))
+      (save-buffer)
+      (kill-buffer)))
   (delete-directory dir t)
   (cons (intern pkg) (vector (version-to-list vers) req desc 'single)))
 
 (defun archive--make-changelog (dir)
   "Export Bzr log info of DIR into a ChangeLog file."
+  (message "Refreshing ChangeLog in %S" dir)
   (let ((default-directory (file-name-as-directory (expand-file-name dir))))
-    (call-process "bzr" nil '(:file "ChangeLog") nil
-                  "log" "--gnu-changelog" ".")))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (let ((coding-system-for-read 'binary)
+            (coding-system-for-write 'binary))
+        (if (file-readable-p "ChangeLog") (insert-file-contents "ChangeLog"))
+        (let ((old-md5 (md5 (current-buffer))))
+          (erase-buffer)
+          (call-process "bzr" nil (current-buffer) nil
+                        "log" "--gnu-changelog" ".")
+          (if (equal old-md5 (md5 (current-buffer)))
+              (message "ChangeLog's md5 unchanged for %S" dir)
+            (write-region (point-min) (point-max) "ChangeLog" nil 'quiet)))))))
 
 (defun archive--process-multi-file-package (dir pkg)
   "Deploy the contents of DIR into the archive as a multi-file package.
@@ -164,7 +229,6 @@
         (vers (nth 2 exp))
         (req (mapcar 'archive--convert-require (nth 4 exp)))
         (readme (expand-file-name "README" dir)))
-    (archive--make-changelog dir)
     (unless (equal (nth 1 exp) pkg)
       (error (format "Package name %s doesn't match file name %s"
                     (nth 1 exp) pkg)))

=== modified file 'admin/update-archive.sh'
--- a/admin/update-archive.sh   2012-11-01 04:11:20 +0000
+++ b/admin/update-archive.sh   2012-11-29 15:58:17 +0000
@@ -71,15 +71,26 @@
     signal_error "make archive-full failed" <make.log
     exit 1
 }
+latest="emacs-packages-latest.tgz"
 (cd archive
- tar zcf emacs-packages-latest.tgz packages)
+ tar zcf "$latest" packages)
 (cd ~elpa
  # Not sure why we have `staging-old', but let's keep it for now.
  rm -rf staging-old
  cp -a staging staging-old
  # Move new files into place but don't throw out old package versions.
- mv build/archive/packages/* staging/packages/
- mv build/archive/* staging/ 2>/dev/null
+ for f in build/archive/packages/*; do
+     dst="staging/packages/$(basename "$f")"
+     # FIXME: it'd be better to only rebuild the packages that have been
+     # modified, rather than rely on md5 to try and abort the refresh
+     # when we don't want it!
+     if [ -r "$dst" ] && [ "$(md5sum <"$f")" = "$(md5sum <"$dst")" ]; then
+         rm "$f"
+     else
+         mv "$f" "$dst"
+     fi
+ done
+ mv build/archive/"$latest" staging/
  rm -rf build/archive)
 
 # Make the HTML files.


reply via email to

[Prev in Thread] Current Thread [Next in Thread]