spawn: support PerlIO layer in scalar redirects

We have to deal with UTF-8 data for generating patches, so make
it easier to pass Perl utf8 data to git, diff, sdiff, etc. to
avoid "Wide character" warnings.

diff --git a/lib/PublicInbox/MailDiff.pm b/lib/PublicInbox/MailDiff.pm
index c7b991f1895c3cd669a20a85f2b22f56f8d21a33..b1c12d6d81bc71b85b9e15cec16c28282a34b372 100644 (file)
--- a/lib/PublicInbox/MailDiff.pm
+++ b/lib/PublicInbox/MailDiff.pm
@@ -63,7 +63,6 @@ sub next_smsg ($) {
 sub emit_msg_diff {
        my ($bref, $self) = @_; # bref is `git diff' output
        # will be escaped to `•' in HTML
-       utf8::decode($$bref);
        $self->{ctx}->{ibx}->{obfuscate} and
                obfuscate_addrs($self->{ctx}->{ibx}, $$bref, "\x{2022}");
        print { $self->{ctx}->{zfh} } '</pre><hr><pre>' if $self->{nr} > 1;
@@ -77,7 +76,7 @@ sub do_diff {
        my $dir = "$self->{tmp}/$n";
        $self->dump_eml($dir, $eml);
        my $cmd = [ qw(git diff --no-index --no-color -- a), $n ];
-       my $opt = { -C => "$self->{tmp}", quiet => 1 };
+       my $opt = { -C => "$self->{tmp}", quiet => 1, 1 => [':utf8', \my $o] };
        my $qsp = PublicInbox::Qspawn->new($cmd, undef, $opt);
        $qsp->psgi_qx($self->{ctx}->{env}, undef, \&emit_msg_diff, $self);
 }

diff --git a/lib/PublicInbox/SearchIdx.pm b/lib/PublicInbox/SearchIdx.pm
index 78519b22bf8346fbaf69b4f32b7fd981829091b8..9566b14d133be8cb35082cf538e4669cd13f075d 100644 (file)
--- a/lib/PublicInbox/SearchIdx.pm
+++ b/lib/PublicInbox/SearchIdx.pm
@@ -353,7 +353,7 @@ sub index_diff ($$$) {
 sub patch_id {
        my ($self, $sref) = @_;
        my $git = ($self->{ibx} // $self->{eidx} // $self)->git;
-       my $opt = { 0 => $sref, 2 => \(my $err) };
+       my $opt = { 0 => [ ':utf8', $sref ], 2 => \(my $err) };
        my $id = run_qx($git->cmd(qw(patch-id --stable)), undef, $opt);
        warn $err if $err;
        $id =~ /\A([a-f0-9]{40,})/ ? $1 : undef;

diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index d3b7ef6f8a418b0691e3b2c36422390093faeb48..b0edeb331e15ffb09f5dafbafaa9667ab363f11b 100644 (file)
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -332,6 +332,18 @@ sub which ($) {
        undef;
 }
 
+sub scalar_redirect {
+       my ($layer, $opt, $child_fd, $bref) = @_;
+       open my $fh, '+>'.$layer, undef;
+       $opt->{"fh.$child_fd"} = $fh;
+       if ($child_fd == 0) {
+               print $fh $$bref;
+               $fh->flush or die "flush: $!";
+               sysseek($fh, 0, SEEK_SET);
+       }
+       fileno($fh);
+}
+
 sub spawn ($;$$) {
        my ($cmd, $env, $opt) = @_;
        my $f = which($cmd->[0]) // die "$cmd->[0]: command not found\n";
@@ -342,15 +354,11 @@ sub spawn ($;$$) {
        }
        for my $child_fd (0..2) {
                my $pfd = $opt->{$child_fd};
-               if ('SCALAR' eq ref($pfd)) {
-                       open my $fh, '+>:utf8', undef;
-                       $opt->{"fh.$child_fd"} = $fh;
-                       if ($child_fd == 0) {
-                               print $fh $$pfd;
-                               $fh->flush or die "flush: $!";
-                               sysseek($fh, 0, SEEK_SET);
-                       }
-                       $pfd = fileno($fh);
+               if ('ARRAY' eq ref($pfd)) {
+                       my ($layer, $bref) = @$pfd;
+                       $pfd = scalar_redirect($layer, $opt, $child_fd, $bref)
+               } elsif ('SCALAR' eq ref($pfd)) {
+                       $pfd = scalar_redirect('', $opt, $child_fd, $pfd);
                } elsif (defined($pfd) && $pfd !~ /\A[0-9]+\z/) {
                        my $fd = fileno($pfd) //
                                        die "$pfd not an IO GLOB? $!";
@@ -394,7 +402,9 @@ sub read_out_err ($) {
        for my $fd (1, 2) { # read stdout/stderr
                my $fh = delete($opt->{"fh.$fd"}) // next;
                seek($fh, 0, SEEK_SET);
-               ${$opt->{$fd}} .= <$fh>;
+               my $dst = $opt->{$fd};
+               $dst = $opt->{$fd} = $dst->[1] if ref($dst) eq 'ARRAY';
+               $$dst .= <$fh>;
                $fh->error and croak "E: read(FD=$fd): $!";
        }
 }