From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Bavier Subject: Re: [PATCH] gnu: perl-text-diff: Update perl-text-diff. Date: Thu, 7 Jul 2016 00:30:23 -0500 Message-ID: <20160707003023.16913265@openmailbox.org> References: <20160630230106.04CE5100EBA@mail2.openmailbox.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/U0ak1PLKX6MsudXjV9Mjowz" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:48802) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bL1tX-0006iz-PC for guix-devel@gnu.org; Thu, 07 Jul 2016 01:30:42 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bL1tT-0007aa-6q for guix-devel@gnu.org; Thu, 07 Jul 2016 01:30:38 -0400 Received: from mail.openmailbox.org ([62.4.1.34]:56324) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bL1tS-0007aR-KG for guix-devel@gnu.org; Thu, 07 Jul 2016 01:30:35 -0400 In-Reply-To: <20160630230106.04CE5100EBA@mail2.openmailbox.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Alex Sassmannshausen Cc: guix-devel --MP_/U0ak1PLKX6MsudXjV9Mjowz Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline On Fri, 01 Jul 2016 01:00:52 +0200 Alex Sassmannshausen wrote: > Yeah, would be very interested in that - please feel free to share! See attached. It may not apply cleanly to latest master, since I haven't had a chance to rebase lately. There are a few other things going on in that patch to, like trying to more cleanly silence output from importers and updaters, and trying to support basic authentication in (guix download). =20 Anyhow, hope it can be of help with your perl work, and I'll be revisiting it once I catch up on some other patches. `~Eric >=20 > On 30 Jun 2016 21:58, Eric Bavier wrote: > > > > On 2016-06-29 07:11, Alex Sassmannshausen wrote: =20 > > > Hello,=20 > > >=20 > > > This patch updates perl-text-diff.=C2=A0 The URL had to be changed as= it=20 > > > seems it=20 > > > has a new maintainer. =20 > > > > BTW, I have a WIP cpan updater for 'guix refresh'.=C2=A0 If you're inte= rested=20 > > in trying it out I can post a patch.=C2=A0 Home-page/source URL changes= seem=20 > > to be something that happens semi-regularly on CPAN, but AFAIK our=20 > > updater framework cannot handle such things.=20 --MP_/U0ak1PLKX6MsudXjV9Mjowz Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=wip-cpan-updater.patch diff --git a/guix/download.scm b/guix/download.scm index 88f285d..21649e7 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -307,12 +307,20 @@ own. This helper makes it easier to deal with \"tar = bombs\"." (define tar (module-ref (resolve-interface '(gnu packages base)) 'tar)) =20 + (define file-name + (match url + ((head _ ...) + (basename head)) + (_ + (basename url)))) + (mlet %store-monad ((drv (url-fetch url hash-algo hash - (string-append "tarbomb-" name) + (string-append "tarbomb-" + (or name file-name)) #:system system #:guile guile))) ;; Take the tar bomb, and simply unpack it as a directory. - (gexp->derivation name + (gexp->derivation (or name file-name) #~(begin (mkdir #$output) (setenv "PATH" (string-append #$gzip "/bin")) diff --git a/guix/http-client.scm b/guix/http-client.scm index 97a1e26..21b8c42 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -236,6 +236,8 @@ Raise an '&http-get-error' condition if downloading fai= ls." (string->uri uri) uri))) (let ((port (or port (open-connection-for-uri uri))) + (headers '((User-Agent . "GNU Guile") + (Accept . "*/*"))) (auth-header (match (uri-userinfo uri) ((? string? str) (list (cons 'Authorization @@ -250,10 +252,11 @@ Raise an '&http-get-error' condition if downloading f= ails." (if (guile-version>? "2.0.7") (http-get uri #:streaming? #t #:port port #:keep-alive? #t - #:headers auth-header) ; 2.0.9+ + #:headers (cons auth-header headers)) ;= 2.0.9+ (http-get* uri #:decode-body? text? ; 2.0.7 #:keep-alive? #t - #:port port #:headers auth-header))) + #:port port + #:extra-headers (cons auth-header head= ers)))) ((code) (response-code resp))) (case code diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index ad61ee7..c0c8569 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -23,18 +23,22 @@ #: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-26) #:use-module (json) #:use-module (guix hash) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix base32) - #:use-module ((guix download) #:select (download-to-store)) - #:use-module (guix import utils) + #:use-module ((guix download) #:select (download-to-store url-fetch)) + #:use-module ((guix import utils) #:select (factorize-uri + flatten assoc-ref*)) #:use-module (guix import json) #:use-module (guix packages) + #:use-module (guix upstream) #:use-module (guix derivations) #:use-module (gnu packages perl) - #:export (cpan->guix-package)) + #:export (cpan->guix-package + %cpan-updater)) =20 ;;; Commentary: ;;; @@ -86,19 +90,50 @@ return \"Test-Simple\"" module)) "distribution")) =20 -(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\"" +(define (package->upstream-name package) + "Return the CPAN name of PACKAGE." + (let* ((properties (package-properties package)) + (upstream-name (and=3D> properties + (cut assoc-ref <> 'upstream-name))) + (version (package-version package))) + (or upstream-name + (match (package-source package) + ((? origin? origin) + (match (origin-uri origin) + ((or (? string? url) (url _ ...)) + (match (string-match (string-append "([^/]*)-" version) url) + (#f #f) + (m (match:substring m 1)))) + (_ #f))) + (_ #f))))) + +;;; TODO: It seems that the general consensus amongst importers and update= rs +;;; is that they'd rather not get any output from the json-fetch and other +;;; *-fetch routines. Let's consolidate the logic into (guix import utils= ), +;;; rather than having all users create their own wrappers. +(define (cpan-fetch name) + "Return an alist representation of the CPAN metadata for the CPAN release +package NAME, or #f on failure." ;; 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 "relea= se" - ;; name of the package. This substitution se= ems - ;; reasonably consistent across packages. - (module->name module)))) + (json-fetch (string-append "http://api.metacpan.org/release/" name))) =20 (define (cpan-home name) (string-append "http://search.cpan.org/dist/" name)) =20 +(define (cpan-source-url meta) + (regexp-substitute/global #f "http://cpan.metacpan.org" + (assoc-ref meta "download_url") + 'pre "mirror://cpan" 'post)) + +(define (cpan-version meta) + "Return the version number from META." + (match (assoc-ref meta "version") + ((? number? version) + ;; version is sometimes not quoted in the module json, so it gets + ;; imported into Guile as a number, so convert it to a string. + (number->string version)) + (version version))) + (define %corelist (delay (let* ((perl (with-store store @@ -120,7 +155,7 @@ META." (string-append "perl-" (string-downcase name)))) =20 (define version - (assoc-ref meta "version")) + (cpan-version meta)) =20 (define core-module? (let ((perl-version (package-version perl)) @@ -184,9 +219,7 @@ META." (list 'quasiquote inputs)))))) =20 (define source-url - (regexp-substitute/global #f "http://cpan.metacpan.org" - (assoc-ref meta "download_url") - 'pre "mirror://cpan" 'post)) + (cpan-source-url meta)) =20 (let ((tarball (with-store store (download-to-store store source-url)))) @@ -217,5 +250,46 @@ META." (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))) + (let ((module-meta (cpan-fetch (module->name module-name)))) (and=3D> module-meta cpan-module->sexp))) + +(define (cpan-package? package) + "Return #t if PACKAGE is a package from CPAN." + (define cpan-url? + (let ((cpan-rx (make-regexp (string-append "(" + "https?://www.cpan.org" "|" + "mirror://cpan" "|" + "https?://cpan.metacpan.org" + ")")))) + (lambda (url) + (regexp-exec cpan-rx url)))) + + (let ((source-url (and=3D> (package-source package) origin-uri)) + (fetch-method (and=3D> (package-source package) origin-method))) + (and (eq? fetch-method url-fetch) + (match source-url + ((? string?) + (cpan-url? source-url)) + ((source-url ...) + (any cpan-url? source-url)))))) + +;;; TODO: Warn about inputs that have been moved in to or out of perl's co= re, +;;; or (seemingly) new inputs. +(define (latest-release package) + "Return an for the latest release of PACKAGE." + (match (cpan-fetch (package->upstream-name package)) + (#f #f) + (meta + (let ((version (cpan-version meta)) + (url (cpan-source-url meta))) + (upstream-source + (package (package-name package)) + (version version) + (urls url)))))) + +(define %cpan-updater + (upstream-updater + (name 'cpan) + (description "Updater for CPAN packages") + (pred cpan-package?) + (latest latest-release))) diff --git a/guix/import/gem.scm b/guix/import/gem.scm index fc06b0d..6e279af 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -38,14 +38,8 @@ (define (rubygems-fetch name) "Return an alist representation of the RubyGems metadata for the package= NAME, or #f on failure." - ;; XXX: We want to silence the download progress report, which is especi= ally - ;; annoying for 'guix refresh', but we have to use a file port. - (call-with-output-file "/dev/null" - (lambda (null) - (with-error-to-port null - (lambda () - (json-fetch - (string-append "https://rubygems.org/api/v1/gems/" name ".json"= ))))))) + (json-fetch + (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) =20 (define (ruby-package-name name) "Given the NAME of a package on RubyGems, return a Guix-compliant name f= or diff --git a/guix/import/github.scm b/guix/import/github.scm index 29116d7..5452ff9 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -33,7 +33,7 @@ failure." (call-with-output-file "/dev/null" (lambda (null) - (with-error-to-port null + (with-error-to-port (current-output-port) (lambda () (call-with-temporary-output-file (lambda (temp port) @@ -137,9 +137,9 @@ the package e.g. 'bedtools2'. Return #f if there is no= releases" (github-user-slash-repository url) "/releases")) (json (json-fetch* - (if token - (string-append api-url "?access_token=3D" token) - api-url)))) + (pk 'github-url (if token + (string-append api-url "?access_token=3D" token) + api-url))))) (if (eq? json #f) (if token (error "Error downloading release information through the GitH= ub diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index f07f453..e0dbb61 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -34,7 +34,6 @@ #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (hackage->guix-package %hackage-updater)) =20 diff --git a/guix/import/json.scm b/guix/import/json.scm index c3092a5..f0d75fd 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2014 David Thompson -;;; Copyright =C2=A9 2015 Eric Bavier +;;; Copyright =C2=A9 2015, 2016 Eric Bavier ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,14 +19,14 @@ =20 (define-module (guix import json) #:use-module (json) - #:use-module (guix utils) + #:use-module (guix http-client) #:use-module (guix import utils) #:export (json-fetch)) =20 (define (json-fetch url) "Return an alist representation of the JSON resource URL, or #f on failu= re." - (call-with-temporary-output-file - (lambda (temp port) - (and (url-fetch url temp) - (hash-table->alist - (call-with-input-file temp json->scm)))))) + (and=3D> (false-if-exception (http-fetch url)) + (lambda (port) + (let ((result (hash-table->alist (json->scm port)))) + (close-port port) + result)))) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index de30f4b..37f7f31 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -47,14 +47,8 @@ (define (pypi-fetch name) "Return an alist representation of the PyPI metadata for the package NAM= E, or #f on failure." - ;; XXX: We want to silence the download progress report, which is especi= ally - ;; annoying for 'guix refresh', but we have to use a file port. - (call-with-output-file "/dev/null" - (lambda (null) - (with-error-to-port null - (lambda () - (json-fetch (string-append "https://pypi.python.org/pypi/" - name "/json"))))))) + (json-fetch (string-append "https://pypi.python.org/pypi/" + name "/json"))) =20 ;; For packages found on PyPI that lack a source distribution. (define-condition-type &missing-source-error &error diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 0efc190..e499381 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -200,6 +200,7 @@ unavailable optional dependencies such as Guile-JSON." %cran-updater %bioconductor-updater %hackage-updater + ((guix import cpan) =3D> %cpan-updater) ((guix import pypi) =3D> %pypi-updater) ((guix import gem) =3D> %gem-updater) ((guix import github) =3D> %github-updater))) --MP_/U0ak1PLKX6MsudXjV9Mjowz--