Package: guix-patches;
Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Date: Thu, 4 Jan 2024 15:18:01 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
Message #20 received at 68242 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 68242 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 5/5] man-db: Add support for zstd compressed man pages. Date: Thu, 4 Jan 2024 11:48:21 -0500
* guix/man-db.scm (<mandb-entry>): Adjust comment.
(abbreviate-file-name): Adjust regexp.
(gz-compressed?, zstd-compressed?): New predicates.
(entry->string): Use them.
(man-page->entry): Adjust doc. Use input port reader appropriate to the
compression type, if any.
(man-files): Adjust regexp.
(mandb-entries): Adjust link resolving predicate.
* guix/profiles.scm (manual-database): Add guile-zlib extension.
Change-Id: I6336e46e2d324c520a7d15d6cafd12bbf43c5b09
---
guix/man-db.scm | 45 +++++++++++++++++++++++++++++++++++----------
guix/profiles.scm | 8 ++++++--
2 files changed, 41 insertions(+), 12 deletions(-)
diff --git a/guix/man-db.scm b/guix/man-db.scm
index 7d9707a592..12887ce400 100644
--- a/guix/man-db.scm
+++ b/guix/man-db.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022, 2024 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,6 +19,7 @@
(define-module (guix man-db)
#:use-module (zlib)
+ #:use-module (zstd)
#:use-module ((guix build utils) #:select (find-files))
#:use-module (gdbm) ;gdbm-ffi
#:use-module (srfi srfi-9)
@@ -48,7 +50,7 @@ (define-module (guix man-db)
(define-record-type <mandb-entry>
(mandb-entry file-name name section synopsis kind)
mandb-entry?
- (file-name mandb-entry-file-name) ;e.g., "../abiword.1.gz"
+ (file-name mandb-entry-file-name) ;e.g., "../abiword.1.zst"
(name mandb-entry-name) ;e.g., "ABIWORD"
(section mandb-entry-section) ;number
(synopsis mandb-entry-synopsis) ;string
@@ -63,7 +65,7 @@ (define (mandb-entry<? entry1 entry2)
(string<? (basename file1) (basename file2))))))))
(define abbreviate-file-name
- (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.gz)?$")))
+ (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.(gz|zst))?$")))
(lambda (file)
(match (regexp-exec man-file-rx (basename file))
(#f
@@ -71,6 +73,14 @@ (define abbreviate-file-name
(matches
(match:substring matches 1))))))
+(define (gzip-compressed? file-name)
+ "True if FILE-NAME is suffixed with the '.gz' file extension."
+ (string-suffix? ".gz" file-name))
+
+(define (zstd-compressed? file-name)
+ "True if FILE-NAME is suffixed with the '.zst' file extension."
+ (string-suffix? ".zst" file-name))
+
(define (entry->string entry)
"Return the wire format for ENTRY as a string."
(match entry
@@ -92,7 +102,11 @@ (define (entry->string entry)
"\t-\t-\t"
- (if (string-suffix? ".gz" file) "gz" "")
+ (cond
+ ((gzip-compressed? file) "gz")
+ ((zstd-compressed? file) "zst")
+ (else ""))
+
"\t"
synopsis "\x00"))))
@@ -148,7 +162,8 @@ (define (read-synopsis port)
(loop (cons line lines))))))
(define* (man-page->entry file #:optional (resolve identity))
- "Parse FILE, a gzipped man page, and return a <mandb-entry> for it."
+ "Parse FILE, a gzip or zstd compressed man page, and return a <mandb-entry>
+for it."
(define (string->number* str)
(if (and (string-prefix? "\"" str)
(> (string-length str) 1)
@@ -156,8 +171,13 @@ (define* (man-page->entry file #:optional (resolve identity))
(string->number (string-drop (string-drop-right str 1) 1))
(string->number str)))
- ;; Note: This works for both gzipped and uncompressed files.
- (call-with-gzip-input-port (open-file file "r0")
+ (define call-with-input-port*
+ (cond
+ ((gzip-compressed? file) call-with-gzip-input-port)
+ ((zstd-compressed? file) call-with-zstd-input-port)
+ (else call-with-port)))
+
+ (call-with-input-port* (open-file file "r0")
(lambda (port)
(let loop ((name #f)
(section #f)
@@ -191,14 +211,19 @@ (define* (man-page->entry file #:optional (resolve identity))
(define (man-files directory)
"Return the list of man pages found under DIRECTORY, recursively."
;; Filter the list to ensure that broken symlinks are excluded.
- (filter file-exists? (find-files directory "\\.[0-9][a-z]?(\\.gz)?$")))
+ (filter file-exists?
+ (find-files directory "\\.[0-9][a-z]?(\\.(gz|zst))?$")))
(define (mandb-entries directory)
"Return mandb entries for the man pages found under DIRECTORY, recursively."
(map (lambda (file)
(man-page->entry file
(lambda (link)
- (let ((file (string-append directory "/" link
- ".gz")))
- (and (file-exists? file) file)))))
+ (let ((file-gz (string-append directory "/" link
+ ".gz"))
+ (file-zst (string-append directory "/" link
+ ".zst")))
+ (and (or (file-exists? file-gz)
+ (file-exists? file-zst) file)
+ file)))))
(man-files directory)))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index da7790d819..7fa5dab62a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -7,7 +7,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado <at> elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas <at> gmail.com>
-;;; Copyright © 2017, 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2017, 2021, 2024 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2019 Kyle Meyer <kyle <at> kyleam.com>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
@@ -1701,6 +1701,9 @@ (define* (manual-database manifest #:optional system)
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+ (define guile-zstd
+ (module-ref (resolve-interface '(gnu packages guile)) 'guile-zstd))
+
(define modules
(delete '(guix config)
(source-module-closure `((guix build utils)
@@ -1709,7 +1712,8 @@ (define* (manual-database manifest #:optional system)
(define build
(with-imported-modules modules
(with-extensions (list gdbm-ffi ;for (guix man-db)
- guile-zlib)
+ guile-zlib
+ guile-zstd)
#~(begin
(use-modules (guix man-db)
(guix build utils)
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.