The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

#use Smart::Comments::JSON '##';
use IPC::Run3 qw(run3);
#use List::MoreUtils qw( all );

delete $ENV{SSH_BATCH_SSH_CMD};
delete $ENV{SSH_BATCH_LINE_MODE};

my $should_skip;
BEGIN {
    $should_skip = ! $ENV{SSH_BATCH_TEST_AGENTZH};
};
use Test::More $should_skip ?
    (skip_all => "Should only be enabled by developers.") :
    ('no_plan');

sub sh ($) {
    my $cmd = shift;
    if (system($cmd) != 0) {
        die "Failed to execute $cmd. Abort.\n";
    }
}

sub fornodes (@) {
    my ($out, $err);
    run3 [$^X, 'bin/fornodes', @_], \undef, \$out, \$err;
    if ($? != 0) {
        warn "fornodes returns non-zero status: ", $? >> 8, "\n";
    }
    if ($err) {
        warn $err;
    }
    chomp $out;
    my @hosts = split / /ms, $out;
    return \@hosts;
}

sub tonodes (@) {
    my ($out, $err);
    run3 [$^X, 'bin/tonodes', @_], \undef, \$out, \$out;
    if ($? != 0) {
        warn "tonodes returns non-zero status: ", $? >> 8, "\n";
    }
    if ($err) {
        warn $err;
    }
    my @outs = split /^====+ [^=]+ ===+$/ms, $out;
    shift @outs;
    return \@outs;
}

sub tonodes2 (@) {
    my ($out, $err);
    run3 [$^X, 'bin/tonodes', @_], \undef, \$out, \$out;
    if ($? != 0) {
        warn "tonodes returns non-zero status: ", $? >> 8, "\n";
    }
    if ($err) {
        warn $err;
    }
    return $out;
}

sub atnodes (@) {
    my ($out, $err);
    run3 [$^X, 'bin/atnodes', @_], \undef, \$out, \$out;
    if ($? != 0) {
        warn "atnodes returns non-zero status: ", $? >> 8, "\n";
    }
    if ($err) {
        warn $err;
    }
    my @outs = split /^====+ [^=]+ ===+$/ms, $out;
    shift @outs;
    return \@outs;
}

sub atnodes2 (@) {
    my ($out, $err);
    run3 [$^X, 'bin/atnodes', @_], \undef, \$out, \$out;
    if ($? != 0) {
        warn "atnodes returns non-zero status: ", $? >> 8, "\n";
    }
    if ($err) {
        warn $err;
    }
    return $out;
}

sub gen_local_tree () {
    if (-d 't/tmp') {
        sh 'rm -rf t/tmp';
    }
    sh 'mkdir -p t/tmp';
    sh 'touch t/tmp/a.txt';
    sh 'touch t/tmp/b.txt';
    sh 'touch t/tmp/README';
    sh 'mkdir -p t/tmp/foo/bar';
    sh 'touch t/tmp/foo/INSTALL';
}

sub cleanup_remote_tree ($) {
    my $count = shift;
    my $outs = atnodes('rm -rf /tmp/tmp', '{tq}');
    is scalar(@$outs), $count, 'all hosts generate outputs';
    for my $out (@$outs) {
        like $out, qr/^\s*$/, 'rm successfuly';
    }
    $outs = atnodes('ls /tmp/tmp', '{tq}');
    is scalar(@$outs), $count, 'all hosts generate outputs';
    ## outs: @$outs
    for my $out (@$outs) {
        is $out, "\nRemote command returns status code 1.\nls: /tmp/tmp: No such file or directory\n\n",
            'directory already removed';
    }
}

my $hosts = fornodes('{tq}');
my $count = @$hosts;
ok $count > 3, "more than 3 hosts in {tq} (found $count)";

# atnodes: exit 1
{
    my $out = atnodes2('exit 1', '{tq}', '-L');
    my @lines = split /\n/, $out;
    my $i = 0;
    for my $host (@$hosts) {
        like $lines[$i++],
            qr/^\Q$host\E: Remote command returns status code 1\.$/,
            'line mode works';
    }
}

# atnodes: multi-line output
{
    my $out = atnodes2('echo hello, world; echo hey', '{tq}', '-L');
    my @lines = split /\n/, $out;
    my $i = 0;
    for my $host (@$hosts) {
        like $lines[$i++],
            qr/^\Q$host\E: hello, world$/,
            'line mode works';
        like $lines[$i++],
            qr/^\Q$host\E: hey$/,
            'line mode works';
    }
}

# atnodes: single-line
{
    my $out = atnodes2('echo', '{tq}', '-L');
    my @lines = split /\n/, $out;
    my $i = 0;
    for my $host (@$hosts) {
        like $lines[$i++],
            qr/^\Q$host\E: $/,
            'line mode works';
    }
}

# atnodes: no output
{
    my $out = atnodes2('echo -n', '{tq}', '-L');
    is $out, '', 'no output, no hostname';
}

# atnodes: buggy with invalid hosts
{
    my $out = atnodes2('hostname', '{buggy}', '-L');
    open my $in, '<', \$out;
    my $i = 0;
    my $fail_count = 0;
    while (<$in>) {
        chomp;
        next if /^ssh:.*?: Name or service not known\r?$/s;
        if (/^\S+: ERROR: /) {
            $fail_count++;
            next;
        }
        my $host = $hosts->[$i++];
        my $hostname;
        if ($host =~ /^\w+/) {
            $hostname = $&;
        }
        like $_, qr/^\Q$host\E: $hostname$/, 'hostname works';
    }
    close $in;
    cmp_ok $fail_count, '>', 1, 'fail count okay';
    ## out: $out
}

# atnodes: buggy with timeout hosts
{
    my $out = atnodes2('hostname', '-t', 2, '{timeout}', '-L');
    open my $in, '<', \$out;
    my $i = 0;
    my $fail_count = 0;
    while (<$in>) {
        chomp;
        next if /^ssh:.*?: Name or service not known\r?$/s;
        if (/^\S+: ERROR: .*?timed out/) {
            $fail_count++;
            next;
        }
        my $host = $hosts->[$i++];
        my $hostname;
        if ($host =~ /^\w+/) {
            $hostname = $&;
        }
        like $_, qr/^\Q$host\E: $hostname$/, 'hostname works';
    }
    close $in;
    cmp_ok $fail_count, '>=', 1, 'fail count okay';
    ## out: $out
}

# tonodes: buggy with invalid hosts
{
    my $out = tonodes2('t/agentzh.t', '{buggy}:/tmp/', '-L');
    open my $in, '<', \$out;
    my $i = 0;
    my $fail_count = 0;
    while (<$in>) {
        chomp;
        next if /^ssh:.*?: Name or service not known\r?$/s;
        if (/^\S+: ERROR: /) {
            $fail_count++;
            next;
        }
    }
    close $in;
    cmp_ok $fail_count, '>', 1, 'fail count okay';
    ## out: $out
}

# tonodes: buggy with timeout hosts
{
    my $out = tonodes2('t/agentzh.t', '-t', 2, '{timeout}:/tmp/', '-L');
    open my $in, '<', \$out;
    my $i = 0;
    my $fail_count = 0;
    while (<$in>) {
        chomp;
        if (/^\S+: ERROR: .*?timed out/) {
            $fail_count++;
        }
    }
    close $in;
    cmp_ok $fail_count, '>=', 1, 'fail count okay';
    ## out: $out
}

#exit;

cleanup_remote_tree($count);
my $outs = tonodes('-r', '-rsync', 't/tmp', '--', '{tq}', ':/tmp/');
for my $out (@$outs) {
    is $out, "\n\n", 'transfer successfuly';
}

$outs = atnodes('ls /tmp/tmp|sort', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
## outs: @$outs
for my $out (@$outs) {
    is $out, "\nREADME\na.txt\nb.txt\nfoo\n\n",
        'only specified files uploaded';
}

cleanup_remote_tree($count);
gen_local_tree();

$outs = tonodes('-r', 't/tmp', '{tq}:/tmp/');
is scalar(@$outs), $count, 'all hosts generate outputs';

$outs = atnodes('ls /tmp/tmp|sort', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
for my $out (@$outs) {
    is $out, "\nREADME\na.txt\nb.txt\nfoo\n\n", 'level 1 files expected';
}

$outs = atnodes('ls /tmp/tmp/foo|sort', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';

## outs: @$outs
for my $out (@$outs) {
    is $out, "\nINSTALL\nbar\n\n", 'level 1 files expected';
}

cleanup_remote_tree($count);

$outs = tonodes('t/tmp', '{tq}:/tmp/', '-v');
for my $out (@$outs) {
    is $out, "\n", 'transfer successfuly';
}

$outs = atnodes('ls /tmp/tmp', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
## outs: @$outs
for my $out (@$outs) {
    is $out, "\nRemote command returns status code 1.\nls: /tmp/tmp: No such file or directory\n\n", 'no -r no cp';
}

cleanup_remote_tree($count);

$outs = atnodes('mkdir /tmp/tmp', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';

$outs = tonodes('t/tmp/a.txt', 't/tmp/b.txt', '--', '{tq}', ':/tmp/tmp/');
for my $out (@$outs) {
    is $out, "\n\n", 'transfer successfuly';
}

$outs = atnodes('ls /tmp/tmp|sort', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
## outs: @$outs
for my $out (@$outs) {
    is $out, "\na.txt\nb.txt\n\n", 'only specified files uploaded';
}

cleanup_remote_tree($count);
$outs = atnodes('mkdir /tmp/tmp', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';

$outs = tonodes('t/tmp/*', '--', '{tq}', ':/tmp/tmp/');
## outs: @$outs
for my $out (@$outs) {
    is $out, "\n\n", 'transfer successfuly';
}

$outs = atnodes('ls /tmp/tmp|sort', '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
for my $out (@$outs) {
    is $out, "\n\n", 'no glob no files';
}

$outs = tonodes('-g', 't/tmp/*', '--', '{tq}', ':/tmp/tmp/', '-c', 2, '-v');
for my $out (@$outs) {
    like $out, qr/^\s*$/s, 'transfer successfuly';
}

$outs = atnodes('ls /tmp/tmp|sort', '-c', 2, '{tq}');
is scalar(@$outs), $count, 'all hosts generate outputs';
## outs: @$outs
for my $out (@$outs) {
    is $out, "\nREADME\na.txt\nb.txt\n\n", 'only specified files uploaded';
}

warn "DONE.\n";