02/02: import: cpan: Use our mirrors for 'https' URLs.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 5b8e564ccdc734cda20d151adc1d60d7119fff3b
Author: Alex Sassmannshausen <address@hidden>
Date:   Sat Jul 2 20:06:02 2016 +0200

    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 <address@hidden>
---
 guix/import/cpan.scm |   13 +++++++++----
 tests/cpan.scm       |   11 +++++++++++
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index ad61ee7..213a155 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Eric Bavier <address@hidden>
 ;;; Copyright © 2015 Mark H Weaver <address@hidden>
+;;; Copyright © 2016 Alex Sassmannshausen <address@hidden>
 ;;;
 ;;; 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))))
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 5d56f0b..898081b 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Eric Bavier <address@hidden>
+;;; Copyright © 2016 Alex Sassmannshausen <address@hidden>
 ;;;
 ;;; 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")