Revert "import: cpan: Adapt for the change to guile-json version 3."

This reverts commit 01ce7af25a.
master
Mark H Weaver 2019-08-22 14:24:11 -04:00
parent 47c95c94b4
commit d020821c0b
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
2 changed files with 19 additions and 24 deletions

View File

@ -34,7 +34,7 @@
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix download) #:select (download-to-store url-fetch)) #:use-module ((guix download) #:select (download-to-store url-fetch))
#:use-module ((guix import utils) #:select (factorize-uri #:use-module ((guix import utils) #:select (factorize-uri
flatten hash-ref*)) flatten assoc-ref*))
#:use-module (guix import json) #:use-module (guix import json)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
@ -76,8 +76,8 @@
;; ssleay ;; ssleay
;; sun ;; sun
("zlib" 'zlib) ("zlib" 'zlib)
((x) (string->license x)) (#(x) (string->license x))
((lst ...) `(list ,@(map string->license lst))) (#(lst ...) `(list ,@(map string->license lst)))
(_ #f))) (_ #f)))
(define (module->name module) (define (module->name module)
@ -88,11 +88,11 @@
"Return the base distribution module for a given module. E.g. the 'ok' "Return the base distribution module for a given module. E.g. the 'ok'
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
return \"Test-Simple\"" return \"Test-Simple\""
(hash-ref (json-fetch (string-append (assoc-ref (json-fetch (string-append
"https://fastapi.metacpan.org/v1/module/" "https://fastapi.metacpan.org/v1/module/"
module module
"?fields=distribution")) "?fields=distribution"))
"distribution")) "distribution"))
(define (package->upstream-name package) (define (package->upstream-name package)
"Return the CPAN name of PACKAGE." "Return the CPAN name of PACKAGE."
@ -122,12 +122,12 @@ or #f on failure. MODULE should be e.g. \"Test::Script\""
(define (cpan-source-url meta) (define (cpan-source-url meta)
"Return the download URL for a module's source tarball." "Return the download URL for a module's source tarball."
(regexp-substitute/global #f "http[s]?://cpan.metacpan.org" (regexp-substitute/global #f "http[s]?://cpan.metacpan.org"
(hash-ref meta "download_url") (assoc-ref meta "download_url")
'pre "mirror://cpan" 'post)) 'pre "mirror://cpan" 'post))
(define (cpan-version meta) (define (cpan-version meta)
"Return the version number from META." "Return the version number from META."
(match (hash-ref meta "version") (match (assoc-ref meta "version")
((? number? version) ((? number? version)
;; version is sometimes not quoted in the module json, so it gets ;; version is sometimes not quoted in the module json, so it gets
;; imported into Guile as a number, so convert it to a string. ;; imported into Guile as a number, so convert it to a string.
@ -183,7 +183,7 @@ depend on (gnu packages perl)."
"Return the `package' s-expression for a CPAN module from the metadata in "Return the `package' s-expression for a CPAN module from the metadata in
META." META."
(define name (define name
(hash-ref meta "distribution")) (assoc-ref meta "distribution"))
(define (guix-name name) (define (guix-name name)
(if (string-prefix? "perl-" name) (if (string-prefix? "perl-" name)
@ -198,9 +198,7 @@ META."
(match (flatten (match (flatten
(map (lambda (ph) (map (lambda (ph)
(filter-map (lambda (t) (filter-map (lambda (t)
(and=> (hash-ref* meta "metadata" "prereqs" ph t) (assoc-ref* meta "metadata" "prereqs" ph t))
(lambda (h)
(hash-map->list cons h))))
'("requires" "recommends" "suggests"))) '("requires" "recommends" "suggests")))
phases)) phases))
(#f (#f
@ -253,9 +251,9 @@ META."
,@(maybe-inputs 'propagated-inputs ,@(maybe-inputs 'propagated-inputs
(convert-inputs '("runtime"))) (convert-inputs '("runtime")))
(home-page ,(cpan-home name)) (home-page ,(cpan-home name))
(synopsis ,(hash-ref meta "abstract")) (synopsis ,(assoc-ref meta "abstract"))
(description fill-in-yourself!) (description fill-in-yourself!)
(license ,(string->license (hash-ref meta "license")))))) (license ,(string->license (assoc-ref meta "license"))))))
(define (cpan->guix-package module-name) (define (cpan->guix-package module-name)
"Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the

View File

@ -24,8 +24,7 @@
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match) #:use-module (ice-9 match))
#:use-module (ice-9 hash-table))
;; Globally disable grafts because they can trigger early builds. ;; Globally disable grafts because they can trigger early builds.
(%graft? #f) (%graft? #f)
@ -110,16 +109,14 @@
(test-equal "source-url-http" (test-equal "source-url-http"
((@@ (guix import cpan) cpan-source-url) ((@@ (guix import cpan) cpan-source-url)
(alist->hash-table `(("download_url" .
`(("download_url" . "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
"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") "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
(test-equal "source-url-https" (test-equal "source-url-https"
((@@ (guix import cpan) cpan-source-url) ((@@ (guix import cpan) cpan-source-url)
(alist->hash-table `(("download_url" .
`(("download_url" . "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
"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") "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
(test-end "cpan") (test-end "cpan")