[PATCH] utils: Allow wrap-program to be called multiple times.

[Eric Bavier]

Currently, if (@ (guix build utils) wrap-program) is called multiple
times for the same file, the original file ends up being overwritten.
This happened to me when trying to wrap a python program, which had
already once been wrapped by python-build-system.  The
python-build-system wrapper sets PYTHON_PATH, and I needed to wrap the
program again in order to set PATH.

Comments are very welcome on this patch to core-updates, as I hacked it
together rather quickly.

A description of what ends up happening, e.g.:

1) Initially::

  $ ls
  foo

2) Then after first call to wrap-program::

  $ ls
  foo -> ./.foo-wrap-01
  .foo-real
  .foo-wrap-01

3) And then after another call to wrap-program::

  $ ls
  foo -> ./.foo-wrap-02
  .foo-real
  .foo-wrap-01
  .foo-wrap-02

>From 231130db4444685d8f3264e61d680634eaead9fb Mon Sep 17 00:00:00 2001
From: Eric Bavier <address@hidden>
Date: Tue, 9 Sep 2014 17:47:31 -0500
Subject: [PATCH] utils: Allow wrap-program to be called multiple times.

* guix/build/utils.scm (wrap-program): Multiple invocations of
  wrap-program for the same file create successive wrappers.
---
 guix/build/utils.scm |   26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 2f3dc9c..d4435b4 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -711,8 +711,24 @@ contents:
 This is useful for scripts that expect particular programs to be in $PATH, for
 programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or
 modules in $GUILE_LOAD_PATH, etc."
-  (let ((prog-real (string-append (dirname prog) "/." (basename prog) "-real"))
-        (prog-tmp  (string-append (dirname prog) "/." (basename prog) "-tmp")))
+  (define (wrapper-path num)
+    (format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) num))
+  (let* ((current-wrappers
+          (find-files (dirname prog)
+                      (string-append "\\." (basename prog) "-wrap-.*")))
+         (wrapper-num (if (null? current-wrappers)
+                          0
+                          (string->number
+                           (string-take-right (last current-wrappers) 2))))
+         (wrapper-tgt (if (zero? wrapper-num)
+                          (let ((prog-real (string-append
+                                            (dirname prog) "/."
+                                            (basename prog) "-real")))
+                            (copy-file prog prog-real)
+                            prog-real)
+                          (wrapper-path wrapper-num)))
+         (wrapper     (wrapper-path (1+ wrapper-num)))
+         (prog-tmp    (string-append wrapper-tgt "-tmp")))
     (define (export-variable lst)
       ;; Return a string that exports an environment variable.
       (match lst
@@ -735,8 +751,6 @@ modules in $GUILE_LOAD_PATH, etc."
          (format #f "export ~a=\"$~a${~a:+:}~a\""
                  var var var (string-join rest ":")))))
 
-    (copy-file prog prog-real)
-
     (with-output-to-file prog-tmp
       (lambda ()
         (format #t
@@ -744,9 +758,11 @@ modules in $GUILE_LOAD_PATH, etc."
                 (which "bash")
                 (string-join (map export-variable vars)
                              "\n")
-                (canonicalize-path prog-real))))
+                (canonicalize-path wrapper-tgt))))
 
     (chmod prog-tmp #o755)
+    (rename-file prog-tmp wrapper)
+    (symlink wrapper prog-tmp)
     (rename-file prog-tmp prog)))
 
 ;;; Local Variables:
-- 
1.7.9.5

-- 
Eric Bavier