diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-04-24 23:37:14 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-04-25 00:13:56 +0200 |
commit | d55a99fed30b2ee47725f07bf26208fb4b13a110 (patch) | |
tree | 9f1ef11ce95a347e76ea0b39719b40039332b856 | |
parent | cac137aa8490e15052c31e7d9b4d1b68c25cd212 (diff) | |
download | guix-d55a99fed30b2ee47725f07bf26208fb4b13a110.tar.gz |
gnu-maintenance: Optimize `release-file'.
* guix/gnu-maintenance.scm (tarball-regexp): Remove. (%tarball-rx): New variable. (release-file): Adjust to use %TARBALL-RX.
-rw-r--r-- | guix/gnu-maintenance.scm | 21 |
1 files changed, 10 insertions, 11 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 49b10565db..30c45ec0c6 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -252,26 +252,25 @@ stored." (_ (values "ftp.gnu.org" (string-append "/gnu/" project))))) -(define tarball-regexp - (memoize - (lambda (project) - "Return a regexp matching tarball names for PROJECT." - (make-regexp (string-append "^" project - "-([0-9]|[^-])*(-src)?\\.tar\\."))))) - -(define %alpha-tarball-rx - (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) - (define (sans-extension tarball) "Return TARBALL without its .tar.* extension." (let ((end (string-contains tarball ".tar"))) (substring tarball 0 end))) +(define %tarball-rx + (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\.")) + +(define %alpha-tarball-rx + (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) + (define (release-file project file) "Return #f if FILE is not a release tarball of PROJECT, otherwise return PACKAGE-VERSION." (and (not (string-suffix? ".sig" file)) - (regexp-exec (tarball-regexp project) file) + (and=> (regexp-exec %tarball-rx file) + (lambda (match) + ;; Filter out unrelated files, like `guile-www-1.1.1'. + (equal? project (match:substring match 1)))) (not (regexp-exec %alpha-tarball-rx file)) (let ((s (sans-extension file))) (and (regexp-exec %package-name-rx s) s)))) |