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.

1 files changed, 20 insertions, 10 deletions

diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index d3b7ef6f..b0edeb33 100644
--- 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): $!";
         }
 }