diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-05-23 14:55:44 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-05-23 15:02:26 +0200 |
commit | bc73a84398fa54b0a11a80c749bf78eb0a58dbe6 (patch) | |
tree | 3e7b6670989ceb4f31464bad632c0332121d96a0 /guix/build/graft.scm | |
parent | 12b6f6527e49c8c4191929a72b1692dbd9eb2440 (diff) | |
parent | 624d4e2e6ba402c374a340869306eec65a808a20 (diff) | |
download | guix-patches-bc73a84398fa54b0a11a80c749bf78eb0a58dbe6.tar guix-patches-bc73a84398fa54b0a11a80c749bf78eb0a58dbe6.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build/graft.scm')
-rw-r--r-- | guix/build/graft.scm | 28 |
1 files changed, 27 insertions, 1 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index b216e6c0d7..b61982dd64 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -83,6 +83,28 @@ writing the result to OUTPUT." (put-u8 output (char->integer char)) result))))) +(define (rename-matching-files directory mapping) + "Apply MAPPING to the names of all the files in DIRECTORY, where MAPPING is +a list of store file name pairs." + (let* ((mapping (map (match-lambda + ((source . target) + (cons (basename source) (basename target)))) + mapping)) + (matches (find-files directory + (lambda (file stat) + (assoc-ref mapping (basename file))) + #:directories? #t))) + + ;; XXX: This is not quite correct: if MAPPING contains "foo", and + ;; DIRECTORY contains "bar/foo/foo", we first rename "bar/foo" and then + ;; "bar/foo/foo" no longer exists so we fail. Oh well, surely that's good + ;; enough! + (for-each (lambda (file) + (let ((target (assoc-ref mapping (basename file)))) + (rename-file file + (string-append (dirname file) "/" target)))) + matches))) + (define* (rewrite-directory directory output mapping #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -115,6 +137,8 @@ file name pairs." (replace-store-references input output mapping store) (chmod output (stat:perms stat)))))))) + ((directory) + (mkdir-p dest)) (else (error "unsupported file type" stat))))) @@ -124,6 +148,8 @@ file name pairs." (umask #o022) (n-par-for-each (parallel-job-count) - rewrite-leaf (find-files directory))) + rewrite-leaf (find-files directory (const #t) + #:directories? #t)) + (rename-matching-files output mapping)) ;;; graft.scm ends here |