Newer
Older
(in-package :asdf-tools)
;;; Extracting version information
(defparameter *version-tag-glob* "[0-9][.][0-9]*")
(defun version-from-tag (&optional commit)
Francois-Rene Rideau
committed
;; run-program issue: :output :line closes the fd, which causes the program to die in error.
(first (nth-value 2 (git `(describe --tags --match ,*version-tag-glob* ,commit) :output :lines))))
(defun version-from-file (&optional commit)
(if commit
(nth-value 2 (git `(show (,commit":version.lisp-expr")) :output :form))
(safe-read-file-form (pn "version.lisp-expr"))))
(defun debian-version-from-file (&optional commit)
(match (if commit
Francois-Rene Rideau
committed
;; run-program issue: :output :line closes the fd, which causes the program to die in error.
(first (nth-value 2 (git `(show (,commit":debian/changelog"))
:output :lines :error-output nil)))
(read-file-line (pn "debian/changelog")))
((ppcre "^[^(]*\\(([-0-9.:-]+)\\)" ver) ver)))
(defun parse-debian-version (&optional (debian-version (debian-version-from-file)))
(cl-ppcre:register-groups-bind (epoch ver rel)
("^(?:([0-9]+):)?([0-9.]+)(?:-([0-9]+))$" debian-version)
;; NB: (A) we return version first, not epoch, because it's the primary result!
;; (B) epoch = nil is semantically same as epoch = 0
;; (C) rel = nil is for debian-native packages, e.g. base-passwd or cowbuilder
(values ver epoch rel)))
(defun debian-version-string (ver epoch rel)
(format nil "~@[~D:~]~A~@[-~A~]" epoch ver rel))
(defun debian-version-without-epoch (version-string)
(multiple-value-bind (ver epoch rel) (parse-debian-version version-string)
(declare (ignore epoch))
(debian-version-string ver nil rel)))
;;; Bumping the version of ASDF
(defparameter *versioned-files*
'(("version.lisp-expr" "\"" "\"")
("uiop/version.lisp-expr" "\"" "\"")
("asdf.asd" " :version \"" "\" ;; to be automatically updated by make bump-version")
("header.lisp" "This is ASDF " ": Another System Definition Facility.")
("upgrade.lisp" " (asdf-version \"" "\")")
("doc/asdf.texinfo" "Manual for Version " ""))) ;; NB: two occurrences with this pattern.
(defparameter *old-version* :default)
(defparameter *new-version* :default)
(defun next-version (v)
(let ((pv (parse-version v 'error)))
(assert (first pv))
(assert (second pv))
(unless (third pv) (appendf pv (list 0)))
(unless (fourth pv) (appendf pv (list 0)))
(incf (car (last pv)))
(unparse-version pv)))
(defun versions-from-args (&optional v1 v2)
(labels ((check (old new)
(parse-version old 'error)
(parse-version new 'error)
(values old new)))
(cond
((and v1 v2) (check v1 v2))
(v1 (check (version-from-file) v1))
((not (eq *new-version* :default)) *new-version*) ;; Ugly passing of argument from Makefile.
(t (let ((old (version-from-file)))
(check old (next-version old)))))))
(deftype byte-vector () '(array (unsigned-byte 8) (*)))
(defun maybe-replace-file (file transformer
&key (reader 'read-file-string)
(writer nil) (comparator 'equalp)
(external-format *utf-8-external-format*))
(format t "Transforming file ~A... " (file-namestring file))
(let* ((old-contents (funcall reader file))
(new-contents (funcall transformer old-contents)))
(if (funcall comparator old-contents new-contents)
(format t "no changes needed!~%")
(let ((written-contents
(if writer
(with-output (s ())
(funcall writer s new-contents))
new-contents)))
(check-type written-contents (or string (byte-vector)))
(clobber-file-with-vector file written-contents :external-format external-format)
(format t "done.~%"))))
(success))
(defun version-transformer (new-version file prefix suffix &optional dont-warn)
(let* ((qprefix (cl-ppcre:quote-meta-chars prefix))
(versionrx "([0-9]+(\\.[0-9]+)+)")
(qsuffix (cl-ppcre:quote-meta-chars suffix))
(regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")"))
(replacement
(constantly (strcat prefix new-version suffix))))
(lambda (text)
(multiple-value-bind (new-text foundp)
(cl-ppcre:regex-replace-all regex text replacement)
(unless (or foundp dont-warn)
(warn "Missing version in ~A" (file-namestring file)))
(values new-text foundp)))))
(defun transform-file (new-version file prefix suffix)
(maybe-replace-file (pn file) (version-transformer new-version file prefix suffix)))
(defun transform-files (new-version)
(loop :for f :in *versioned-files* :do (apply 'transform-file new-version f))
(success))
(defun test-transform-file (new-version file prefix suffix)
(let ((lines (read-file-lines (pn file))))
(dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil))
(multiple-value-bind (new-text foundp)
(funcall (version-transformer new-version file prefix suffix t) l)
(when foundp
(format t "Found a match:~% ==> ~A~%Replacing with~% ==> ~A~%~%"
l new-text)
(return (success)))))))
(defun test-transform (new-version)
(apply 'test-transform-file new-version (first *versioned-files*)))
(defun bump-version (&optional v1 v2)
"bump asdf version, do not commit"
(with-asdf-dir ()
(multiple-value-bind (old-version new-version)
(format t "Bumping ASDF version from ~A to ~A~%" old-version new-version)
(transform-files new-version)
(println "Rebuilding ASDF with bumped version")
(build-asdf)
new-version)))
(defun bump (&optional v1 v2)
"bump asdf version, then commit and tag"
(let ((v (bump-version v1 v2)))
(git `(commit -a -m ("Bump version to ",v)))
(git `(tag ,v))
v))