#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

use IO::Pty::Easy;
use IO::Select;

my $script = <<'SCRIPT';
use strict;
use warnings;
use Term::Filter::Callback;
my $term = Term::Filter::Callback->new(
    callbacks => {
        setup => sub {
            my ($t, @cmd) = @_;
            my $ref = ref($t);
            print "SETUP: $t ($ref): @cmd\n";
        },
        cleanup => sub {
            my ($t) = @_;
            my $ref = ref($t);
            print "CLEANUP: $t ($ref)\n";
        },
        munge_input => sub {
            my ($t, $buf) = @_;
            my $ref = ref($t);
            print "MUNGE_INPUT: $t ($ref): $buf\n";
            $buf = "\n" if $buf =~ /exit/i;
            return uc($buf);
        },
        munge_output => sub {
            my ($t, $buf) = @_;
            my $ref = ref($t);
            print "MUNGE_OUTPUT: $t ($ref): $buf\n";
            return lc($buf);
        },
    }
);
print "$term\n";
$term->run($^X, '-ple', q[last if /^$/]);
print "done\n";
SCRIPT

my $crlf = qr/\x0d\x0a/;

# just in case
alarm 60;

{
    my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
    $pty->spawn($^X, (map { "-I $_" } @INC), '-e', $script);

    my $setup_str = full_read($pty);

    my ($term_str, $ref) = $setup_str =~ m{
        ^
        ((.*)=.*)
        \n
        SETUP: \s \1 \s \(\2\):\s
        \Q$^X\E .* \Q-ple\E .* last\ if\ /\^\$/ .*
        \n
        $
    }sx;

    is($ref, 'Term::Filter::Callback', "setup callback got a Term::Filter::Callback object");

    $pty->write("fOo\n");

    like(
        full_read($pty),
        qr{
            ^
            MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s fOo\n
            \n
            MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
            \n
            foo$crlf
            MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
            \n
            foo$crlf
            $
        }sx,
        "munge_input and munge_output got the right arguments"
    );

    $pty->write("EXIT\n");

    like(
        full_read($pty),
        qr{
            ^
            MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s EXIT\n
            \n
            MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s $crlf
            \n
            $crlf
            CLEANUP: \s \Q$term_str\E \s \($ref\)\n
            done\n
            $
        }sx,
        "cleanup got the right arguments"
    );
}

sub full_read {
    my ($pty) = @_;

    my $select = IO::Select->new($pty);
    return if $select->has_exception(0.1);

    my $ret;
    while ($select->can_read(1)) {
        my $new = $pty->read;
        last unless defined($new) && length($new);
        $ret .= $new;
        return $ret if $select->has_exception(0.1);
    }

    return $ret;
}

done_testing;