From 525a59d6d3278f891e19c85cdad96175cffcdef7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 19 Aug 2012 21:50:03 +0200
Subject: utils: Add a `path' argument to `patch-shebang'.

* guix/build/utils.scm (patch-shebang): Add an optional `path'
  parameter.  Change SHEBANG-RX to match the whole interpreter file
  name.  Don't patch when BIN and CMD are the same.  Add docstring.
---
 guix/build/utils.scm | 32 +++++++++++++++++---------------
 1 file changed, 17 insertions(+), 15 deletions(-)

(limited to 'guix')

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index fbffa8ba43..7e572c0388 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -255,10 +255,12 @@ match substring."
           (loop (get-bytevector-n! in buffer 0 buffer-size))))))
 
 (define patch-shebang
-  (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]*)/([[:alnum:]]+)(.*)$")))
-    (lambda (file)
-      "Patch the #! interpreter path in FILE, if FILE actually starts with a
-shebang."
+  (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$")))
+    (lambda* (file
+              #:optional (path (search-path-as-string->list (getenv "PATH"))))
+      "Replace the #! interpreter file name in FILE by a valid one found in
+PATH, when FILE actually starts with a shebang.  Return #t when FILE was
+patched, #f otherwise."
       (define (patch p interpreter rest-of-line)
         (let* ((template (string-append file ".XXXXXX"))
                (out      (mkstemp! template))
@@ -287,21 +289,21 @@ shebang."
                  (let ((line (false-if-exception (read-line p))))
                    (and=> (and line (regexp-exec shebang-rx line))
                           (lambda (m)
-                            (let* ((PATH
-                                    (search-path-as-string->list (getenv "PATH")))
-                                   (cmd (match:substring m 2))
-                                   (bin (search-path PATH cmd)))
+                            (let* ((cmd (match:substring m 1))
+                                   (bin (search-path path
+                                                     (basename cmd))))
                               (if bin
-                                  (begin
-                                    (format (current-error-port)
-                                            "patch-shebang: ~a: changing `~a/~a' to `~a'~%"
-                                            file (match:substring m 1)
-                                            cmd bin)
-                                    (patch p bin (match:substring m 3)))
+                                  (if (string=? bin cmd)
+                                      #f          ; nothing to do
+                                      (begin
+                                        (format (current-error-port)
+                                                "patch-shebang: ~a: changing `~a' to `~a'~%"
+                                                file cmd bin)
+                                        (patch p bin (match:substring m 2))))
                                   (begin
                                     (format (current-error-port)
                                             "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
-                                            file cmd)
+                                            file (basename cmd))
                                     #f)))))))))))))
 
 ;;; Local Variables:
-- 
cgit v1.2.3