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

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:
Alex Sassmannshausen 2016-07-02 20:06:02 +02:00 committed by Ludovic Courtès
parent 679b535b03
commit 5b8e564ccd
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/import/cpan.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;;
;;; 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)
(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
(delay
(let* ((perl (with-store store
@ -183,10 +191,7 @@ META."
(list (list guix-name
(list 'quasiquote inputs))))))
(define source-url
(regexp-substitute/global #f "http://cpan.metacpan.org"
(assoc-ref meta "download_url")
'pre "mirror://cpan" 'post))
(define source-url (fix-source-url (assoc-ref meta "download_url")))
(let ((tarball (with-store store
(download-to-store store source-url))))

11
tests/cpan.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;;
;;; This file is part of GNU Guix.
;;;
@ -97,4 +98,14 @@
(x
(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")