commit:     a9c2999d4804ecb5b97782f5011b04158b72317a
Author:     Kerin Millar <kfm <AT> plushkava <DOT> net>
AuthorDate: Sun Sep 14 13:47:48 2025 +0000
Commit:     Kerin Millar <kfm <AT> plushkava <DOT> net>
CommitDate: Mon Sep 15 03:28:14 2025 +0000
URL:        https://gitweb.gentoo.org/proj/locale-gen.git/commit/?id=a9c2999d

Capture STDERR with a piped open in generate_archive()

Presently, the generate_archive() subroutine calls the redirect_stderr()
subroutine. The latter manipulates file descriptor #2 in the initial
perl process before executing a callback that causes perl to fork and
execute localedef(1) for the purpose of building the locale archive.
Further, the file descriptor in question is re-opened with a file in
read/write mode. Once localedef(1) exits, the file offset is reset to 0
so that the captured errors may be read.

Simplify matters by initially forking perl with the open builtin and
having the child process perform the equivalent of dup2(1, 2) before
proceeding to exec localedef(1). That way, the parent process can read
directly from the resulting pipe and there is no need to restore the
prior state of the file descriptor.

Signed-off-by: Kerin Millar <kfm <AT> plushkava.net>

 locale-gen | 38 +++++++++++++-------------------------
 1 file changed, 13 insertions(+), 25 deletions(-)

diff --git a/locale-gen b/locale-gen
index 796e8cc..05dabcf 100644
--- a/locale-gen
+++ b/locale-gen
@@ -9,7 +9,6 @@ use v5.36;
 
 use Cwd qw(getcwd);
 use Errno qw(ENOENT);
-use Fcntl qw(SEEK_SET);
 use File::Spec::Functions qw(canonpath catfile catdir path splitpath);
 use File::Temp qw(tempdir);
 use Getopt::Long ();
@@ -504,19 +503,20 @@ sub generate_archive ($gentoo_prefix, $locale_dir, 
$prior_archive, @canonicals)
        # Integrate all of the compiled locales into the new locale archive.
        my $total = scalar @canonicals;
        printf "Adding %d locale%s to the locale archive ...\n", $total, 
plural($total);
-       my $stderr = fopen('stderr.log', '+>');
-       redirect_stderr($stderr, sub {
+       my $stderr;
+       if (! defined(my $pid = open my $pipe, '-|')) {
+               die "Can't fork: $!";
+       } elsif ($pid == 0) {
+               open *STDERR, '>&=', *STDOUT or die "Can't direct STDERR to 
STDOUT: $!\n";
                run(qw( localedef --prefix . --quiet --add-to-archive -- ), 
@canonicals);
-       });
-
-       # Propagate the diagnostics and errors raised by localedef(1), if any.
-       seek $stderr, 0, SEEK_SET;
-       my $i = 0;
-       while (my $line = readline $stderr) {
-               warn $line;
-               ++$i;
+       } else {
+               local $/;
+               $stderr = readline $pipe;
+               if (length $stderr) {
+                       warn $stderr;
+               }
+               close $pipe;
        }
-       close $stderr;
 
        # Check the status code first.
        throw_child_error('localedef');
@@ -524,7 +524,7 @@ sub generate_archive ($gentoo_prefix, $locale_dir, 
$prior_archive, @canonicals)
        # Sadly, the exit status of GNU localedef(1) is nigh on useless in the
        # case that the --add-to-archive option is provided. If anything was
        # printed to STDERR at all, act as if the utility had exited 1.
-       if ($i > 0) {
+       if (length $stderr) {
                throw_child_error('localedef', 1 << 8);
        }
 
@@ -600,18 +600,6 @@ sub plural ($int) {
        return $int == 1 ? '' : 's';
 }
 
-sub redirect_stderr ($stderr, $callback) {
-       if (! open my $old_stderr, '>&', *STDERR) {
-               die "Can't dup STDERR to a new file descriptor: $!";
-       } elsif (! open *STDERR, '>&', $stderr) {
-               my $fileno = fileno $stderr;
-               die "Can't dup file descriptor #$fileno to STDERR: $!";
-       } else {
-               $callback->();
-               open *STDERR, '>&=', $old_stderr;
-       }
-}
-
 sub render_printable ($value) {
        require JSON::PP;
        return JSON::PP->new->ascii->space_after->encode($value)

Reply via email to