[shepherd] 05/05: maint: Produce a deterministic ‘POT-Creation-Date’ in .pot files.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit edf7364dbcff0d31a51f969dd9d6b942b10b69d8
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Nov 3 19:30:21 2024 +0100

    maint: Produce a deterministic ‘POT-Creation-Date’ in .pot files.
    
    * build-aux/xgettext.scm: New file, taken from Guix commit
    f83b5274c8d67a9bccf8881cc4f87d76a3d172de and adapted to not use (guix
    build utils).
    * po/Makevars (XGETTEXT): New variable.
    (XGETTEXT_OPTIONS): Add ‘--xgettext’.
---
 build-aux/xgettext.scm | 112 +++++++++++++++++++++++++++++++++++++++++++++++++
 po/Makevars            |   7 +++-
 2 files changed, 118 insertions(+), 1 deletion(-)

diff --git a/build-aux/xgettext.scm b/build-aux/xgettext.scm
new file mode 100755
index 0000000..57d07bd
--- /dev/null
+++ b/build-aux/xgettext.scm
@@ -0,0 +1,112 @@
+#! /bin/sh
+# -*-scheme-*-
+build_aux=$(dirname $0)
+srcdir=$build_aux/..
+export LC_ALL=en_US.UTF-8
+export TZ=UTC0
+exec guile --no-auto-compile -L $srcdir -C $srcdir -e main -s "$0" "$@"
+!#
+
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; This program is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;;; Commentary:
+;;;
+;;; This script provides an xgettext wrapper to (re)set POT-Creation-Date from
+;;; a Git timestamp.  Test doing something like:
+;;;
+;;; build-aux/xgettext.scm --files-from=po/guix/POTFILES.in 
--default-domain=test
+;;;
+;;;; Code:
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-26)
+             (ice-9 curried-definitions)
+             (ice-9 match)
+             (ice-9 popen)
+             (ice-9 rdelim))
+
+(define ((option? name) option)
+  (string-prefix? name option))
+
+(define (get-option args name)
+  (let ((option (find (option? name) args)))
+    (and option
+         (substring option (string-length name)))))
+
+(define (pipe-command command)
+  (let* ((port (apply open-pipe* OPEN_READ command))
+         (output (read-string port)))
+    (close-port port)
+    output))
+
+(define (change-creation-date po-file timestamp)
+  "Change the @code{POT-Creation-Date} field in @var{po-file} to
+@var{timestamp}."
+  (let ((output (mkstemp "/tmp/xgettext-XXXXXX")))
+    (call-with-input-file po-file
+      (lambda (input)
+        (set-port-encoding! output (port-encoding input))
+        (let loop ()
+          (match (read-line input 'concat)
+            ((? eof-object?) #t)
+            (line
+             (let ((line (if (string-prefix? "\"POT-Creation-Date: " line)
+                             (string-append "\"POT-Creation-Date: "
+                                            timestamp "\\n\"\n")
+                             line)))
+               (display line output)
+               (loop))))))
+      #:guess-encoding #t)
+    (force-output output)
+    (copy-file (port-filename output) po-file)
+    (delete-file (port-filename output))))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (main args)
+  (fluid-set! %default-port-encoding #f)
+  (let* ((files-from (get-option args "--files-from="))
+         (default-domain (get-option args "--default-domain="))
+         (directory (or (get-option args "--directory=") "."))
+         (xgettext (or (get-option args "--xgettext=") "xgettext"))
+         (xgettext-args (filter (negate (option? "--xgettext=")) args))
+         (command (match xgettext-args
+                    ((xgettext.scm args ...)
+                     `(,xgettext ,@args))))
+         (result (apply system* command))
+         (status (/ result 256)))
+    (if (or (not (zero? status))
+            (not files-from))
+        (exit status)
+        (let* ((text (with-input-from-file files-from read-string))
+               (lines (string-split text #\newline))
+               (files (remove (cute string-prefix? "#" <>) lines))
+               (files (map (cute string-append directory "/" <>) files))
+               (git-command `("git" "log" "--pretty=format:%ci" "-n1" ,@files))
+               (timestamp (pipe-command git-command))
+               (source-date-epoch (or (getenv "SOURCE_DATE_EPOCH") "1"))
+               (timestamp (if (string-null? timestamp)
+                              source-date-epoch
+                              timestamp))
+               (po-file (string-append default-domain ".po")))
+          (change-creation-date po-file timestamp)))))
diff --git a/po/Makevars b/po/Makevars
index 3493567..42c15a0 100644
--- a/po/Makevars
+++ b/po/Makevars
@@ -5,10 +5,15 @@ DOMAIN = $(PACKAGE)
 subdir = po
 top_builddir = ..
 
+# Use the xgettext.scm wrapper to produce .pot files reproducibly using a
+# timestamp from Git for the 'POT-Creation-Date' field.
+XGETTEXT := $(top_srcdir)/build-aux/xgettext.scm
+
 XGETTEXT_OPTIONS =                             \
   --from-code=UTF-8                            \
   --keyword=l10n --keyword=l10n:1,2            \
-  --keyword=message
+  --keyword=message                            \
+  --xgettext=$(XGETTEXT_)
 
 # Set this to the empty string, which means translations are in the
 # public domain; in this case the translators are expected to disclaim