05/06: import cran: Refactor "needs-zlib?".

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit a0f43208cb424306a79fa74690b0f2075c7c35b2
Author: Ricardo Wurmus <address@hidden>
Date:   Wed Apr 5 18:42:07 2017 +0200

    import cran: Refactor "needs-zlib?".
    
    * guix/import/cran.scm (tarball-files-match-pattern?): New procedure.
    (needs-zlib?): Implement in terms of "tarball-files-match-pattern?".
---
 guix/import/cran.scm | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 039f352..db72feb 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -207,17 +207,16 @@ empty list when the FIELD cannot be found."
       (check "*.f95")
       (check "*.f")))
 
-(define (needs-zlib? tarball)
-  "Return #T if any of the Makevars files in the src directory of the TARBALL
-contain a zlib linker flag."
+(define (tarball-files-match-pattern? tarball regexp . file-patterns)
+  "Return #T if any of the files represented by FILE-PATTERNS in the TARBALL
+match the given REGEXP."
   (call-with-temporary-directory
    (lambda (dir)
-     (let ((pattern (make-regexp "-lz")))
+     (let ((pattern (make-regexp regexp)))
        (parameterize ((current-error-port (%make-void-port "rw+")))
-         (system* "tar"
-                  "xf" tarball "-C" dir
-                  "--wildcards"
-                  "*/src/Makevars*" "*/src/configure*" "*/configure*"))
+         (apply system* "tar"
+                "xf" tarball "-C" dir
+                `("--wildcards" ,@file-patterns)))
        (any (lambda (file)
               (call-with-input-file file
                 (lambda (port)
@@ -226,10 +225,16 @@ contain a zlib linker flag."
                       (cond
                        ((eof-object? line) #f)
                        ((regexp-exec pattern line) #t)
-                       (else (loop)))))))
-              #t)
+                       (else (loop))))))))
             (find-files dir))))))
 
+(define (needs-zlib? tarball)
+  "Return #T if any of the Makevars files in the src directory of the TARBALL
+contain a zlib linker flag."
+  (tarball-files-match-pattern?
+   tarball "-lz"
+   "*/src/Makevars*" "*/src/configure*" "*/configure*"))
+
 (define (description->package repository meta)
   "Return the `package' s-expression for an R package published on REPOSITORY
 from the alist META, which was derived from the R package's DESCRIPTION file."