nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: Add CPAN importer. 

* guix/import/cpan.scm, guix/scripts/import/cpan.scm, tests/cpan.scm:
  New files.
* Makefile.am (MODULE)[HAVE_GUILE_JSON]: Add them.
* guix/scripts/import.scm (importers): Add cpan.
* doc/guix.texi (Requirements): Mention `guix import cpan` as a user
  of guile-json.
  (Invoking guix import): Document new `guix import cpan` command.
This commit is contained in:
Eric Bavier 2015-01-08 14:51:13 -06:00
parent 694b317c2d
commit d45dc6da5c
6 changed files with 392 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile.am
View File

@ -176,9 +176,13 @@ if HAVE_GUILE_JSON
MODULES += \
guix/import/json.scm \
guix/import/pypi.scm \
guix/scripts/import/pypi.scm
guix/scripts/import/pypi.scm \
guix/import/cpan.scm \
guix/scripts/import/cpan.scm
SCM_TESTS += tests/pypi.scm
SCM_TESTS += \
tests/pypi.scm \
tests/cpan.scm
endif

24
doc/guix.texi
View File

@ -258,10 +258,10 @@ interest primarily for developers and not for casual users.
@item
Installing @uref{http://gnutls.org/, GnuTLS-Guile} will
allow you to access @code{https} URLs with the @command{guix download}
command (@pxref{Invoking guix download}) and the @command{guix import
pypi} command. This is primarily of interest to developers.
@xref{Guile Preparations, how to install the GnuTLS bindings for Guile,,
gnutls-guile, GnuTLS-Guile}.
command (@pxref{Invoking guix download}), the @command{guix import pypi}
command, and the @command{guix import cpan} command. This is primarily
of interest to developers. @xref{Guile Preparations, how to install the
GnuTLS bindings for Guile,, gnutls-guile, GnuTLS-Guile}.
@end itemize
Unless @code{--disable-daemon} was passed to @command{configure}, the
@ -2957,6 +2957,22 @@ package:
guix import pypi itsdangerous
@end example
@item cpan
@cindex CPAN
Import meta-data from @uref{https://www.metacpan.org/, MetaCPAN}.
Information is taken from the JSON-formatted meta-data provided through
@uref{https://api.metacpan.org/, MetaCPAN's API} and includes most
relevant information. License information should be checked closely.
Package dependencies are included but may in some cases needlessly
include core Perl modules.
The command command below imports meta-data for the @code{Acme::Boolean}
Perl module:
@example
guix import cpan Acme::Boolean
@end example
@item nix
Import meta-data from a local copy of the source of the
@uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This

167
guix/import/cpan.scm Normal file
View File

@ -0,0 +1,167 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import cpan)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (json)
#:use-module (guix hash)
#:use-module (guix store)
#:use-module (guix base32)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module (guix import json)
#:export (cpan->guix-package))
;;; Commentary:
;;;
;;; Generate a package declaration template for the latest version of a CPAN
;;; module, using meta-data from metacpan.org.
;;;
;;; Code:
(define string->license
(match-lambda
;; List of valid values from https://metacpan.org/pod/CPAN::Meta::Spec.
;; Some licenses are excluded based on their absense from (guix licenses).
("agpl_3" 'agpl3)
;; apache_1_1
("apache_2_0" 'asl2.0)
;; artistic_1_0
;; artistic_2_0
("bsd" 'bsd-3)
("freebsd" 'bsd-2)
;; gfdl_1_2
("gfdl_1_3" 'fdl1.3+)
("gpl_1" 'gpl1)
("gpl_2" 'gpl2)
("gpl_3" 'gpl3)
("lgpl_2_1" 'lgpl2.1)
("lgpl_3_0" 'lgpl3)
("mit" 'x11)
;; mozilla_1_0
("mozilla_1_1" 'mpl1.1)
("openssl" 'openssl)
("perl_5" 'gpl1+) ;and Artistic 1
("qpl_1_0" 'qpl)
;; ssleay
;; sun
("zlib" 'zlib)
((x) (string->license x))
((lst ...) `(list ,@(map string->license lst)))
(_ #f)))
(define (module->name module)
"Transform a 'module' name into a 'release' name"
(regexp-substitute/global #f "::" module 'pre "-" 'post))
(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\""
;; This API always returns the latest release of the module.
(json-fetch (string-append "http://api.metacpan.org/release/"
;; XXX: The 'release' api requires the "release"
;; name of the package. This substitution seems
;; reasonably consistent across packages.
(module->name module))))
(define (cpan-home name)
(string-append "http://search.cpan.org/dist/" name))
(define (cpan-module->sexp meta)
"Return the `package' s-expression for a CPAN module from the metadata in
META."
(define name
(assoc-ref meta "distribution"))
(define (guix-name name)
(if (string-prefix? "perl-" name)
(string-downcase name)
(string-append "perl-" (string-downcase name))))
(define version
(assoc-ref meta "version"))
(define (convert-inputs phases)
;; Convert phase dependencies into a list of name/variable pairs.
(match (flatten
(map (lambda (ph)
(filter-map (lambda (t)
(assoc-ref* meta "metadata" "prereqs" ph t))
'("requires" "recommends" "suggests")))
phases))
(#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)))))
(define (maybe-inputs guix-name inputs)
(match inputs
(()
'())
((inputs ...)
(list (list guix-name
(list 'quasiquote inputs))))))
(define source-url
(assoc-ref meta "download_url"))
(let ((tarball (with-store store
(download-to-store store source-url))))
`(package
(name ,(guix-name name))
(version ,version)
(source (origin
(method url-fetch)
(uri (string-append ,@(factorize-uri source-url version)))
(sha256
(base32
,(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
;; 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")))
,@(maybe-inputs 'inputs
(convert-inputs '("runtime")))
(home-page ,(string-append "http://search.cpan.org/dist/" name))
(synopsis ,(assoc-ref meta "abstract"))
(description fill-in-yourself!)
(license ,(string->license (assoc-ref meta "license"))))))
(define (cpan->guix-package module-name)
"Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the
`package' s-expression corresponding to that package, or #f on failure."
(let ((module-meta (cpan-fetch module-name)))
(and=> module-meta cpan-module->sexp)))

2
guix/scripts/import.scm
View File

@ -73,7 +73,7 @@ rather than \\n."
;;; Entry point.
;;;
(define importers '("gnu" "nix" "pypi"))
(define importers '("gnu" "nix" "pypi" "cpan"))
(define (resolve-importer name)
(let ((module (resolve-interface

91
guix/scripts/import/cpan.scm Normal file
View File

@ -0,0 +1,91 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import cpan)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix import cpan)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-cpan))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
(define (show-help)
(display (_ "Usage: guix import cpan PACKAGE-NAME
Import and convert the CPAN package for PACKAGE-NAME.\n"))
(display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import cpan")))
%standard-import-options))
;;;
;;; Entry point.
;;;
(define (guix-import-cpan . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
value)
(_ #f))
(reverse opts))))
(match args
((package-name)
(let ((sexp (cpan->guix-package package-name)))
(unless sexp
(leave (_ "failed to download meta-data for package '~a'~%")
package-name))
sexp))
(()
(leave (_ "too few arguments~%")))
((many ...)
(leave (_ "too many arguments~%"))))))

107
tests/cpan.scm Normal file
View File

@ -0,0 +1,107 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-cpan)
#:use-module (guix import cpan)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix tests)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(define test-json
"{
\"metadata\" : {
\"prereqs\" : {
\"configure\" : {
\"requires\" : {
\"ExtUtils::MakeMaker\" : \"0\",
\"Module::Build\" : \"0.28\"
}
},
\"runtime\" : {
\"requires\" : {
\"Getopt::Std\" : \"0\",
\"Test::Script\" : \"1.05\",
}
}
}
\"name\" : \"Foo-Bar\",
\"version\" : \"0.1\"
}
\"name\" : \"Foo-Bar-0.1\",
\"distribution\" : \"Foo-Bar\",
\"license\" : [
\"perl_5\"
],
\"abstract\" : \"Fizzle Fuzz\",
\"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
\"author\" : \"GUIX\",
\"version\" : \"0.1\"
}")
(define test-source
"foobar")
(test-begin "cpan")
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
(mock ((guix build download) url-fetch
(lambda* (url file-name #:key (mirrors '()))
(with-output-to-file file-name
(lambda ()
(display
(match url
("http://api.metacpan.org/release/Foo-Bar"
test-json)
("http://example.com/Foo-Bar-0.1.tar.gz"
test-source)
(_ (error "Unexpected URL: " url))))))))
(match (cpan->guix-package "Foo::Bar")
(('package
('name "perl-foo-bar")
('version "0.1")
('source ('origin
('method 'url-fetch)
('uri ('string-append "http://example.com/Foo-Bar-"
'version ".tar.gz"))
('sha256
('base32
(? string? hash)))))
('build-system 'perl-build-system)
('native-inputs
('quasiquote
(("perl-module-build" ('unquote 'perl-module-build)))))
('inputs
('quasiquote
(("perl-test-script" ('unquote 'perl-test-script)))))
('home-page "http://search.cpan.org/dist/Foo-Bar")
('synopsis "Fizzle Fuzz")
('description 'fill-in-yourself!)
('license 'gpl1+))
(string=? (bytevector->nix-base32-string
(call-with-input-string test-source port-sha256))
hash))
(x
(pk 'fail x #f)))))
(test-end "cpan")
(exit (= (test-runner-fail-count (test-runner-current)) 0))