rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix: Rename and move sans-extension to tarball-sans-extension. 

* guix/gnu-maintenance.scm (sans-extension): Move and rename to ...
* guix/utils.scm (tarball-sans-extension): ... here.
This commit is contained in:
Hartmut Goebel 2019-08-27 18:20:16 +02:00
parent 83aa656217
commit da1027a705
No known key found for this signature in database
GPG Key ID: 634A8DFFD3F631DF
2 changed files with 19 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/gnu-maintenance.scm
View File

@ -230,12 +230,6 @@ network to check in GNU's database."
(or (assoc-ref (package-properties package) 'ftp-directory)
(string-append "/gnu/" name)))))
(define (sans-extension tarball)
"Return TARBALL without its .tar.* or .zip extension."
(let ((end (or (string-contains tarball ".tar")
(string-contains tarball ".zip"))))
(substring tarball 0 end)))
(define %tarball-rx
;; The .zip extensions is notably used for freefont-ttf.
;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz".
@ -261,14 +255,15 @@ true."
(string-append project
"-src")))))))
(not (regexp-exec %alpha-tarball-rx file))
(let ((s (sans-extension file)))
(let ((s (tarball-sans-extension file)))
(regexp-exec %package-name-rx s))))
(define (tarball->version tarball)
"Return the version TARBALL corresponds to. TARBALL is a file name like
\"coreutils-8.23.tar.xz\"."
(let-values (((name version)
(gnu-package-name->name+version (sans-extension tarball))))
(gnu-package-name->name+version
(tarball-sans-extension tarball))))
version))
(define* (releases project
@ -492,8 +487,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(and (string=? url (basename url)) ;relative reference?
(release-file? package url)
(let-values (((name version)
(package-name->name+version (sans-extension url)
#\-)))
(package-name->name+version
(tarball-sans-extension url)
#\-)))
(upstream-source
(package name)
(version version)
@ -565,14 +561,16 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
(release-file? name (basename file))))
files)))
(match (sort relevant (lambda (file1 file2)
(version>? (sans-extension (basename file1))
(sans-extension (basename file2)))))
(version>? (tarball-sans-extension
(basename file1))
(tarball-sans-extension
(basename file2)))))
((and tarballs (reference _ ...))
(let* ((version (tarball->version reference))
(tarballs (filter (lambda (file)
(string=? (sans-extension
(string=? (tarball-sans-extension
(basename file))
(sans-extension
(tarball-sans-extension
(basename reference))))
tarballs)))
(upstream-source

7
guix/utils.scm
View File

@ -91,6 +91,7 @@
arguments-from-environment-variable
file-extension
file-sans-extension
tarball-sans-extension
compressed-file?
switch-symlinks
call-with-temporary-output-file
@ -578,6 +579,12 @@ minor version numbers from version-string."
(substring file 0 dot)
file)))
(define (tarball-sans-extension tarball)
"Return TARBALL without its .tar.* or .zip extension."
(let ((end (or (string-contains tarball ".tar")
(string-contains tarball ".zip"))))
(substring tarball 0 end)))
(define (compressed-file? file)
"Return true if FILE denotes a compressed file."
(->bool (member (file-extension file)