01/06: gnu: cups: Inherit & modify cups-minimal arguments.

[guix-commits]

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

commit 8d9a2dee1f213a35ce2e74d657806819b5df3126
Author: Tobias Geerinckx-Rice <me@tobias.gr>
AuthorDate: Tue Jun 22 16:56:19 2021 +0200

    gnu: cups: Inherit & modify cups-minimal arguments.
    
    * gnu/packages/cups.scm (cups)[arguments]: Use
    substitute-keyword-arguments on cups-minimal's arguments to do away
    with the redundant 'patch-makedefs and 'make-manpages-writable phases.
---
 gnu/packages/cups.scm | 251 ++++++++++++++++++++++++--------------------------
 1 file changed, 118 insertions(+), 133 deletions(-)

diff --git a/gnu/packages/cups.scm b/gnu/packages/cups.scm
index 230a36b..1a071a1 100644
--- a/gnu/packages/cups.scm
+++ b/gnu/packages/cups.scm
@@ -319,139 +319,124 @@ device-specific programs to convert and print many 
types of files.")
   (package/inherit cups-minimal
     (name "cups")
     (arguments
-     `(;; Three tests fail:
-       ;; * two tests in ipp-1.1.test related to "RFC 2911 section 3.2.6:
-       ;;   Get-Jobs Operation"
-       ;; * test of number of error/warning messages, probably related to a
-       ;;   missing font.
-       #:tests? #f
-       #:configure-flags
-       '("--disable-launchd"
-         "--disable-systemd")
-       #:phases
-       (modify-phases %standard-phases
-         (add-before 'configure 'patch-makedefs
-           (lambda _
-             (substitute* "Makedefs.in"
-               (("INITDIR.*=.*@INITDIR@") "INITDIR = @prefix@/@INITDIR@")
-               (("/bin/sh") (which "sh")))
-             #t))
-         (add-before 'check 'patch-tests
-           (lambda _
-             (let ((filters (assoc-ref %build-inputs "cups-filters"))
-                   (catpath (string-append
-                             (assoc-ref %build-inputs "coreutils") "/bin/"))
-                   (testdir (string-append (getcwd) "/tmp/")))
-               (mkdir testdir)
-               (substitute* "test/run-stp-tests.sh"
-                 ((" *BASE=/tmp/") (string-append "BASE=" testdir))
-
-                 ;; allow installation of filters from output dir and from
-                 ;; cups-filters
-                 (("for dir in /usr/libexec/cups/filter /usr/lib/cups/filter")
-                  (string-append
-                   "for dir in "
-                   (assoc-ref %outputs "out") "/lib/cups/filter "
-                   filters "/lib/cups/filter"))
-
-                 ;; check for charsets in cups-filters output
-                 (("/usr/share/cups/charsets")
-                  (string-append filters "/share/cups/charsets"))
-
-                 ;; install additional required filters
-                 (("instfilter texttopdf texttopdf pdf")
-                  (string-append
-                   "instfilter texttopdf texttopdf pdf;"
-                   "instfilter imagetoraster imagetoraster raster;"
-                   "instfilter gstoraster gstoraster raster;"
-                   "instfilter urftopdf urftopdf pdf;"
-                   "instfilter rastertopdf rastertopdf pdf;"
-                   "instfilter pstopdf pstopdf pdf"))
-
-                 ;; specify location of lpstat binary
-                 (("description=\"`lpstat -l")
-                  "description=\"`../systemv/lpstat -l")
-
-                 ;; patch shebangs of embedded scripts
-                 (("#!/bin/sh") (string-append "#!" (which "sh")))
-
-                 ;; also link mime definitions from cups-filters
-                 ;; to enable the additional filters for the test suite
-                 (("ln -s \\$root/conf/mime\\.types")
-                  (string-append
-                   "ln -s " filters
-                   "/share/cups/mime/cupsfilters.types $BASE/share/mime; "
-                   "ln -s $root/conf/mime.types"))
-                 (("ln -s \\$root/conf/mime\\.convs")
-                  (string-append
-                   "ln -s " filters
-                   "/share/cups/mime/cupsfilters.convs $BASE/share/mime; "
-                   "ln -s $root/conf/mime.convs")))
-
-               ;; fix search path for "cat"
-               (substitute* "cups/testfile.c"
-                 (("cupsFileFind\\(\"cat\", \"/bin\"")
-                  (string-append "cupsFileFind(\"cat\", \"" catpath "\""))
-                 (("cupsFileFind\\(\"cat\", \"/bin:/usr/bin\"")
-                  (string-append "cupsFileFind(\"cat\", \"" catpath "\"")))
-               #t)))
-         ;; Make the compressed manpages writable so that the
-         ;; reset-gzip-timestamps phase does not error out.
-         (add-before 'reset-gzip-timestamps 'make-manpages-writable
-           (lambda* (#:key outputs #:allow-other-keys)
-             (let* ((out (assoc-ref outputs "out"))
-                    (man (string-append out "/share/man")))
-               (for-each (lambda (file) (chmod file #o644))
-                         (find-files man "\\.gz"))
-               #t)))
-         (add-after 'install 'install-cups-filters-symlinks
-           (lambda* (#:key inputs outputs #:allow-other-keys)
-             (let ((out (assoc-ref outputs "out"))
-                   (cups-filters (assoc-ref inputs "cups-filters")))
-               ;; charsets
-               (symlink
-                (string-append cups-filters "/share/cups/charsets")
-                (string-append out "/share/charsets"))
-
-               ;; mime types, driver file, ppds
-               (for-each
-                (lambda (f)
-                  (symlink (string-append cups-filters f)
-                           (string-append out f)))
-                '("/share/cups/mime/cupsfilters.types"
-                  "/share/cups/mime/cupsfilters.convs"
-                  "/share/cups/drv/cupsfilters.drv"
-                  "/share/ppd"))
-
-               ;; filters
-               (for-each
-                (lambda (f)
-                  (symlink f
-                           (string-append out "/lib/cups/filter" (basename 
f))))
-                (find-files (string-append cups-filters "/lib/cups/filter")))
-
-               ;; backends
-               (for-each
-                (lambda (f)
-                  (symlink (string-append cups-filters f)
-                           (string-append out "/lib/cups/backend/"
-                                          (basename f))))
-                '("/lib/cups/backend/parallel"
-                  "/lib/cups/backend/serial"))
-
-               ;; banners
-               (let ((banners "/share/cups/banners"))
-                 (delete-file-recursively (string-append out banners))
-                 (symlink (string-append cups-filters banners)
-                          (string-append out banners)))
-
-               ;; assorted data
-               (let ((data "/share/cups/data"))
-                 (delete-file-recursively (string-append out data))
-                 (symlink (string-append cups-filters data)
-                          (string-append out data)))
-
-               #t))))))
+     (substitute-keyword-arguments (package-arguments cups-minimal)
+       ((#:tests? _ #t)
+        ;; Three tests fail:
+        ;; * two tests in ipp-1.1.test related to "RFC 2911 section 3.2.6:
+        ;;   Get-Jobs Operation"
+        ;; * test of number of error/warning messages, probably related to a
+        ;;   missing font.
+        #f)
+       ((#:configure-flags _ '())
+        `(list "--disable-launchd"
+               "--disable-systemd"))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+           (add-before 'check 'patch-tests
+             (lambda _
+               (let ((filters (assoc-ref %build-inputs "cups-filters"))
+                     (catpath (string-append
+                               (assoc-ref %build-inputs "coreutils") "/bin/"))
+                     (testdir (string-append (getcwd) "/tmp/")))
+                 (mkdir testdir)
+                 (substitute* "test/run-stp-tests.sh"
+                   ((" *BASE=/tmp/") (string-append "BASE=" testdir))
+
+                   ;; Allow installation of filters from the output directory
+                   ;; and from cups-filters.
+                   (("for dir in /usr/libexec/cups/filter 
/usr/lib/cups/filter")
+                    (string-append
+                     "for dir in "
+                     (assoc-ref %outputs "out") "/lib/cups/filter "
+                     filters "/lib/cups/filter"))
+
+                   ;; Check for charsets in the default cups-filters output.
+                   (("/usr/share/cups/charsets")
+                    (string-append filters "/share/cups/charsets"))
+
+                   ;; Install additional required filters.
+                   (("instfilter texttopdf texttopdf pdf")
+                    (string-append
+                     "instfilter texttopdf texttopdf pdf;"
+                     "instfilter imagetoraster imagetoraster raster;"
+                     "instfilter gstoraster gstoraster raster;"
+                     "instfilter urftopdf urftopdf pdf;"
+                     "instfilter rastertopdf rastertopdf pdf;"
+                     "instfilter pstopdf pstopdf pdf"))
+
+                   ;; Specify the location of the lpstat binary.
+                   (("description=\"`lpstat -l")
+                    "description=\"`../systemv/lpstat -l")
+
+                   ;; Patch the shebangs of embedded scripts.
+                   (("#!/bin/sh") (string-append "#!" (which "sh")))
+
+                   ;; Also link MIME definitions from cups-filters
+                   ;; to enable the additional filters for the test suite.
+                   (("ln -s \\$root/conf/mime\\.types")
+                    (string-append
+                     "ln -s " filters
+                     "/share/cups/mime/cupsfilters.types $BASE/share/mime; "
+                     "ln -s $root/conf/mime.types"))
+                   (("ln -s \\$root/conf/mime\\.convs")
+                    (string-append
+                     "ln -s " filters
+                     "/share/cups/mime/cupsfilters.convs $BASE/share/mime; "
+                     "ln -s $root/conf/mime.convs")))
+
+                 ;; Fix the search path for the "cat" command.
+                 (substitute* "cups/testfile.c"
+                   (("cupsFileFind\\(\"cat\", \"/bin\"")
+                    (string-append "cupsFileFind(\"cat\", \"" catpath "\""))
+                   (("cupsFileFind\\(\"cat\", \"/bin:/usr/bin\"")
+                    (string-append "cupsFileFind(\"cat\", \"" catpath 
"\""))))))
+           (add-after 'install 'install-cups-filters-symlinks
+             (lambda* (#:key inputs outputs #:allow-other-keys)
+               (let ((out (assoc-ref outputs "out"))
+                     (cups-filters (assoc-ref inputs "cups-filters")))
+                 ;; Charsets.
+                 (symlink
+                  (string-append cups-filters "/share/cups/charsets")
+                  (string-append out "/share/charsets"))
+
+                 ;; MIME types, driver files, and PPDs.
+                 (for-each
+                  (lambda (f)
+                    (symlink (string-append cups-filters f)
+                             (string-append out f)))
+                  '("/share/cups/mime/cupsfilters.types"
+                    "/share/cups/mime/cupsfilters.convs"
+                    "/share/cups/drv/cupsfilters.drv"
+                    "/share/ppd"))
+
+                 ;; Filters.
+                 (for-each
+                  (lambda (f)
+                    (symlink f
+                             (string-append out "/lib/cups/filter"
+                                            (basename f))))
+                  (find-files (string-append cups-filters "/lib/cups/filter")))
+
+                 ;; Backends.
+                 (for-each
+                  (lambda (f)
+                    (symlink (string-append cups-filters f)
+                             (string-append out "/lib/cups/backend/"
+                                            (basename f))))
+                  '("/lib/cups/backend/parallel"
+                    "/lib/cups/backend/serial"))
+
+                 ;; Banners.
+                 (let ((banners "/share/cups/banners"))
+                   (delete-file-recursively (string-append out banners))
+                   (symlink (string-append cups-filters banners)
+                            (string-append out banners)))
+
+                 ;; Assorted data.
+                 (let ((data "/share/cups/data"))
+                   (delete-file-recursively (string-append out data))
+                   (symlink (string-append cups-filters data)
+                            (string-append out data))))))))))
     (inputs
      `(("avahi" ,avahi)
        ("gnutls" ,gnutls)