diff mbox

gnu: perl-text-diff: Update perl-text-diff.

Message ID 20160707003023.16913265@openmailbox.org
State New
Headers show

Commit Message

Eric Bavier July 7, 2016, 5:30 a.m. UTC
On Fri, 01 Jul 2016 01:00:52 +0200
Alex Sassmannshausen <alex@pompo.co> 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).  

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

> 
> On 30 Jun 2016 21:58, Eric Bavier <ericbavier@openmailbox.org> wrote:
> >
> > On 2016-06-29 07:11, Alex Sassmannshausen wrote:   
> > > Hello, 
> > > 
> > > This patch updates perl-text-diff.  The URL had to be changed as it 
> > > seems it 
> > > has a new maintainer.   
> >
> > BTW, I have a WIP cpan updater for 'guix refresh'.  If you're interested 
> > in trying it out I can post a patch.  Home-page/source URL changes seem 
> > to be something that happens semi-regularly on CPAN, but AFAIK our 
> > updater framework cannot handle such things.
diff mbox

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))
 
+  (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 fails."
                       (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 fails."
                      (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 headers))))
                     ((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))
 
 ;;; Commentary:
 ;;;
@@ -86,19 +90,50 @@  return \"Test-Simple\""
                                         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\""
+(define (package->upstream-name package)
+  "Return the CPAN name of PACKAGE."
+  (let* ((properties (package-properties package))
+         (upstream-name (and=> 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 updaters
+;;; 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 "release"
-                             ;; name of the package.  This substitution seems
-                             ;; reasonably consistent across packages.
-                             (module->name module))))
+  (json-fetch (string-append "http://api.metacpan.org/release/" name)))
 
 (define (cpan-home name)
   (string-append "http://search.cpan.org/dist/" name))
 
+(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))))
 
   (define version
-    (assoc-ref meta "version"))
+    (cpan-version meta))
 
   (define core-module?
     (let ((perl-version (package-version perl))
@@ -184,9 +219,7 @@  META."
                    (list 'quasiquote inputs))))))
 
   (define source-url
-    (regexp-substitute/global #f "http://cpan.metacpan.org"
-                              (assoc-ref meta "download_url")
-                              'pre "mirror://cpan" 'post))
+    (cpan-source-url meta))
 
   (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=> 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=> (package-source package) origin-uri))
+        (fetch-method (and=> (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 core,
+;;; or (seemingly) new inputs.
+(define (latest-release package)
+  "Return an <upstream-source> 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 especially
-  ;; 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")))
 
 (define (ruby-package-name name)
   "Given the NAME of a package on RubyGems, return a Guix-compliant name for
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=" token)
-                    api-url))))
+                (pk 'github-url (if token
+                     (string-append api-url "?access_token=" token)
+                     api-url)))))
     (if (eq? json #f)
         (if token
             (error "Error downloading release information through the GitHub
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))
 
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 © 2014 David Thompson <davet@gnu.org>
-;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,14 +19,14 @@ 
 
 (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))
 
 (define (json-fetch url)
   "Return an alist representation of the JSON resource URL, or #f on failure."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (and (url-fetch url temp)
-          (hash-table->alist
-           (call-with-input-file temp json->scm))))))
+  (and=> (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 NAME,
 or #f on failure."
-  ;; XXX: We want to silence the download progress report, which is especially
-  ;; 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")))
 
 ;; 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) => %cpan-updater)
                  ((guix import pypi) => %pypi-updater)
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))