summaryrefslogtreecommitdiff
path: root/guix/upstream.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-27 14:56:23 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-27 14:59:42 +0100
commit42314ffa072f31cc1cb44df38b1f8fcca19d9d3c (patch)
tree528aba2eec665b8df8288420e5902681f5cc8f21 /guix/upstream.scm
parent1ee3d2dcb8892b2ed1a0212fdd6ac2c47f2c8da2 (diff)
refresh: Update the source code URL.
Reported by Tobias Geerinckx-Rice <me@tobias.gr> in <https://bugs.gnu.org/35010>. * guix/upstream.scm (update-package-source): Take 'source' instead of 'version' as the second argument. [update-expression]: Change to take 'replacements', a list of replacement pairs. Compute OLD-URL and NEW-URL and replace the dirname of the OLD-URL with that of NEW-URL. * guix/scripts/refresh.scm (update-package): Adjust call to 'update-package-source' accordingly.
Diffstat (limited to 'guix/upstream.scm')
-rw-r--r--guix/upstream.scm62
1 files changed, 42 insertions, 20 deletions
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 2c70b3422d..1326b3db95 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -39,6 +39,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:export (upstream-source
@@ -404,36 +405,57 @@ this method: ~s")
(#f
(values #f #f #f))))
-(define (update-package-source package version hash)
- "Modify the source file that defines PACKAGE to refer to VERSION,
-whose tarball has SHA256 HASH (a bytevector). Return the new version string
-if an update was made, and #f otherwise."
- (define (update-expression expr old-version version old-hash hash)
- ;; Update package expression EXPR, replacing occurrences OLD-VERSION by
- ;; VERSION and occurrences of OLD-HASH by HASH (base32 representation
- ;; thereof).
- (let ((old-hash (bytevector->nix-base32-string old-hash))
- (hash (bytevector->nix-base32-string hash)))
- (string-replace-substring
- (string-replace-substring expr old-hash hash)
- old-version version)))
+(define* (update-package-source package source hash)
+ "Modify the source file that defines PACKAGE to refer to SOURCE, an
+<upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the
+new version string if an update was made, and #f otherwise."
+ (define (update-expression expr replacements)
+ ;; Apply REPLACEMENTS to package expression EXPR, a string. REPLACEMENTS
+ ;; must be a list of replacement pairs, either bytevectors or strings.
+ (fold (lambda (replacement str)
+ (match replacement
+ (((? bytevector? old-bv) . (? bytevector? new-bv))
+ (string-replace-substring
+ str
+ (bytevector->nix-base32-string old-bv)
+ (bytevector->nix-base32-string new-bv)))
+ ((old . new)
+ (string-replace-substring str old new))))
+ expr
+ replacements))
(let ((name (package-name package))
+ (version (upstream-source-version source))
(version-loc (package-field-location package 'version)))
(if version-loc
(let* ((loc (package-location package))
(old-version (package-version package))
(old-hash (origin-sha256 (package-source package)))
+ (old-url (match (origin-uri (package-source package))
+ ((? string? url) url)
+ (_ #f)))
+ (new-url (match (upstream-source-urls source)
+ ((first _ ...) first)))
(file (and=> (location-file loc)
(cut search-path %load-path <>))))
(if file
- (and (edit-expression
- ;; Be sure to use absolute filename.
- (assq-set! (location->source-properties loc)
- 'filename file)
- (cut update-expression <>
- old-version version old-hash hash))
- version)
+ ;; Be sure to use absolute filename. Replace the URL directory
+ ;; when OLD-URL is available; this is useful notably for
+ ;; mirror://cpan/ URLs where the directory may change as a
+ ;; function of the person who uploads the package. Note that
+ ;; package definitions usually concatenate fragments of the URL,
+ ;; which is why we only attempt to replace a subset of the URL.
+ (let ((properties (assq-set! (location->source-properties loc)
+ 'filename file))
+ (replacements `((,old-version . ,version)
+ (,old-hash . ,hash)
+ ,@(if (and old-url new-url)
+ `((,(dirname old-url) .
+ ,(dirname new-url)))
+ '()))))
+ (and (edit-expression properties
+ (cut update-expression <> replacements))
+ version))
(begin
(warning (G_ "~a: could not locate source file")
(location-file loc))