From: Stefan Monnier Date: Thu, 29 Nov 2012 15:58:17 +0000 (-0500) Subject: Try to preserve timestamps. Fix ChangeLog generation. X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/52f40a8375337c9122317190a2ef6bf8ba535487 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. --- diff --git a/.bzrignore b/.bzrignore index 3f58ec2b7..9c9e22e17 100644 --- a/.bzrignore +++ b/.bzrignore @@ -4,3 +4,5 @@ site packages/*/*-autoloads.el packages/*/*-pkg.el core +ChangeLog +packages/.changelog-witness diff --git a/Makefile b/Makefile index b2b8b451f..7b352b424 100644 --- a/Makefile +++ b/Makefile @@ -25,9 +25,17 @@ archive: archive-tmp 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 @@ process-archive: 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 diff --git a/admin/archive-contents.el b/admin/archive-contents.el index f2b6830d7..152a56a44 100644 --- a/admin/archive-contents.el +++ b/admin/archive-contents.el @@ -76,7 +76,7 @@ Delete backup files also." ;; 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 @@ Delete backup files also." (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 @@ Otherwise, return nil." (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 @@ package commentary to PKG-readme.txt. Return the descriptor." ;; 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 @@ PKG-readme.txt. Return the descriptor." (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))) diff --git a/admin/update-archive.sh b/admin/update-archive.sh index e4f33c8b0..e5de7872c 100755 --- a/admin/update-archive.sh +++ b/admin/update-archive.sh @@ -71,15 +71,26 @@ make archive-full >make.log 2>&1 || { signal_error "make archive-full failed" /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.