137/227: build: glib-or-gtk: Generate the gdk-pixbuf-loaders cache file in a phase.

[guix-commits]

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

commit e0d9c3798229b041072e39dde1048bb02f1bfbcc
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Sun Oct 3 00:25:36 2021 -0400

    build: glib-or-gtk: Generate the gdk-pixbuf-loaders cache file in a phase.
    
    Adding a profile hook to do so covers most use cases, but it is still
    necessary to have the gdk-pixbuf loaders cache file computed at build time, 
as
    software may expect to find loaders support at that time.
    
    * guix/build/glib-or-gtk-build-system.scm: Delete trailing #t.
    (%gdk-pixbuf-loaders-cache-file-prefix): New variable.
    (generate-gdk-pixbuf-loaders-cache): New procedure.
    (generate-gdk-pixbuf-loaders-cache-file): Add procedure...
    (%standard-phases): ... and register it as a build phase.
---
 guix/build-system/glib-or-gtk.scm       |  5 ++-
 guix/build/glib-or-gtk-build-system.scm | 57 ++++++++++++++++++++++++++++++---
 2 files changed, 57 insertions(+), 5 deletions(-)

diff --git a/guix/build-system/glib-or-gtk.scm 
b/guix/build-system/glib-or-gtk.scm
index 0c88f03..aa97038 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -26,6 +26,8 @@
   #:use-module (guix monads)
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
+  #:use-module ((guix build glib-or-gtk-build-system)
+                #:select (%gdk-pixbuf-loaders-cache-file))
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (guix packages)
@@ -33,7 +35,8 @@
   #:export (%glib-or-gtk-build-system-modules
             glib-or-gtk-build
             glib-or-gtk-cross-build
-            glib-or-gtk-build-system))
+            glib-or-gtk-build-system)
+  #:re-export (%gdk-pixbuf-loaders-cache-file)) ;for convenience
 
 ;; Commentary:
 ;;
diff --git a/guix/build/glib-or-gtk-build-system.scm 
b/guix/build/glib-or-gtk-build-system.scm
index c2f814e..475a94a 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%standard-phases
+            %gdk-pixbuf-loaders-cache-file
+            generate-gdk-pixbuf-loaders-cache
             glib-or-gtk-build))
 
 ;; Commentary:
@@ -183,8 +186,7 @@ add a dependency of that output on GLib and GTK+."
                        (apply wrap-program program #:sh (sh) env-vars))
                      bin-list))))))
 
-  (for-each handle-output outputs)
-  #t)
+  (for-each handle-output outputs))
 
 (define* (compile-glib-schemas #:key outputs #:allow-other-keys)
   "Implement phase \"glib-or-gtk-compile-schemas\": compile \"glib\" schemas
@@ -197,11 +199,58 @@ if needed."
                             (not (file-exists?
                                   (string-append schemasdir 
"/gschemas.compiled"))))
                    (invoke "glib-compile-schemas" schemasdir)))))
-            outputs)
-  #t)
+            outputs))
+
+;; This file is to be generated by the
+;; `generate-gdk-pixbuf-loaders-cache' build phase defined below.
+(define %gdk-pixbuf-loaders-cache-file
+  "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache")
+
+(define (generate-gdk-pixbuf-loaders-cache directories outputs)
+  "Generate the loaders.cache file used by gdk-pixbuf to locate the available
+loaders among DIRECTORIES, and set the GDK_PIXBUF_MODULE_FILE environment
+variable.  The cache file is installed under OUTPUTS.  Return the first cache
+file name if one was created else #f."
+  (let* ((loaders (append-map
+                   (cut find-files <> "^libpixbufloader-.*\\.so$")
+                   directories))
+         (outputs* (map (cut string-append <> "/"
+                             %gdk-pixbuf-loaders-cache-file)
+                        outputs))
+         (loaders.cache (first outputs*))
+         (loaders.cache-copies (cdr outputs*)))
+    (if (not (null? loaders))
+        (begin
+          (mkdir-p (dirname loaders.cache))
+          (setenv "GDK_PIXBUF_MODULE_FILE" loaders.cache)
+          (apply invoke "gdk-pixbuf-query-loaders" "--update-cache" loaders)
+          (for-each (lambda (f)
+                      (mkdir-p (dirname f))
+                      (copy-file loaders.cache f))
+                    loaders.cache-copies)
+          loaders.cache)
+        #f)))
+
+(define* (generate-gdk-pixbuf-loaders-cache-file #:key inputs outputs
+                                                 #:allow-other-keys)
+  "Build phase that Wraps the GENERATE-GDK-PIXBUF-LOADERS-CACHE procedure."
+  ;; Conditionally compute the cache file if the gdk-pixbuf command is
+  ;; available on PATH (it comes with gdk-pixbuf).
+  (when (which "gdk-pixbuf-query-loaders")
+    (let ((loaders.cache (generate-gdk-pixbuf-loaders-cache
+                          (map cdr inputs)
+                          (filter-map identity
+                                      (list
+                                       (assoc-ref outputs "out")
+                                       (assoc-ref outputs "bin")
+                                       (assoc-ref outputs "lib"))))))
+      (when loaders.cache
+        (format #t "GDK_PIXBUF_MODULE_FILE set to `~a'~%" loaders.cache)))))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
+    (add-after 'unpack 'generate-gdk-pixbuf-loaders-cache-file
+      generate-gdk-pixbuf-loaders-cache-file)
     (add-after 'install 'glib-or-gtk-compile-schemas compile-glib-schemas)
     (add-after 'install 'glib-or-gtk-wrap wrap-all-programs)))