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

use strict;
use warnings;

BEGIN {
   # We need to force TERM=xterm so that we can guarantee the right byte
   # sequences for testing
   $ENV{TERM} = "xterm";
}

use Test::More;
use Test::Identity;

use Tickit::Term;

use Time::HiRes qw( sleep );

my $term = Tickit::Term->new( UTF8 => 1 );
$term->set_size( 25, 80 );

is( $term->get_input_handle, undef, '$term->get_input_handle undef' );

my ( $type, $str );
$term->bind_event( key => sub {
   my ( $term, $ev, $args ) = @_;
   identical( $_[0], $term, '$_[0] is term for resize event' );
   is( $ev, "key", '$ev is key' );
   $type = $args->{type};
   $str  = $args->{str};
} );

$term->input_push_bytes( "A" );

is( $type, "text", '$type after push_bytes A' );
is( $str,  "A",    '$str after push_bytes A' );

is( $term->check_timeout, undef, '$term has no timeout after A' );

# We'll test with a Unicode character outside of Latin-1, to ensure it
# roundtrips correctly
#
# 'ĉ' [U+0109] - LATIN SMALL LETTER C WITH CIRCUMFLEX
#  UTF-8: 0xc4 0x89

undef $type; undef $str;
$term->input_push_bytes( "\xc4\x89" );

is( $type, "text",    '$type after push_bytes for UTF-8' );
is( $str,  "\x{109}", '$str after push_bytes for UTF-8' );

$term->input_push_bytes( "\e[A" );

is( $type, "key", '$type after push_bytes Up' );
is( $str,  "Up",  '$str after push_bytes Up' );

is( $term->check_timeout, undef, '$term has no timeout after Up' );

undef $type; undef $str;
$term->input_push_bytes( "\e[" );

is( $type, undef, '$type undef after partial Down' );
ok( defined $term->check_timeout, '$term has timeout after partial Down' );

$term->input_push_bytes( "B" );

is( $type, "key",  '$type after push_bytes after completed Down' );
is( $str,  "Down", '$str after push_bytes after completed Down' );

is( $term->check_timeout, undef, '$term has no timeout after completed Down' );

undef $type; undef $str;
$term->input_push_bytes( "\e" );

is( $type, undef, '$type undef after partial Escape' );

my $timeout = $term->check_timeout;
ok( $timeout, '$term has timeout after partial Escape' );

sleep $timeout + 0.01; # account for timing overlaps

is( $term->check_timeout, undef, '$term has no timeout after timedout' );

is( $type, "key",    '$type after push_bytes after timedout' );
is( $str,  "Escape", '$str after push_bytes after timedout' );

# Legacy event handling
{
   my ( $type, $str );
   $term->set_on_key( sub { ( undef, $type, $str ) = @_; } );

   $term->input_push_bytes( "A" );
}

{
   pipe( my $rd, my $wr ) or die "pipe() - $!";

   my $term = Tickit::Term->new( input_handle => $rd );

   isa_ok( $term, "Tickit::Term", '$term isa Tickit::Term' );
   is( $term->get_input_handle, $rd, '$term->get_input_handle is $rd' );
}

done_testing;