01/02: import: cpan: check version bounds on core modules.

[Eric Bavier]

bavier pushed a commit to branch master
in repository guix.

commit b77d17d023257625af1281d49e8043a03289edaf
Author: Eric Bavier <address@hidden>
Date:   Fri Apr 15 23:52:19 2016 -0500

    import: cpan: check version bounds on core modules.
    
    Modules may be removed from Perl's core, so we must check for a removal
    version.
    
    * guix/import/cpan.scm (cpan-module->sexp)[core-module?]: Also check
    version upper bound.
---
 guix/import/cpan.scm |   35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index c80d568..ad61ee7 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -26,6 +26,7 @@
   #: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)
@@ -121,16 +122,30 @@ 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 core-module?
+    (let ((perl-version (package-version perl))
+          (rx (make-regexp
+               (string-append "released with perl v?([0-9\\.]*)"
+                              "(.*and removed from v?([0-9\\.]*))?"))))
+      (lambda (name)
+        (define (version-between? lower version upper)
+          (and (version>=? version lower)
+               (or (not upper)
+                   (version>? upper version))))
+        (and (force %corelist)
+             (parameterize ((current-error-port (%make-void-port "w")))
+               (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
+                 (let loop ()
+                   (let ((line (read-line corelist)))
+                     (if (eof-object? line)
+                         (begin (close-pipe corelist) #f)
+                         (or (and=> (regexp-exec rx line)
+                                    (lambda (m)
+                                      (let ((first (match:substring m 1))
+                                            (last  (match:substring m 3)))
+                                        (version-between?
+                                         first perl-version last))))
+                             (loop)))))))))))
 
   (define (convert-inputs phases)
     ;; Convert phase dependencies into a list of name/variable pairs.