1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
3 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
4 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
6 ;;; This file is part of GNU Guix.
8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
13 ;;; GNU Guix is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 (define-module (test-cpan)
22 #:use-module (guix import cpan)
23 #:use-module (guix base32)
24 #:use-module (gcrypt hash)
25 #:use-module (guix tests http)
26 #:use-module ((guix store) #:select (%graft?))
27 #:use-module (srfi srfi-64)
28 #:use-module (web client)
29 #:use-module (ice-9 match))
31 ;; Globally disable grafts because they can trigger early builds.
37 \"name\" : \"Foo-Bar\",
40 \"name\" : \"Foo-Bar-0.1\",
41 \"distribution\" : \"Foo-Bar\",
46 { \"relationship\": \"requires\",
47 \"phase\": \"runtime\",
48 \"version\": \"1.05\",
49 \"module\": \"Test::Script\"
52 \"abstract\" : \"Fizzle Fuzz\",
53 \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
54 \"author\" : \"Guix\",
61 ;; Avoid collisions with other tests.
62 (%http-server-port 10400)
66 (test-assert "cpan->guix-package"
67 ;; Replace network resources with sample data.
68 (with-http-server `((200 ,test-json)
70 (200 "{ \"distribution\" : \"Test-Script\" }"))
71 (parameterize ((%metacpan-base-url (%local-url))
72 (current-http-proxy (%local-url)))
73 (match (cpan->guix-package "Foo::Bar")
75 ('name "perl-foo-bar")
79 ('uri ('string-append "http://example.com/Foo-Bar-"
84 ('build-system 'perl-build-system)
87 (("perl-test-script" ('unquote 'perl-test-script)))))
88 ('home-page "https://metacpan.org/release/Foo-Bar")
89 ('synopsis "Fizzle Fuzz")
90 ('description 'fill-in-yourself!)
91 ('license 'perl-license))
92 (string=? (bytevector->nix-base32-string
93 (call-with-input-string test-source port-sha256))
98 (test-equal "metacpan-url->mirror-url, http"
99 "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
100 (metacpan-url->mirror-url
101 "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
103 (test-equal "metacpan-url->mirror-url, https"
104 "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
105 (metacpan-url->mirror-url
106 "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))