mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
185 lines
6.9 KiB
Common Lisp
Executable file
185 lines
6.9 KiB
Common Lisp
Executable file
#!/bin/sh
|
|
#|-*- mode:lisp -*-|#
|
|
#|
|
|
exec ros -Q -L sbcl-bin -- $0 "$@"
|
|
|#
|
|
(progn
|
|
(ros:ensure-asdf)
|
|
(ql:quickload '(:cl-ppcre :split-sequence "snmsts/sn.github")))
|
|
|
|
(defpackage :ros.script.release.3703769340
|
|
(:use :cl :sn.github.repos.releases))
|
|
(in-package :ros.script.release.3703769340)
|
|
|
|
(defvar *project-path* (truename (merge-pathnames "../" (make-pathname :name nil :type nil :defaults *load-pathname*))))
|
|
(defvar *new-version* nil)
|
|
(defvar *owner* "roswell")
|
|
(defvar *repo* "roswell")
|
|
|
|
(defun find-version ()
|
|
(with-open-file (in (merge-pathnames "configure.ac" *project-path*))
|
|
(loop for line = (read-line in nil nil)
|
|
while line
|
|
for match = (nth-value 1 (cl-ppcre:scan-to-strings "^AC_INIT\\([^,]*,\\[([^,]*)\\]" line))
|
|
when match
|
|
do (return-from find-version (aref match 0)))))
|
|
|
|
(defun inc-version (v)
|
|
(let ((version (mapcar #'parse-integer (split-sequence:split-sequence #\. v)))
|
|
(d (multiple-value-list(decode-universal-time (get-universal-time)))))
|
|
(setf (first version) (- (nth 5 d) 2000)
|
|
(second version) (nth 4 d)
|
|
(fourth version) (1+ (fourth version)))
|
|
(format nil "~{~A~^.~}" version)))
|
|
|
|
(defun edit-file (path match replace version &key test)
|
|
(let ((file (with-open-file (in path :direction :input)
|
|
(loop for line = (read-line in nil nil)
|
|
while line
|
|
for match- = (nth-value 1 (cl-ppcre:scan-to-strings match line))
|
|
collect (if match-
|
|
(cl-ppcre:regex-replace replace line
|
|
(format nil "\\{1}~A\\{3}" version))
|
|
line)))))
|
|
(if test
|
|
file
|
|
(with-open-file (out path :direction :output :if-exists :supersede)
|
|
(dolist (line file)
|
|
(format out "~A~%" line))))))
|
|
|
|
(defun edit-configure-ac (&optional (version *new-version*) test)
|
|
(edit-file (merge-pathnames "configure.ac" *project-path*)
|
|
"^AC_INIT\\([^,]*,\\[([^,]*)\\]"
|
|
"^(AC_INIT\\([^,]*,\\[)([^,]*)(\\].*)$"
|
|
version :test test))
|
|
|
|
(defun edit-roswell-asd (&optional (version *new-version*) test)
|
|
(edit-file (merge-pathnames "roswell.asd" *project-path*)
|
|
"^[ ]*:version[ ]*\"[^,]*\"[ ]*$"
|
|
"^([ ]*:version[ ]*\")([^\"]*)(\".*)$"
|
|
version :test test))
|
|
|
|
(defun x (cmd)
|
|
(string-right-trim
|
|
(format nil "~A" #\newline)
|
|
(with-output-to-string (o)
|
|
(uiop/run-program:run-program cmd :output o))))
|
|
|
|
(defun edit-changelog ()
|
|
(error "not implement yet"))
|
|
|
|
(defun prepare-changelog ()
|
|
(declare (ignore argv))
|
|
(uiop:run-program "git checkout master" :output :interactive :error-output :interactive)
|
|
(let ((*new-version* "master-changelog-which-not-yet-released")
|
|
(newpart (merge-pathnames "ChangeLog--" *project-path*))
|
|
(newfile (merge-pathnames "ChangeLog---" *project-path*))
|
|
(file (merge-pathnames "ChangeLog" *project-path*)))
|
|
(with-open-file (out newpart :direction :output :if-exists :supersede)
|
|
(format out "~{~A~%~}"
|
|
(list (format nil "roswell (~A-1) unstable; urgency=low" *new-version*)
|
|
"" " *" ""
|
|
(format nil " -- ~A <~A> ~A"
|
|
(x "git config --get user.name")
|
|
(x "git config --get user.email")
|
|
(local-time:format-rfc1123-timestring
|
|
nil
|
|
(local-time:universal-to-timestamp (get-universal-time)))) "")))
|
|
(with-open-file (out newfile :direction :output :if-exists :supersede)
|
|
(uiop/run-program:run-program
|
|
(format nil "cat ~A ~A" newpart file)
|
|
:output out))
|
|
(uiop/run-program:run-program
|
|
(format nil "mv ~A ~A" newfile file))
|
|
(uiop/run-program:run-program
|
|
(format nil "rm -f ~A ~A" newpart newfile))))
|
|
|
|
(defun show-how-to-release ()
|
|
(format t "~{~A~%~}~%"
|
|
`("To release"
|
|
"1. Review changes and complete ChangeLog"
|
|
"2. Type"
|
|
"make release")))
|
|
|
|
(defun prepare (argv)
|
|
(declare (ignore argv))
|
|
(uiop/run-program:run-program "git checkout master" :output t)
|
|
(format t "~¤t version is ~s.How about new one's:~%" (find-version))
|
|
(force-output)
|
|
(setq *new-version* (read-line))
|
|
(when (zerop (length *new-version*))
|
|
(setf *new-version* (inc-version (find-version))))
|
|
(format t "~&new version name is ~S~%" *new-version*)
|
|
(force-output)
|
|
(edit-changelog)
|
|
(edit-configure-ac)
|
|
(edit-roswell-asd)
|
|
(show-how-to-release))
|
|
|
|
(defun release (argv)
|
|
(declare (ignore argv))
|
|
(let ((version (find-version)))
|
|
(mapc
|
|
#'uiop:run-program
|
|
`("git add ChangeLog configure.ac roswell.asd"
|
|
,(format nil "git commit -m \"bump version to ~A\"" version)))))
|
|
|
|
(defun release-2 (argv)
|
|
(declare (ignore argv))
|
|
(let ((version (find-version)))
|
|
(mapc
|
|
(lambda (x) (uiop:run-program x :output :interactive :error-output :interactive))
|
|
`("git checkout release"
|
|
"git merge master"
|
|
,(format nil "git tag -a \"v~A\" -m \"v~A\"" version version)
|
|
"git push"
|
|
"git push --tags"))
|
|
(prepare-changelog)
|
|
(mapc
|
|
(lambda (x) (uiop:run-program x :output :interactive :error-output :interactive))
|
|
`("git add ChangeLog"
|
|
,(format nil "git commit -m\"[ci skip] prepare ChangeLog entry next to v~A\"" version)
|
|
"git push"))))
|
|
|
|
(defun release-exist-p (tagname &key (owner *owner*) (repo *repo*))
|
|
(ignore-errors
|
|
(find tagname
|
|
(releases-list owner repo)
|
|
:key (lambda (x) (getf x :|tag_name|))
|
|
:test 'equal)))
|
|
|
|
(defun ensure-release-exists (tagname &key (owner *owner*) (repo *repo*))
|
|
(let ((found (release-exist-p tagname :owner owner :repo repo)))
|
|
(if found
|
|
found
|
|
(releases-create owner repo tagname))))
|
|
|
|
(defun asset-upload (path tagname &key (owner *owner*) (repo *repo*))
|
|
(releases-asset-upload
|
|
owner repo
|
|
(getf (release-exist-p tagname :owner owner :repo repo) :|id|) path))
|
|
|
|
(defun github (argv)
|
|
(unless (uiop:getenv "GITHUB_OAUTH_TOKEN")
|
|
(error "GITHUB_OAUTH_TOKEN must be set"))
|
|
(ensure-release-exists (uiop:getenv "TRAVIS_TAG"))
|
|
(asset-upload (pathname (first argv)) (uiop:getenv "TRAVIS_TAG")))
|
|
|
|
(defun debian (argv)
|
|
(declare (ignore argv))
|
|
(unless (uiop:getenv "GITHUB_OAUTH_TOKEN")
|
|
(error "GITHUB_OAUTH_TOKEN must be set"))
|
|
(ensure-release-exists (uiop:getenv "TRAVIS_TAG"))
|
|
(loop for i in (directory (make-pathname
|
|
:type :wild :name :wild
|
|
:defaults (merge-pathnames "scripts/debian/" *project-path*)))
|
|
when (pathname-name i)
|
|
do (asset-upload (pathname i) (uiop:getenv "TRAVIS_TAG"))))
|
|
|
|
(defun main (subcmd &rest argv)
|
|
(declare (ignorable argv))
|
|
(let ((subcmd (find subcmd '(release prepare github debian release-2)
|
|
:test 'equal :key 'string-downcase)))
|
|
(when subcmd
|
|
(funcall subcmd argv))))
|