gnu: glibc-locales: Install symlinks using the normalized codeset.

Fixes <https://bugs.gnu.org/36076>.
Reported by Jack Hill <jackhill@jackhill.us>
and Giovanni Biscuolo <g@xelera.eu>

* gnu/build/locale.scm (locale->name+codeset): New file.
* gnu/packages/base.scm (make-glibc-locales): Add #:modules
and #:imported-modules.  Add a 'symlink-normalized-codesets' phase.
This commit is contained in:
Ludovic Courtès 2019-06-06 16:52:15 +02:00
parent 15ec93a783
commit 0e6cee21a4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 45 additions and 1 deletions

View file

@ -24,6 +24,7 @@ (define-module (gnu build locale)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export (build-locale #:export (build-locale
normalize-codeset normalize-codeset
locale->name+codeset
read-supported-locales)) read-supported-locales))
(define locale-rx (define locale-rx
@ -84,3 +85,11 @@ (define* (build-locale locale
(invoke localedef "--no-archive" "--prefix" directory (invoke localedef "--no-archive" "--prefix" directory
"-i" locale "-f" codeset "-i" locale "-f" codeset
(string-append directory "/" name))) (string-append directory "/" name)))
(define (locale->name+codeset locale)
"Split a locale name such as \"aa_ER@saaho.UTF-8\" into two values: the
language/territory/modifier part, and the codeset."
(match (string-rindex locale #\.)
(#f (values locale #f))
(dot (values (string-take locale dot)
(string-drop locale (+ dot 1))))))

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2019 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2014, 2019 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2016, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015, 2016, 2018 Mark H Weaver <mhw@netris.org>
@ -1050,12 +1050,47 @@ (define-public (make-glibc-locales glibc)
(let ((args `(#:tests? #f #:strip-binaries? #f (let ((args `(#:tests? #f #:strip-binaries? #f
,@(package-arguments glibc)))) ,@(package-arguments glibc))))
(substitute-keyword-arguments args (substitute-keyword-arguments args
((#:modules modules '((guix build utils)
(guix build gnu-build-system)))
`((srfi srfi-11)
(gnu build locale)
,@modules))
((#:imported-modules modules '())
`((gnu build locale)
,@%gnu-build-system-modules))
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(replace 'build (replace 'build
(lambda _ (lambda _
(invoke "make" "localedata/install-locales" (invoke "make" "localedata/install-locales"
"-j" (number->string (parallel-job-count))))) "-j" (number->string (parallel-job-count)))))
(add-after 'build 'symlink-normalized-codesets
(lambda* (#:key outputs #:allow-other-keys)
;; The above phase does not install locales with names using
;; the "normalized codeset." Thus, create symlinks like:
;; en_US.utf8 -> en_US.UTF-8
(define (locale-directory? file stat)
(and (file-is-directory? file)
(string-index (basename file) #\_)
(string-rindex (basename file) #\.)))
(let* ((out (assoc-ref outputs "out"))
(locales (find-files out locale-directory?
#:directories? #t)))
(for-each (lambda (directory)
(let*-values (((base)
(basename directory))
((name codeset)
(locale->name+codeset base))
((normalized)
(normalize-codeset codeset)))
(unless (string=? codeset normalized)
(symlink base
(string-append (dirname directory)
"/" name "."
normalized)))))
locales)
#t)))
(delete 'install) (delete 'install)
(delete 'move-static-libs))) (delete 'move-static-libs)))
((#:configure-flags flags) ((#:configure-flags flags)