summaryrefslogtreecommitdiff
path: root/guix/gnu-maintenance.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-24 23:37:14 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-25 00:13:56 +0200
commitd55a99fed30b2ee47725f07bf26208fb4b13a110 (patch)
tree9f1ef11ce95a347e76ea0b39719b40039332b856 /guix/gnu-maintenance.scm
parentcac137aa8490e15052c31e7d9b4d1b68c25cd212 (diff)
downloadguix-patches-d55a99fed30b2ee47725f07bf26208fb4b13a110.tar
guix-patches-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.
Diffstat (limited to 'guix/gnu-maintenance.scm')
-rw-r--r--guix/gnu-maintenance.scm21
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))))