devops: Use regsexps, more parsed versions.

diff --git a/src/devops/devops.scm b/src/devops/devops.scm
index 9c5c3aa9984e9bbb88bc33bfd1db3a3c2887f3a3..d91b52df52163aa5f3c9c4a557aa4578a302db18 100644 (file)
--- a/src/devops/devops.scm
+++ b/src/devops/devops.scm
@@ -38,7 +38,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (lint (core-lint version (core-changes) dirt)))
     (if (not (null? lint))
        (begin
-         (log "# "(project-name)" "version":\n")
+         (log "# "(project-name)" "(version-string version)":\n")
          (write-lint lint)))))
 
 (define (plugin-status plugin dirt)
@@ -47,7 +47,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (lint (plugin-lint plugin version changes dirt)))
     (if (not (null? lint))
        (begin
-         (log "# "(plugin-name plugin)" "version":\n")
+         (log "# "(plugin-name plugin)" "(version-string version)":\n")
          (write-lint lint)))))
 
 (define (write-lint lint)
@@ -83,15 +83,21 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (plugin-lint-hook plugin version changes dirt)
         '()))))
 
+(define debian-changelog-version-pattern
+  (compile-regsexp '(seq (* (any-char))
+                        #\space #\(
+                        (group version (+ (char-not-in #\))))
+                        #\))))
+
 (define (debian-version dir)
   (let* ((changelog (string dir"/debian/changelog"))
         (line (and (file-exists? changelog)
                    (file-first-line changelog)))
-        (regs (and line
-                   (re-string-match ".* +(\\([^)]+\\))" line))))
-    (if regs
-       (re-match-extract line regs 1)
-       (error "could not find Debian version:" line))))
+        (match (and line
+                    (regsexp-match-string debian-changelog-version-pattern
+                                          line))))
+    (and match
+        (->version (match-extract match 'version)))))
 
 (define (debian-version-lint version dversion)
   (append
@@ -102,15 +108,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (list "Debian version not found.")
        '())
    (if (and version dversion
-           (not (string=? version dversion)))
-       (list (string "Debian version ("dversion") does not match."))
+           (not (version=? version dversion)))
+       (list (string "Debian version ("(version-string dversion)")"
+                    " does not match."))
        '())))
 
-(define (released-version-lint version-string released changed)
+(define (released-version-lint version released changes)
   (cond ((eq? #f released)
         (list "First release!"))
-       ((and (not (null? changed))
-             (not (version>? (->version version-string) released)))
+       ((and (not (null? changes))
+             (not (version>? version released)))
         (list "Version is out-of-date."))
        (else
         '())))
@@ -143,18 +150,23 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (string=? dir (substring line 3 dir-end))
         (char=? #\/ (string-ref line dir-end)))))
 
-(load-option 'regular-expression)
+(define core-version-pattern
+  (compile-regsexp '(seq (* (any-char))
+                        "ubsystem-identification! \"Release\""
+                        " '("
+                        (group version (+ (alt #\space (char-in numeric))))
+                        ")")))
 
 (define (core-version)
   (call-with-input-file "src/runtime/version.scm"
     (lambda (in)
       (let loop ()
        (let* ((line (read-line in))
-              (patt ".*ubsystem-identification! \"Release\" '(\\([0-9 ]+\\))")
-              (regs (and (string? line)
-                         (re-string-match patt line))))
-         (if regs
-             (string-replace (re-match-extract line regs 1) #\space #\.)
+              (match (and (string? line)
+                          (regsexp-match-string core-version-pattern line))))
+         (if match
+             (map (lambda (s) (string->number s 10))
+                  (burst-string (match-extract match 'version) #\space #t))
              (if (eof-object? line)
                  (error "could not find core version")
                  (loop))))))))
@@ -203,6 +215,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (and last-tag
         (car (shell-lines "git log --format=%H -1 "last-tag)))))
 
+(define plugin-version-pattern
+  (compile-regsexp '(seq (* (char-in whitespace))
+                        #\[
+                        (group version (+ (alt #\. (char-in numeric))))
+                        #\])))
+
 (define (plugin-version plugin)
   (call-with-input-file (string (plugin-directory plugin)"/configure.ac")
     (lambda (in)
@@ -211,11 +229,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (if (and (string? line)
                   (string-prefix? "AC_INIT" line))
              (let* ((line (read-line in))
-                    (regs (and (string? line)
-                               (re-string-match "[ \t]*[[]\\([0-9.]+\\)[]]"
-                                                line))))
-               (if regs
-                   (re-match-extract line regs 1)
+                    (match (and (string? line)
+                                (regsexp-match-string plugin-version-pattern
+                                                      line))))
+               (if match
+                   (->version (match-extract match 'version))
                    (error "no plugin version:" (plugin-name plugin))))
              (if (eof-object? line)
                  (error "no AC_INIT:" (plugin-name plugin))
@@ -258,9 +276,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (release-core version changes dirt snap?)
   (if (and (null? changes) (not snap?))
       (error "no unreleased commits"))
-  (let* ((version (core-version))
-        (project (project-name))
-        (pkgvers (string project"-"version))
+  (let* ((project (project-name))
+        (vers (version-string version))
+        (pkgvers (string project"-"vers))
         (logfile (string "devops/"pkgvers"-src.log")))
     (log "# "pkgvers":\n")
     (write-lint (core-lint version changes dirt))
@@ -282,16 +300,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (run "rm -rf devops/"pkgvers)
        (run "cd devops/ && tar xzf "pkgvers".tar.gz")
        (run "cd devops/ && dpkg-source --build "pkgvers)
-       (run "chmod 444 devops/"project"_"version".dsc")
-       (run "chmod 444 devops/"project"_"version".tar.xz")
+       (run "chmod 444 devops/"project"_"vers".dsc")
+       (run "chmod 444 devops/"project"_"vers".tar.xz")
        (run "rm -rf devops/"pkgvers)))
     (delete-file logfile)))
 
 (define (release-plugin plugin version changes dirt snap?)
   (if (and (null? changes) (not snap?))
       (error "no unreleased commits"))
-  (let* ((pkg (plugin-package plugin))
-        (pkgvers (string pkg"-"version))
+  (let* ((vers (version-string version))
+        (pkg (plugin-package plugin))
+        (pkgvers (string pkg"-"vers))
         (logfile (string "devops/"pkgvers"-src.log"))
         (dir (plugin-directory plugin)))
     (log "# "pkgvers":\n")
@@ -316,8 +335,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (run "rm -rf devops/"pkgvers)
        (run "cd devops/ && tar xzf "pkgvers".tar.gz")
        (run "cd devops/ && dpkg-source --build "pkgvers)
-       (run "chmod 444 devops/"pkg"_"version".dsc")
-       (run "chmod 444 devops/"pkg"_"version".tar.xz")
+       (run "chmod 444 devops/"pkg"_"vers".dsc")
+       (run "chmod 444 devops/"pkg"_"vers".tar.xz")
        (run "rm -rf devops/"pkgvers)))
     (delete-file logfile)))
 
@@ -325,17 +344,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (let* ((changes (or (core-changes) '()))
         (version (core-version))
         (released (released-version (project-name)))
-        (new (->version version))
-        (source-filename
-         (string "devops/"(project-name)"-"version".tar.gz")))
+        (vers (version-string version))
+        (source-filename (string "devops/"(project-name)"-"vers".tar.gz")))
     (define (found) (log "# "source-filename":\nAlready done.\n"))
     (cond ((and (null? changes)
-               (version=? new released))
+               (version=? version released))
           (if (file-exists? source-filename)
               (found)
               (release-core version changes dirt #t)))
          ((and (pair? changes)
-               (version>? new released))
+               (version>? version released))
           ;; Clobber!
           (release-core version changes dirt #t))
          ((null? changes)
@@ -349,17 +367,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (let* ((changes (plugin-changes plugin))
         (version (plugin-version plugin))
         (released (released-version (plugin-package plugin)))
-        (new (->version version))
-        (source-filename
-         (string "devops/"(plugin-package plugin)"-"version".tar.gz")))
+        (vers (version-string version))
+        (source-filename (string "devops/"
+                                 (plugin-package plugin)"-"vers".tar.gz")))
     (define (found) (log "# "source-filename":\nAlready done.\n"))
     (cond ((and (null? changes)
-               (version=? new released))
+               (version=? version released))
           (if (file-exists? source-filename)
               (found)
               (release-plugin plugin version changes dirt #t)))
          ((and (pair? changes)
-               (version>? new released))
+               (version>? version released))
           ;; Clobber!
           (release-plugin plugin version changes dirt #t))
          ((null? changes)