summaryrefslogtreecommitdiff
path: root/guix/import/cpan.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/import/cpan.scm')
-rw-r--r--guix/import/cpan.scm77
1 files changed, 58 insertions, 19 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 5f4602a8d2..37dd3b162c 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,6 +20,8 @@
(define-module (guix import cpan)
#:use-module (ice-9 match)
#: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 (json)
#:use-module (guix hash)
@@ -27,6 +30,9 @@
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (gnu packages perl)
#:export (cpan->guix-package))
;;; Commentary:
@@ -44,7 +50,7 @@
;; apache_1_1
("apache_2_0" 'asl2.0)
;; artistic_1_0
- ;; artistic_2_0
+ ("artistic_2_0" 'artistic2.0)
("bsd" 'bsd-3)
("freebsd" 'bsd-2)
;; gfdl_1_2
@@ -58,7 +64,7 @@
;; mozilla_1_0
("mozilla_1_1" 'mpl1.1)
("openssl" 'openssl)
- ("perl_5" 'gpl1+) ;and Artistic 1
+ ("perl_5" '(package-license perl)) ;GPL1+ and Artistic 1
("qpl_1_0" 'qpl)
;; ssleay
;; sun
@@ -71,6 +77,14 @@
"Transform a 'module' name into a 'release' name"
(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)
"Return an alist representation of the CPAN metadata for the perl module MODULE,
or #f on failure. MODULE should be e.g. \"Test::Script\""
@@ -84,6 +98,15 @@ or #f on failure. MODULE should be e.g. \"Test::Script\""
(define (cpan-home name)
(string-append "http://search.cpan.org/dist/" name))
+(define %corelist
+ (delay
+ (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)
"Return the `package' s-expression for a CPAN module from the metadata in
META."
@@ -98,6 +121,17 @@ META."
(define version
(assoc-ref meta "version"))
+ (define (core-module? name)
+ (and (force %corelist)
+ (parameterize ((current-error-port (%make-void-port "w")))
+ (let* ((corelist (open-pipe* OPEN_READ (force %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)
;; Convert phase dependencies into a list of name/variable pairs.
(match (flatten
@@ -109,19 +143,22 @@ META."
(#f
'())
((inputs ...)
- (delete-duplicates
- ;; Listed dependencies may include core modules. Filter those out.
- (filter-map (match-lambda
- ((or (module . "0") ("perl" . _))
- ;; 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)
- ((module . _)
- (let ((name (guix-name (module->name module))))
- (list name
- (list 'unquote (string->symbol name))))))
- inputs)))))
+ (sort
+ (delete-duplicates
+ ;; Listed dependencies may include core modules. Filter those out.
+ (filter-map (match-lambda
+ (("perl" . _) ;implicit dependency
+ #f)
+ ((module . _)
+ (and (not (core-module? module))
+ (let ((name (guix-name (module->dist-name module))))
+ (list name
+ (list 'unquote (string->symbol name)))))))
+ inputs))
+ (lambda args
+ (match args
+ (((a _ ...) (b _ ...))
+ (string<? a b))))))))
(define (maybe-inputs guix-name inputs)
(match inputs
@@ -132,7 +169,9 @@ META."
(list 'quasiquote inputs))))))
(define source-url
- (assoc-ref meta "download_url"))
+ (regexp-substitute/global #f "http://cpan.metacpan.org"
+ (assoc-ref meta "download_url")
+ 'pre "mirror://cpan" 'post))
(let ((tarball (with-store store
(download-to-store store source-url))))
@@ -147,12 +186,12 @@ META."
,(bytevector->nix-base32-string (file-sha256 tarball))))))
(build-system perl-build-system)
,@(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,
;; which says they are required during building. We
;; have not yet had a need for cross-compiled perl
- ;; modules, however, so we leave them out.
- (convert-inputs '("configure" "build")))
+ ;; modules, however, so we leave it out.
+ (convert-inputs '("configure" "build" "test")))
,@(maybe-inputs 'inputs
(convert-inputs '("runtime")))
(home-page ,(string-append "http://search.cpan.org/dist/" name))