01/01: build-system/gnu: Add 'install-license-files' phase.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit a864d563025f7408204af8540f8611a56bd3c939
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 5 21:32:02 2017 +0100

    build-system/gnu: Add 'install-license-files' phase.
    
    Suggested by Dave Love <address@hidden>.
    
    * guix/build-system/gnu.scm (%license-file-regexp): New variable.
    (gnu-build): Add #:license-file-regexp and use it.
    (gnu-cross-build): Likewise.
    * guix/build/gnu-build-system.scm (%license-file-regexp): New variable.
    (install-license-files): New procedure.
    (%standard-phases): Add it.
---
 guix/build-system/gnu.scm       |  8 ++++++++
 guix/build/gnu-build-system.scm | 27 +++++++++++++++++++++++++++
 2 files changed, 35 insertions(+)

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 047ace7..f54afe1 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -273,6 +273,10 @@ standard packages used as implicit inputs of the GNU build 
system."
     (build (if target gnu-cross-build gnu-build))
     (arguments (strip-keyword-arguments private-keywords arguments))))
 
+(define %license-file-regexp
+  ;; Regexp matching license files.
+  "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
 (define* (gnu-build store name input-drvs
                     #:key (guile #f)
                     (outputs '("out"))
@@ -291,6 +295,7 @@ standard packages used as implicit inputs of the GNU build 
system."
                     (strip-directories ''("lib" "lib64" "libexec"
                                           "bin" "sbin"))
                     (validate-runpath? #t)
+                    (license-file-regexp %license-file-regexp)
                     (phases '%standard-phases)
                     (locale "en_US.utf8")
                     (system (%current-system))
@@ -358,6 +363,7 @@ packages that must not be referenced."
                   #:patch-shebangs? ,patch-shebangs?
                   #:strip-binaries? ,strip-binaries?
                   #:validate-runpath? ,validate-runpath?
+                  #:license-file-regexp ,license-file-regexp
                   #:strip-flags ,strip-flags
                   #:strip-directories ,strip-directories)))
 
@@ -432,6 +438,7 @@ is one of `host' or `target'."
                           (strip-directories ''("lib" "lib64" "libexec"
                                                 "bin" "sbin"))
                           (validate-runpath? #t)
+                          (license-file-regexp %license-file-regexp)
                           (phases '%standard-phases)
                           (locale "en_US.utf8")
                           (system (%current-system))
@@ -509,6 +516,7 @@ platform."
                     #:patch-shebangs? ,patch-shebangs?
                     #:strip-binaries? ,strip-binaries?
                     #:validate-runpath? ,validate-runpath?
+                    #:license-file-regexp ,license-file-regexp
                     #:strip-flags ,strip-flags
                     #:strip-directories ,strip-directories))))
 
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index e37b751..7b43361 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -29,6 +29,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
   #:export (%standard-phases
+            %license-file-regexp
             gnu-build))
 
 ;; Commentary:
@@ -641,6 +642,31 @@ which cannot be found~%"
             outputs)
   #t)
 
+(define %license-file-regexp
+  ;; Regexp matching license files.
+  "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
+(define* (install-license-files #:key outputs
+                                (license-file-regexp %license-file-regexp)
+                                #:allow-other-keys)
+  "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'."
+  (let* ((regexp    (make-regexp license-file-regexp))
+         (out       (or (assoc-ref outputs "out")
+                        (match outputs
+                          (((_ . output) _ ...)
+                           output))))
+         (package   (strip-store-file-name out))
+         (directory (string-append out "/share/doc/" package))
+         (files     (scandir "." (lambda (file)
+                                   (regexp-exec regexp file)))))
+    (format #t "installing ~a license files~%" (length files))
+    (for-each (lambda (file)
+                (if (file-is-directory? file)
+                    (copy-recursively file directory)
+                    (install-file file directory)))
+              files)
+    #t))
+
 (define %standard-phases
   ;; Standard build phases, as a list of symbol/procedure pairs.
   (let-syntax ((phases (syntax-rules ()
@@ -654,6 +680,7 @@ which cannot be found~%"
             validate-documentation-location
             delete-info-dir-file
             patch-dot-desktop-files
+            install-license-files
             reset-gzip-timestamps
             compress-documentation)))