import: cpan: Use corelist to filter dependencies.

* guix/import/cpan.scm (%corelist): New variable.
  (module->dist-name, core-module?): New procedures.
  (cpan-module->sexp)[convert-inputs]: Use them.  Include "test" dependencies
  in converted inputs.
* doc/guix.texi (Invoking guix import)[cpan]: Mention corelist filtering.
This commit is contained in:
Eric Bavier 2015-02-12 08:39:09 -06:00
parent f8e366230d
commit 66392e475d
2 changed files with 44 additions and 13 deletions

View File

@ -3089,9 +3089,10 @@ guix import pypi itsdangerous
Import meta-data from @uref{https://www.metacpan.org/, MetaCPAN}. Import meta-data from @uref{https://www.metacpan.org/, MetaCPAN}.
Information is taken from the JSON-formatted meta-data provided through Information is taken from the JSON-formatted meta-data provided through
@uref{https://api.metacpan.org/, MetaCPAN's API} and includes most @uref{https://api.metacpan.org/, MetaCPAN's API} and includes most
relevant information. License information should be checked closely. relevant information, such as module dependencies. License information
Package dependencies are included but may in some cases needlessly should be checked closely. If Perl is available in the store, then the
include core Perl modules. @code{corelist} utility will be used to filter core modules out of the
list of dependencies.
The command command below imports meta-data for the @code{Acme::Boolean} The command command below imports meta-data for the @code{Acme::Boolean}
Perl module: Perl module:

View File

@ -19,6 +19,8 @@
(define-module (guix import cpan) (define-module (guix import cpan)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module ((ice-9 popen) #:select (open-pipe* close-pipe))
#:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (json) #:use-module (json)
#:use-module (guix hash) #:use-module (guix hash)
@ -27,6 +29,9 @@
#:use-module ((guix download) #:select (download-to-store)) #:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix import json) #:use-module (guix import json)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages perl)
#:export (cpan->guix-package)) #:export (cpan->guix-package))
;;; Commentary: ;;; Commentary:
@ -71,6 +76,14 @@
"Transform a 'module' name into a 'release' name" "Transform a 'module' name into a 'release' name"
(regexp-substitute/global #f "::" module 'pre "-" 'post)) (regexp-substitute/global #f "::" module 'pre "-" 'post))
(define (module->dist-name module)
"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
return \"Test-Simple\""
(assoc-ref (json-fetch (string-append "http://api.metacpan.org/module/"
module))
"distribution"))
(define (cpan-fetch module) (define (cpan-fetch module)
"Return an alist representation of the CPAN metadata for the perl module MODULE, "Return an alist representation of the CPAN metadata for the perl module MODULE,
or #f on failure. MODULE should be e.g. \"Test::Script\"" or #f on failure. MODULE should be e.g. \"Test::Script\""
@ -84,6 +97,14 @@ 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 %corelist
(let* ((perl (with-store store
(derivation->output-path
(package-derivation store perl))))
(core (string-append perl "/bin/corelist")))
(and (access? core X_OK)
core)))
(define (cpan-module->sexp meta) (define (cpan-module->sexp meta)
"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."
@ -98,6 +119,17 @@ META."
(define version (define version
(assoc-ref meta "version")) (assoc-ref meta "version"))
(define (core-module? name)
(and %corelist
(parameterize ((current-error-port (%make-void-port "w")))
(let* ((corelist (open-pipe* OPEN_READ %corelist name)))
(let loop ((line (read-line corelist)))
(if (eof-object? line)
(begin (close-pipe corelist) #f)
(if (string-contains line "first released with perl")
(begin (close-pipe corelist) #t)
(loop (read-line corelist)))))))))
(define (convert-inputs phases) (define (convert-inputs phases)
;; Convert phase dependencies into a list of name/variable pairs. ;; Convert phase dependencies into a list of name/variable pairs.
(match (flatten (match (flatten
@ -112,15 +144,13 @@ META."
(delete-duplicates (delete-duplicates
;; Listed dependencies may include core modules. Filter those out. ;; Listed dependencies may include core modules. Filter those out.
(filter-map (match-lambda (filter-map (match-lambda
((or (module . "0") ("perl" . _)) (("perl" . _) ;implicit dependency
;; TODO: A stronger test might to run MODULE through
;; `corelist' from our perl package. This current test
;; seems to be only a loose convention.
#f) #f)
((module . _) ((module . _)
(let ((name (guix-name (module->name module)))) (and (not (core-module? module))
(list name (let ((name (guix-name (module->dist-name module))))
(list 'unquote (string->symbol name)))))) (list name
(list 'unquote (string->symbol name)))))))
inputs))))) inputs)))))
(define (maybe-inputs guix-name inputs) (define (maybe-inputs guix-name inputs)
@ -147,12 +177,12 @@ META."
,(bytevector->nix-base32-string (file-sha256 tarball)))))) ,(bytevector->nix-base32-string (file-sha256 tarball))))))
(build-system perl-build-system) (build-system perl-build-system)
,@(maybe-inputs 'native-inputs ,@(maybe-inputs 'native-inputs
;; "runtime" and "test" may also be needed here. See ;; "runtime" may also be needed here. See
;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases, ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases,
;; which says they are required during building. We ;; which says they are required during building. We
;; have not yet had a need for cross-compiled perl ;; have not yet had a need for cross-compiled perl
;; modules, however, so we leave them out. ;; modules, however, so we leave it out.
(convert-inputs '("configure" "build"))) (convert-inputs '("configure" "build" "test")))
,@(maybe-inputs 'inputs ,@(maybe-inputs 'inputs
(convert-inputs '("runtime"))) (convert-inputs '("runtime")))
(home-page ,(string-append "http://search.cpan.org/dist/" name)) (home-page ,(string-append "http://search.cpan.org/dist/" name))