From 73e27235cac1275ba7671fd2364325cf5788cb3c Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <address@hidden>
Date: Thu, 28 Mar 2019 00:26:02 -0400
Subject: [PATCH 5/9] import: pypi: Support more types of archives.

This change enables the PyPI importer to look for requirements in a source
archive of a different type than "tar.gz" or "tar.bz2".

* guix/import/pypi.scm: (guess-requirements)[tarball-directory]: Rename to...
[archive-root-directory]: this. Use COMPRESSED-FILED? to determine if an
archive is supported or not.
[guess-requirements-from-source]: Adapt to use the new method, and use unzip
to extract ZIP archives.
(guess-requirements): Rename the TARBALL argument to ARCHIVE, to denote the
archive format is no longer bound specifically to the Tar format.
---
 guix/import/pypi.scm | 47 ++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 23 deletions(-)

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index a90be67bb0..8e93653717 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -190,27 +190,24 @@ requirement names."
                 (loop (cons (specification->requirement-name line)
                             result))))))))))
 
-(define (guess-requirements source-url wheel-url tarball)
-  "Given SOURCE-URL, WHEEL-URL and a TARBALL of the package, return a list
-of the required packages specified in the requirements.txt file.  TARBALL will
+(define (guess-requirements source-url wheel-url archive)
+  "Given SOURCE-URL, WHEEL-URL and a ARCHIVE of the package, return a list
+of the required packages specified in the requirements.txt file.  ARCHIVE will
 be extracted in a temporary directory."
 
-  (define (tarball-directory url)
-    ;; Given the URL of the package's tarball, return the name of the directory
+  (define (archive-root-directory url)
+    ;; Given the URL of the package's archive, return the name of the directory
     ;; that will be created upon decompressing it. If the filetype is not
     ;; supported, return #f.
-    ;; TODO: Support more archive formats.
-    (let ((basename (substring url (+ 1 (string-rindex url #\/)))))
-      (cond
-       ((string-suffix? ".tar.gz" basename)
-        (string-drop-right basename 7))
-       ((string-suffix? ".tar.bz2" basename)
-        (string-drop-right basename 8))
-       (else
+    (if (compressed-file? url)
+        (let ((root-directory (file-sans-extension (basename url))))
+          (if (string=? "tar" (file-extension root-directory))
+              (file-sans-extension root-directory)
+              root-directory))
         (begin
-          (warning (G_ "Unsupported archive format: \
-cannot determine package dependencies"))
-          #f)))))
+          (warning (G_ "Unsupported archive format (~a): \
+cannot determine package dependencies") (file-extension url))
+          #f)))
 
   (define (read-wheel-metadata wheel-archive)
     ;; Given WHEEL-ARCHIVE, a ZIP Python wheel archive, return the package's
@@ -246,16 +243,20 @@ cannot determine package dependencies"))
 
   (define (guess-requirements-from-source)
     ;; Return the package's requirements by guessing them from the source.
-    (let ((dirname (tarball-directory source-url)))
+    (let ((dirname (archive-root-directory source-url))
+          (extension (file-extension source-url)))
       (if (string? dirname)
           (call-with-temporary-directory
            (lambda (dir)
              (let* ((pypi-name (string-take dirname (string-rindex dirname #\-)))
                     (requires.txt (string-append dirname "/" pypi-name
                                                  ".egg-info" "/requires.txt"))
-                    (exit-code (parameterize ((current-error-port (%make-void-port "rw+"))
-                                              (current-output-port (%make-void-port "rw+")))
-                                 (system* "tar" "xf" tarball "-C" dir requires.txt))))
+                    (exit-code
+                     (parameterize ((current-error-port (%make-void-port "rw+"))
+                                    (current-output-port (%make-void-port "rw+")))
+                       (if (string=? "zip" extension)
+                           (system* "unzip" archive "-d" dir requires.txt)
+                           (system* "tar" "xf" archive "-C" dir requires.txt)))))
                (if (zero? exit-code)
                    (parse-requires.txt (string-append dir "/" requires.txt))
                    (begin
@@ -271,13 +272,13 @@ cannot determine package dependencies"))
   (or (guess-requirements-from-wheel)
       (guess-requirements-from-source)))
 
-(define (compute-inputs source-url wheel-url tarball)
-  "Given the SOURCE-URL of an already downloaded TARBALL, return a list of
+(define (compute-inputs source-url wheel-url archive)
+  "Given the SOURCE-URL of an already downloaded ARCHIVE, return a list of
 name/variable pairs describing the required inputs of this package.  Also
 return the unaltered list of upstream dependency names."
   (let ((dependencies
          (remove (cut string=? "argparse" <>)
-                 (guess-requirements source-url wheel-url tarball))))
+                 (guess-requirements source-url wheel-url archive))))
     (values (sort
              (map (lambda (input)
                     (let ((guix-name (python->package-name input)))
-- 
2.21.0