import: cpan: Use our mirrors for 'https' URLs.
* guix/import/cpan.scm (fix-source-url): New procedure. (cpan-module->sexp): Use it to construct our source-url. * tests/cpan.scm: Add tests for fix-source-url. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
679b535b03
commit
5b8e564ccd
|
@ -1,6 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||||
|
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -99,6 +100,13 @@ or #f on failure. MODULE should be e.g. \"Test::Script\""
|
||||||
(define (cpan-home name)
|
(define (cpan-home name)
|
||||||
(string-append "http://search.cpan.org/dist/" name))
|
(string-append "http://search.cpan.org/dist/" name))
|
||||||
|
|
||||||
|
(define (fix-source-url download-url)
|
||||||
|
"Return a new download URL based on DOWNLOAD-URL which now uses our mirrors,
|
||||||
|
if the original's domain was metacpan."
|
||||||
|
(regexp-substitute/global #f "http[s]?://cpan.metacpan.org" download-url
|
||||||
|
'pre "mirror://cpan" 'post))
|
||||||
|
|
||||||
|
|
||||||
(define %corelist
|
(define %corelist
|
||||||
(delay
|
(delay
|
||||||
(let* ((perl (with-store store
|
(let* ((perl (with-store store
|
||||||
|
@ -183,10 +191,7 @@ META."
|
||||||
(list (list guix-name
|
(list (list guix-name
|
||||||
(list 'quasiquote inputs))))))
|
(list 'quasiquote inputs))))))
|
||||||
|
|
||||||
(define source-url
|
(define source-url (fix-source-url (assoc-ref meta "download_url")))
|
||||||
(regexp-substitute/global #f "http://cpan.metacpan.org"
|
|
||||||
(assoc-ref meta "download_url")
|
|
||||||
'pre "mirror://cpan" 'post))
|
|
||||||
|
|
||||||
(let ((tarball (with-store store
|
(let ((tarball (with-store store
|
||||||
(download-to-store store source-url))))
|
(download-to-store store source-url))))
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
|
||||||
|
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -97,4 +98,14 @@
|
||||||
(x
|
(x
|
||||||
(pk 'fail x #f)))))
|
(pk 'fail x #f)))))
|
||||||
|
|
||||||
|
(test-equal "source-url-http"
|
||||||
|
((@@ (guix import cpan) fix-source-url)
|
||||||
|
"http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
|
||||||
|
(test-equal "source-url-https"
|
||||||
|
((@@ (guix import cpan) fix-source-url)
|
||||||
|
"https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
|
||||||
|
|
||||||
(test-end "cpan")
|
(test-end "cpan")
|
||||||
|
|
Loading…
Reference in New Issue