perl redirect stdout to lexical filehandle

Question

I'm trying to write a helper function that runs a perl function in another process and returns a closure that produces a line of output at a time when called.

I figured out a way of doing this using pipe that mixes old and new-style filehandles. I used an old-style one for the sink in order to use the open(STDOUT, ">&thing") syntax and a new-style one for the source since it needs to be captured by a closure and I didn't want to burden the caller with providing a filehandle.

Is there a way of using a new-style filehandle in a construction with the same meaning as open(STDOUT, ">&thing") ?

#!/usr/bin/env perl

# pipe.pl
# use pipe() to create a pair of fd's.
# write to one and read from the other.
#
# The source needs to be captured by the closure and can't be
# destructed at the end of get_reader(), so it has to be lexical.
#
# We need to be able to redirect stdout to sink in such a way that
# we actually dup the file descriptor (so shelling out works as intended).
# open(STDOUT, ">&FILEHANDLE") achieves this but appears to require an
# old-style filehandle.

use strict;
use warnings;

sub get_reader {
    local *SINK;
    my $source;
    pipe($source, SINK) or die "can't open pipe!";
    my $cpid = fork();
    if ($cpid == -1) {
        die 'failed to fork';
    }
    elsif ($cpid == 0) {
        open STDOUT, ">&SINK" or die "can't open sink";
        system("echo -n hi");
        exit;
    }
    else {
        return sub {
            my $line = readline($source);
            printf "from child (%s)\n", $line;
            exit;
        }
    }
}

sub main {
    my $reader = get_reader();
    $reader->();
}

main();

When run, this produces

from child (hi)

as expected.

Answer 1

sub get_reader {
   my ($cmd) = @_;

   open(my $pipe, '-|', @$cmd);

   return sub {
      return undef if !$pipe;

      my $line = <$pipe>;
      if (!defined($line)) {
         close($pipe);
         $pipe = undef;
         return undef;
      }

      chomp($line);
      return $line;
   };
}

If that's not good enough (eg because you also need to redirect the child's STDIN or STDERR), you can use IPC::Run instead.

use IPC::Run qw( start );

sub get_reader {
   my ($cmd) = @_;

   my $buf = '';
   my $h = start($cmd, '>', \$buf);

   return sub {
      return undef if !$h;

      while (1) {
         if ($buf =~ s/^([^\n]*)\n//) {
            return $1;
         }

         if (!$h->pump())) {
            $h->finish();
            $h = undef;
            return substr($buf, 0, length($buf), '') if length($buf);
            return undef;
         }
      }
   };
}

Either way, you can now do

my $i = get_reader(['prog', 'arg', 'arg']);
while (defined( my $line = $i->() )) {
   print "$line\n";
}

Either way, error handling left to you.