version.lisp 5.76 KB
Newer Older
1
2
3
4
5
6
7
(in-package :asdf-tools)

;;; Extracting version information

(defparameter *version-tag-glob* "[0-9][.][0-9]*")

(defun version-from-tag (&optional commit)
8
9
  ;; run-program issue: :output :line closes the fd, which causes the program to die in error.
  (first (nth-value 1 (git `(describe --tags --match ,*version-tag-glob* ,commit) :output :lines))))
10
11
12

(defun version-from-file (&optional commit)
  (if commit
13
      (nth-value 1 (git `(show (,commit":version.lisp-expr")) :output :form))
14
15
16
      (safe-read-file-form (pn "version.lisp-expr"))))

(defun debian-version-from-file (&optional commit)
17
  (match (if commit
18
19
             ;; run-program issue: :output :line closes the fd, which causes the program to die in error.
             (first (nth-value 1 (git `(show (,commit":debian/changelog")) :output :lines)))
20
21
             (read-file-line (pn "debian/changelog")))
    ((ppcre "^[^(]*\\(([-0-9.:-]+)\\)" ver) ver)))
22

23
24
25
26
27
28
29
30
(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)))

31
32
33
34
35
36
37
38
(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)))

39
40
41
42
43
44
(defparameter *version* (version-from-file))

;;; Bumping the version of ASDF

(defparameter *versioned-files*
  '(("version.lisp-expr" "\"" "\"")
45
    ("uiop/version.lisp-expr" "\"" "\"")
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    ("asdf.asd" "  :version \"" "\" ;; to be automatically updated by make bump-version")
    ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
    ("upgrade.lisp" "   (asdf-version \"" "\")")))

(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))
70
      ((not (eq *new-version* :default)) *new-version*) ;; Ugly passing of argument from Makefile.
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
      (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)
92
93
          (format t "done.~%"))))
  (success))
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

(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 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)
113
114
  (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f))
  (success))
115
116
117
118
119
120
121
122
123

(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)
124
          (return (success)))))))
125
126
127
128

(defun test-transform (new-version)
  (apply 'test-transform-file new-version (first *versioned-files*)))

129
(defun bump-version (&optional v1 v2)
130
  "bump asdf version, do not commit"
131
132
  (with-asdf-dir ()
    (multiple-value-bind (old-version new-version)
133
        (versions-from-args v1 v2)
134
135
136
137
138
139
      (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)))

140
(defun bump (&optional v1 v2)
141
  "bump asdf version, then commit and tag"
142
  (let ((v (bump-version v1 v2)))
143
144
145
    (git `(commit -a -m ("Bump version to ",v)))
    (git `(tag ,v))
    v))