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

use 5.010001;
use strict;
use warnings;
use constant NL => "\n";

use Data::Dump qw(dump);
use POSIX;
use Test::More 0.98;
use Text::ANSI::Util qw(
                           ta_add_color_resets
                           ta_detect ta_length ta_length_height ta_pad
                           ta_split_codes ta_split_codes_single
                           ta_strip ta_trunc ta_wrap ta_highlight
                           ta_highlight_all ta_extract_codes);

subtest "ta_detect" => sub {
    ok(!ta_detect("a"), 'neg 1');
    ok(!ta_detect("\e"), 'neg 2');
    ok( ta_detect("\e[0m"), 'pos 1');
    ok( ta_detect("\e[31;47mhello\e[0m"), 'pos 2');
};

subtest "ta_strip" => sub {
    is(ta_strip(""), "");
    is(ta_strip("hello"), "hello");
    is(ta_strip("\e[31;47mhello\e[0m"), "hello");
};

subtest "ta_extract_codes" => sub {
    is(ta_extract_codes(""), "");
    is(ta_extract_codes("hello"), "");
    is(ta_extract_codes("\e[31;47mhello\e[0m"), "\e[31;47m\e[0m");
};

subtest "ta_split_codes" => sub {
    is_deeply([ta_split_codes("")], []);
    is_deeply([ta_split_codes("a")], ["a"]);
    is_deeply([ta_split_codes("a\e[31m")], ["a", "\e[31m"]);
    is_deeply([ta_split_codes("\e[31ma")], ["", "\e[31m", "a"]);
    is_deeply([ta_split_codes("\e[31ma\e[0m")], ["", "\e[31m", "a", "\e[0m"]);
    is_deeply([ta_split_codes("\e[31ma\e[0mb")], ["", "\e[31m", "a", "\e[0m", "b"]);
    is_deeply([ta_split_codes("\e[31m\e[0mb")], ["", "\e[31m\e[0m", "b"]);
};

subtest "ta_split_codes_single" => sub {
    is_deeply([ta_split_codes_single("\e[31m\e[0mb")], ["", "\e[31m", "", "\e[0m", "b"]);
};

subtest "ta_length" => sub {
    is(ta_length(""), 0);
    is(ta_length("hello"), 5);
    is(ta_length("\e[0m"), 0);
    is(ta_length("\e[31;47mhello\e[0m"), 5);
};

subtest "ta_length_height" => sub {
    is_deeply(ta_length_height(""), [0, 0]);
    is_deeply(ta_length_height("\e[0m"), [0, 0]);
    is_deeply(ta_length_height(" "), [1, 1]);
    is_deeply(ta_length_height(" \n"), [1, 2]);
    is_deeply(ta_length_height("\e[31;47myellow\e[0m\nhello\n"), [6, 3]);
};

# single paragraph
my $txt1 = <<_;
\e[31;47mI\e[0m dont wan't to go home. Where do you want to go? I'll keep you company. Mr Goh,
I'm fine. You don't have to keep me company.
_
#qq--------10--------20--------30--------40--------50
my $txt1w =
qq|\e[31;47mI\e[0m dont wan't to go home. Where do you|.NL.
qq|want to go? I'll keep you company. Mr|.NL.
qq|Goh, I'm fine. You don't have to keep me|.NL.
qq|company.|.NL;

# multiple paragraph
my $txt1b = <<_;
\e[31;47mI\e[0m dont wan't to go home. Where do you want to go? I'll keep you company. Mr Goh,
I'm fine. You don't have to keep me company.

\e[31;47mI\e[0m dont wan't to go home. Where do you want to go? I'll keep you company. Mr Goh,
I'm fine. You don't have to keep me company.
_
#qq--------10--------20--------30--------40--------50
my $txt1bw =
qq|\e[31;47mI\e[0m dont wan't to go home. Where do you|.NL.
qq|want to go? I'll keep you company. Mr|.NL.
qq|Goh, I'm fine. You don't have to keep me|.NL.
qq|company.|.NL.NL.
qq|\e[31;47mI\e[0m dont wan't to go home. Where do you|.NL.
qq|want to go? I'll keep you company. Mr|.NL.
qq|Goh, I'm fine. You don't have to keep me|.NL.
qq|company.|.NL;

# no terminating newline
my $txt1c = "\e[31;47mI\e[0m dont wan't to go home. Where do you want to go? I'll keep you company. Mr Goh,
I'm fine. You don't have to keep...";
#qq--------10--------20--------30--------40--------50
my $txt1cw =
qq|\e[31;47mI\e[0m dont wan't to go home. Where do you|.NL.
qq|want to go? I'll keep you company. Mr|.NL.
qq|Goh, I'm fine. You don't have to keep...|;

subtest "ta_wrap" => sub {
    my ($res, $cres);

    $res  = ta_wrap($txt1 , 40);
    $cres = $txt1w;
    is($res, $cres, "single paragraph")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap($txt1b, 40);
    $cres = $txt1bw;
    is($res, $cres, "multiple paragraph")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap($txt1c, 40);
    $cres = $txt1cw;
    is($res, $cres, "no terminating newline")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap("x 12345678901234 x", 10);
    $cres = "x\n1234567890\n1234 x";
    is($res, $cres, "truncate long word 1")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap("x \e[1m12345678901234\e[0m x", 10);
    $cres = "x\e[1m\e[0m\n\e[1m1234567890\e[0m\e[0m\n\e[1m1234\e[0m x";
    is($res, $cres, "truncate long word 2")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap("\e[1m12345678901234\e[0m", 10);
    $cres = "\e[1m1234567890\e[0m\n\e[1m1234\e[0m";
    is($res, $cres, "truncate long word 3 (broken in v0.08)")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    $res  = ta_wrap("x\n\e[1m\nx", 10);
    $cres = "x\n\n\e[1mx";
    is($res, $cres, "color code in parabreak")
        or diag dump([split /^/, $cres], [split /^/, $res]);

    # XXX fli opt
    # XXX fli deduced
    # XXX fli opt
    # XXX sli deduced
    # XXX pad opt

    $res = ta_wrap("12345 123", 10, {return_stats=>1});
    is_deeply($res, ["12345 123", {max_word_width=>5, min_word_width=>3}],
              "opt return_stats");
};

subtest "ta_trunc" => sub {
    my $t = "\e[31m1\e[32m2\e[33m3\e[0m4";
    is(ta_trunc($t, 5), $t);
    is(ta_trunc($t, 4), $t);
    is(ta_trunc($t, 3), "\e[31m1\e[32m2\e[33m3\e[0m");
    is(ta_trunc($t, 2), "\e[31m1\e[32m2\e[33m\e[0m");
    is(ta_trunc($t, 1), "\e[31m1\e[32m\e[33m\e[0m");
    is(ta_trunc($t, 0), "\e[31m\e[32m\e[33m\e[0m");
};

subtest "ta_pad" => sub {
    my $foo = "\e[31;47mfoo\e[0m";
    is(ta_pad(""    , 10), "          ", "empty");
    is(ta_pad("$foo", 10), "$foo       ");
    is(ta_pad("$foo", 10, "l"), "       $foo");
    is(ta_pad("$foo", 10, "c"), "   $foo    ");
    is(ta_pad("$foo", 10, "r", "x"), "${foo}xxxxxxx");
    is(ta_pad("${foo}12345678", 10), "${foo}12345678");
    is(ta_pad("${foo}12345678", 10, undef, undef, 1), "${foo}1234567");
};

subtest "ta_highlight" => sub {
    is(ta_highlight("\e[1m\e[31m12345\e[32m64567\e[0m", "456", "\e[7m"),
       "\e[1m\e[31m123\e[7m45\e[0m\e[1m\e[31m\e[7m6\e[0m\e[1m\e[31m\e[32m4567\e[0m");
};

subtest "ta_highlight_all" => sub {
    is(ta_highlight_all("\e[1m\e[31m12345\e[32m674567\e[0m", "456", "\e[7m"),
       "\e[1m\e[31m123\e[7m45\e[0m\e[1m\e[31m\e[7m6\e[0m\e[1m\e[31m\e[32m7\e[7m456\e[0m\e[1m\e[31m\e[32m7\e[0m");
};

subtest "ta_add_color_resets" => sub {
    is_deeply([ta_add_color_resets("\e[31mred and \e[1mbold", "beureum", "merah\e[0m normal", "normale")],
              ["\e[31mred and \e[1mbold\e[0m",
               "\e[31m\e[1mbeureum\e[0m",
               "\e[31m\e[1mmerah\e[0m normal",
               "\e[0mnormale"]);
};

DONE_TESTING:
done_testing();