ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu-maintenance: Optimize `release-file'.

Browse source 
* guix/gnu-maintenance.scm (tarball-regexp): Remove.
  (%tarball-rx): New variable.
  (release-file): Adjust to use %TARBALL-RX.
This commit is contained in:
Ludovic Courtès 2013-04-24 23:37:14 +02:00
parent cac137aa84
commit d55a99fed3
1 changed files with 10 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
guix/gnu-maintenance.scm
View file

@ -252,26 +252,25 @@ (define quirks
(_
(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))))