The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T

use strict;
use warnings;

use File::Next ();
use Test::More tests => 2;

use lib 't';
use Util;

sub do_parent {
    my %params = @_;

    my ( $stdout_read, $stderr_read, $stdout_lines, $stderr_lines ) =
        @params{qw/stdout_read stderr_read stdout_lines stderr_lines/};

    while ( $stdout_read || $stderr_read ) {
        my $rin = '';

        vec( $rin, fileno($stdout_read), 1 ) = 1 if $stdout_read;
        vec( $rin, fileno($stderr_read), 1 ) = 1 if $stderr_read;

        select( $rin, undef, undef, undef );

        if ( $stdout_read && vec( $rin, fileno($stdout_read), 1 ) ) {
            my $line = <$stdout_read>;

            if ( defined( $line ) ) {
                push @{$stdout_lines}, $line;
            }
            else {
                close $stdout_read;
                undef $stdout_read;
            }
        }

        if ( $stderr_read && vec( $rin, fileno($stderr_read), 1 ) ) {
            my $line = <$stderr_read>;

            if ( defined( $line ) ) {
                push @{$stderr_lines}, $line;
            }
            else {
                close $stderr_read;
                undef $stderr_read;
            }
        }
    }

    chomp @{$stdout_lines};
    chomp @{$stderr_lines};

    return;
}

prep_environment();

my $freedom = File::Next::reslash( 't/text/freedom-of-choice.txt' );
my $fourth  = File::Next::reslash( 't/text/4th-of-july.txt' );
my $science = File::Next::reslash( 't/text/science-of-myth.txt' );

my @expected = split /\n/, <<"EOF";
$freedom:1:A victim of collision on the open sea
$freedom:3:Sink, swim, go down with the ship
$freedom:6:I'll say it again in the land of the free
$freedom:15:He licked the other
$freedom:24:Seems to be the rule of thumb
$freedom:28:I'll say it again in the land of the free
$freedom:41:He licked the other
$fourth:1:Alone with the morning burning red
$fourth:2:On the canvas in my head
$fourth:6:Just the road and its majesty
$fourth:8:With the world in the rear view
$fourth:11:You were pretty as can be, sitting in the front seat
$fourth:13:And you're happy to be with me on the 4th of July
$fourth:14:We sang "Stranglehold" to the stereo
$fourth:19:Get drawn into the sun
$fourth:22:And there you were
$fourth:25:Staking a claim on the world we found
$fourth:28:You were out of the blue to a boy like me
$fourth:33:In the silence that we shared
$science:3:In the case of Christianity and Judaism there exists the belief
$science:6:The Buddhists believe that the functional aspects override the myth
$science:7:While other religions use the literal core to build foundations with
$science:8:See, half the world sees the myth as fact, and it's seen as a lie by the other half
$science:9:And the simple truth is that it's none of that 'cause
$science:10:Somehow no matter what the world keeps turning
$science:14:In fact, for better understanding we take the facts of science and apply them
$science:15:And if both factors keep evolving then we continue getting information
$science:16:But closing off the possibilities makes it hard to see the bigger picture
$science:18:Consider the case of the woman whose faith helped her make it through
$science:22:And if it works, then it gets the job done
$science:23:Somehow no matter what the world keeps turning
EOF

my $perl = caret_X();
my @lhs_args = ( $perl, '-Mblib', build_ack_invocation( '--sort-files', '-g', 'of', 't/text' ) );
my @rhs_args = ( $perl, '-Mblib', build_ack_invocation( '-x', 'the' ) ); # for now

if ( $ENV{'ACK_TEST_STANDALONE'} ) {
    @lhs_args = grep { $_ ne '-Mblib' } @lhs_args;
    @rhs_args = grep { $_ ne '-Mblib' } @rhs_args;
}

my ($stdout, $stderr);

if ( is_windows() ) {
    ($stdout, $stderr) = run_cmd("@lhs_args | @rhs_args");
}
else {
    my ( $stdout_read, $stdout_write );
    my ( $stderr_read, $stderr_write );
    my ( $lhs_rhs_read, $lhs_rhs_write );

    pipe( $stdout_read, $stdout_write );
    pipe( $stderr_read, $stderr_write );
    pipe( $lhs_rhs_read, $lhs_rhs_write );

    my $lhs_pid;
    my $rhs_pid;

    $lhs_pid = fork();

    if ( !defined($lhs_pid) ) {
        die 'Unable to fork';
    }

    if ( $lhs_pid ) {
        $rhs_pid = fork();

        if ( !defined($rhs_pid) ) {
            kill TERM => $lhs_pid;
            waitpid $lhs_pid, 0;
            die 'Unable to fork';
        }
    }

    if ( $rhs_pid ) { # parent
        close $stdout_write;
        close $stderr_write;
        close $lhs_rhs_write;
        close $lhs_rhs_read;

        do_parent(
            stdout_read  => $stdout_read,
            stderr_read  => $stderr_read,
            stdout_lines => ($stdout = []),
            stderr_lines => ($stderr = []),
        );

        waitpid $lhs_pid, 0;
        waitpid $rhs_pid, 0;
    }
    elsif ( $lhs_pid ) { # right-hand-side child
        close $stdout_read;
        close $stderr_read;
        close $stderr_write;
        close $lhs_rhs_write;

        open STDIN, '<&', $lhs_rhs_read or die "Can't open: $!";
        open STDOUT, '>&', $stdout_write or die "Can't open: $!";
        close STDERR;

        exec @rhs_args;
    }
    else { # left-hand side child
        close $stdout_read;
        close $stdout_write;
        close $lhs_rhs_read;
        close $stderr_read;

        open STDOUT, '>&', $lhs_rhs_write or die "Can't open: $!";
        open STDERR, '>&', $stderr_write or die "Can't open: $!";
        close STDIN;

        exec @lhs_args;
    }
}

sets_match( $stdout, \@expected, __FILE__ );
is_empty_array( $stderr );