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

use FindBin;
use lib "$FindBin::RealBin/lib";
use Async::Selector::testutils;


package Async::Selector::Sample::Resources;
use strict;
use warnings;

sub new {
    my ($class, $selector, @names) = @_;
    my $self =  bless {
        selector => $selector,
        resources => { map {$_ => ""} @names },
    }, $class;
    my %register_params = ();
    foreach my $name (@names) {
        $register_params{$name} = sub {
            my ($min_length) = @_;
            return length($self->{resources}{$name}) >= $min_length ? $self->{resources}{$name} : undef;
        };
    }
    $selector->register(%register_params);
    return $self;
}

sub get {
    my ($self, @names) = @_;
    return @{$self->{resources}}{@names};
}

sub set {
    my ($self, %vals) = @_;
    @{$self->{resources}}{keys %vals} = values %vals;
    $self->{selector}->trigger(keys %vals);
}

package main;

BEGIN {
    use_ok('Async::Selector');
}

sub collector {
    my ($result_ref, $one_shot) = @_;
    return sub {
        my ($w, %res) = @_;
        ok(defined($res{$_}), "value for key $_ is defined.") foreach keys %res;
        push(@$result_ref, map { sprintf("%s:%s", $_, $res{$_}) } keys %res);
        if($one_shot) {
            $w->cancel();
        }
    };
}

sub checkResult {
    my ($result_ref, @exp_list) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    checkArray('result', $result_ref, @exp_list);
}

{
    note('--- N-resource: resources in watcher callback should only have keys for available resource.');
    my $s = new_ok('Async::Selector');
    my $rs = Async::Selector::Sample::Resources->new($s, 1 .. 5);
    my $fired = 0;
    my $w;
    $w = $s->watch(1 => 0, 2 => 5, 4 => 2, sub {
        my ($watcher, %res) = @_;
        $fired = 1;
        ok(!defined($w), '$w is not defined at this time because this is immediate fire.');
        checkCond($watcher, [1,2,4], {1=>0, 2=>5, 4=>2}, "watcher in callback");
        is($res{1}, "", "got resource 1");
        ok(!exists($res{$_}), "No key for resource $_") foreach 2..5;
        $watcher->cancel();
    });
    ok($fired, "watcher fired.");
    ok(!$w->active, "watcher fired.");
    
    $fired = 0;
    $w = $s->watch(3 => 3, 4 => 4, 5 => 5, 6 => 6, sub {
        my ($watcher, %res) = @_;
        $fired = 1;
        is($watcher, $w, '$watcher is actually $w.');
        checkCond($watcher, [3,4,5,6], {3=>3, 4=>4, 5=>5, 6=>6}, "watcher in callback");
        is($res{3}, "cccc", "got resource 3");
        is($res{4}, "dddd", "got resource 4");
        ok(!exists($res{$_}), "No key for resource $_") foreach (1,2,5,6);
    });
    ok(!$fired, "not yet fired");
    ok($w->active);
    $rs->set(1 => 'aaaa', 2 => 'bbbb', 3 => 'cccc', 4 => "dddd", 5 => "eeee");
    ok($fired, "fired");
    ok($w->active);
    $w->cancel();
    $fired = 0;
    ok(!$w->active);
    $rs->set(1 => 'aaaaaa', 2 => 'bbbbbb', 3 => 'cccccc', 4 => "dddddd", 5 => "eeeeee");
    ok(!$fired, "not fired because already canceled");
}

{
    note('--- N-resource, registered()');
    my $s = new_ok('Async::Selector');
    my $rs = Async::Selector::Sample::Resources->new($s, 1 .. 10);
    ok( $s->registered($_), "$_ is registered") foreach (1..10);
    ok(!$s->registered($_), "$_ is not registered") foreach (0, 11..15);
}

{
    note('--- N-resource, 1-watch.');
    my $N = 5;
    my $s = new_ok('Async::Selector');
    my $rs = Async::Selector::Sample::Resources->new($s, 1 .. $N);
    my @result = ();
    my $w = $s->watch(1 => 3, 2 => 4, 3 => 2, 4 => 9, 5 => 2, collector(\@result, 1));
    ok($w->active, "w is active now.");
    checkResult \@result;
    $rs->set(1 => "sk", 2 => "sas", 3 => "", 4 => "abcdefgh", 5 => "Y");
    checkResult \@result;
    $rs->set(1 => "ab", 2 => "asas", 3 => "BB",               5 => "ybb");
    checkResult \@result, qw(2:asas 3:BB 5:ybb);
    checkWatchers $s;
    ok(!$w->active, "w is fired and inactive now");
    @result = ();
    $rs->set(map {$_ => "this_is_a_long_string"} 1 .. $N);
    cmp_ok(int(@result), "==", 0, "no result because the watcher is removed.");

    @result = ();
    $w = $s->watch(1 => 0, 2 => 3, 3 => 4, collector(\@result, 0));
    checkResult \@result, qw(1:this_is_a_long_string 2:this_is_a_long_string 3:this_is_a_long_string);
    @result = ();
    $rs->set(1 => "", 2 => "aa", 3 => "bb", 4 => "cc", 5 => "dd");
    checkResult \@result, qw(1:);
    checkWatchers $s, $w;
    ok($w->active, "w is active");
    @result = ();
    $s->trigger(1 .. $N);
    checkResult \@result, qw(1:);
    @result = ();
    $s->trigger(3);
    checkResult \@result;
    @result = ();
    $rs->set(2 => "aaa", 3 => "bbbb", 4 => "ccccc", 5 => "dddddd");
    ok($w->active, "w is still active");
    checkResult \@result, qw(2:aaa 3:bbbb);

    note("--- -- if the triggered resource is not selected, the watcher callback is not executed.");
    @result = ();
    $s->trigger(4, 5);
    checkResult \@result;

    checkWatchers $s, $w;
    $w->cancel();
    checkWatchers $s;
    ok(!$w->active, "w is inactive now");

    @result = ();
    $rs->set(map {$_ => ""} 1 .. $N);
    checkResult \@result;

    @result = ();
    $w = $s->watch(3 => 3, 4 => 4, 5 => 5, collector(\@result, 0));
    checkResult \@result;
    checkWatchers $s, $w;
    @result = ();
    $rs->set(1 => "a", 2 => "b", 3 => "c", 4 => "d", 5 => "e");
    checkResult \@result;
    @result = ();
    $rs->set(1 => "a" x 3, 2 => "b" x 3, 3 => "c" x 3, 4 => "d" x 3, 5 => "e" x 3);
    checkResult \@result, qw(3:ccc);
    @result = ();
    $rs->set(1 => "a" x 4, 2 => "b" x 4, 3 => "c" x 4, 4 => "d" x 4, 5 => "e" x 4);
    checkResult \@result, qw(3:cccc 4:dddd);
    @result = ();
    $rs->set(1 => "a" x 5, 2 => "b" x 5, 3 => "c" x 5, 4 => "d" x 5, 5 => "e" x 5);
    checkResult \@result, qw(3:ccccc 4:ddddd 5:eeeee);
}

{
    note('--- 1-resource, M-watchers');
    my $s = new_ok('Async::Selector');
    my $rs = Async::Selector::Sample::Resources->new($s, 1);
    my @result = ();
    note('--- -- continuous watchers');
    my @watchers = ();
    my $w;
    push @watchers, $s->watch(1 => 1, collector(\@result, 0));
    push @watchers, $s->watch(1 => 2, collector(\@result, 0));
    checkResult \@result;
    checkWatchers $s, @watchers;
    $rs->set(1 => "A");
    checkResult \@result, qw(1:A);
    checkWatchers $s, @watchers;
    @result = ();
    $rs->set(1 => "BB");
    checkResult \@result, qw(1:BB 1:BB);
    checkWatchers $s, @watchers;
    @result = ();
    $rs->set(1 => 'a');
    checkResult \@result, qw(1:a);
    checkWatchers $s, @watchers;
    ok($_->active, "watcher active") foreach @watchers;
    $_->cancel() foreach @watchers;
    checkWatchers $s;
    @result = ();
    $rs->set(1 => 'abcde');
    checkResult \@result;
    ok(!$_->active, "watcher inactive") foreach @watchers;

    note('--- -- one-shot watchers');
    @result = ();
    $w = $s->watch(1 => 4, collector(\@result, 1));
    ok(!$w->active, "immediate fire gives inactive watcher");
    checkCond($w, [1], {1 => 4}, "inactive watcher");
    checkResult \@result, qw(1:abcde);
    checkWNum $s, 0;
    $w = $s->watch(1 => 6, collector(\@result, 1));
    ok($w->active, "this is still active");
    checkCond($w, [1], {1 => 6}, "active watcher");
    checkResult \@result, qw(1:abcde);
    checkWNum $s, 1;
    $w = $s->watch(1 => 7, collector(\@result, 1));
    ok($w->active, "this is still active");
    checkResult \@result, qw(1:abcde);
    checkWNum $s, 2;
    $w = $s->watch(1 => 3, collector(\@result, 1));
    ok(!$w->active, "fire immediately");
    checkResult \@result, qw(1:abcde 1:abcde);
    checkWNum $s, 2;
    $w = $s->watch(1 => 8, collector(\@result, 1));
    ok($w->active, "still active");
    checkResult \@result, qw(1:abcde 1:abcde);
    checkWNum $s, 3;
    $w = $s->watch(1 => 9, collector(\@result, 1));
    ok($w->active, "still active");
    checkResult \@result, qw(1:abcde 1:abcde);
    checkWNum $s, 4;
    @result = ();
    $rs->set(1 => "666666");
    checkResult \@result, "1:666666";
    checkWNum $s, 3;
    $rs->set(1 => "7777777");
    checkResult \@result, qw(1:666666 1:7777777);
    checkWNum $s, 2;
    $rs->set(1 => "88888888");
    checkResult \@result, qw(1:666666 1:7777777 1:88888888);
    checkWNum $s, 1;
    $rs->set(1 => "999999999");
    checkResult \@result, qw(1:666666 1:7777777 1:88888888 1:999999999);
    checkWNum $s, 0;
    @result = ();
    foreach my $num (10 .. 15) {
        $rs->set(1 => "A" x $num);
        checkResult \@result;
    }
    
    note('--- -- mix one-shot and continuous watchers');
    $rs->set(1 => "");
    @result = ();
    @watchers = ();
    push @watchers, $s->watch(1 => 5, collector(\@result, 0));
    push @watchers, $s->watch(1 => 6, collector(\@result, 1));
    push @watchers, $s->watch(1 => 7, collector(\@result, 0));
    push @watchers, $s->watch(1 => 8, collector(\@result, 1));
    checkResult \@result;
    checkWatchers $s, @watchers;
    @result = ();
    $rs->set(1 => "qqqq");
    checkResult \@result;
    checkWNum $s, 4;
    @result = ();
    $rs->set(1 => "wwwww");
    checkResult \@result, "1:wwwww";
    checkWNum $s, 4;
    @result = ();
    $rs->set(1 => "eeeeee");
    checkResult \@result, qw(1:eeeeee 1:eeeeee);
    checkWNum $s, 3;
    ok(!$watchers[1]->active, "watcher 1 fired and gets inactive.");
    @result = ();
    $rs->set(1 => "rrrrrrr");
    checkResult \@result, qw(1:rrrrrrr 1:rrrrrrr);
    checkWNum $s, 3;
    @result = ();
    $rs->set(1 => "tttttttt");
    checkResult \@result, qw(1:tttttttt 1:tttttttt 1:tttttttt);
    checkWNum $s, 2;
    ok(!$watchers[3]->active, "watcher 3 fired and gets inactive.");
    foreach my $num (9 .. 12) {
        @result = ();
        $rs->set(1 => ("A" x $num));
        checkResult \@result, ('1:' . ("A" x $num)) x 2;
    }
    $_->cancel() foreach @watchers;
    checkWNum $s, 0;
    foreach my $i (1 .. 3) {
        @result = ();
        $rs->set(1 => "PPPPPPPPPPPPPP");
        checkResult \@result;
    }
    
    note('--- -- cancel() some of the watchers');
    $rs->set(1 => "a");
    @watchers = ();
    @result = ();
    push @watchers, $s->watch(1 => $_, collector(\@result, 0)) foreach 1 .. 10;
    checkResult \@result, "1:a";
    checkWatchers $s, @watchers;
    @result = ();
    $_->cancel() foreach @watchers[2, 4, 5, 8]; ## 1 2 4 7 8 10
    checkWatchers $s, @watchers[0, 1, 3, 6, 7, 9];
    $rs->set(1 => "bbbbbb");
    checkResult(\@result, ("1:bbbbbb") x 3);
}

{
    note('--- N-resource, M-watchers');
    my $s = new_ok('Async::Selector');
    my $rs = Async::Selector::Sample::Resources->new($s, 1 .. 5);
    my @result = ();
    my @w = ();
    push @w, $s->watch(1 => 5, 2 => 5, 3 => 5                , collector(\@result, 1));
    push @w, $s->watch(        2 => 4, 3 => 4, 4 => 4        , collector(\@result, 1));
    push @w, $s->watch(1 => 5,                 4 => 5, 5 => 5, collector(\@result, 1));
    push @w, $s->watch(        2 => 0, 3 => 0, 4 => 3, 5 => 5, collector(\@result, 1));
    push @w, $s->watch(1 => 2,                 4 => 5, 5 => 2, collector(\@result, 1));
    push @w, $s->watch(        2 => 4, 3 => 4                , collector(\@result, 1));
    checkCond($w[0], [1,2,3], {1 => 5, 2 => 5, 3 => 5}, "watcher 0");
    checkCond($w[1], [2,3,4], {2 => 4, 3 => 4, 4 => 4}, "watcher 1");
    checkCond($w[2], [1,4,5], {1 => 5, 4 => 5, 5 => 5}, "watcher 2");
    checkCond($w[3], [2,3,4,5], {2 => 0, 3 => 0, 4 => 3, 5 => 5}, "watcher 3");
    checkCond($w[4], [1,4,5], {1 => 2, 4 => 5, 5 => 2}, "watcher 4");
    checkCond($w[5], [2,3], {2 => 4, 3 => 4}, "watcher 5");
    checkResult \@result, qw(2: 3:);
    checkWNum $s, 5;
    @result = ();
    $rs->set(1 => "aa", 5 => "aa");
    checkResult \@result, qw(1:aa 5:aa);
    checkWNum $s, 4;
    @result = ();
    $rs->set(3 => "AAAA", 4 => "AAAA");
    checkResult \@result, qw(3:AAAA 3:AAAA 4:AAAA);
    checkWNum $s, 2;
    @result = ();
    $rs->set(map {$_ => "bbbbbb"} 1 .. 5);
    checkResult \@result, qw(1:bbbbbb 2:bbbbbb 3:bbbbbb 1:bbbbbb 4:bbbbbb 5:bbbbbb);
    checkWNum $s, 0;
    @result = ();
    $rs->set(map {$_ => "cccccccccccc"} 1 .. 5);
    checkResult \@result;
    checkWNum $s, 0;
}

{
    note('--- 2 selectors with same resource names');
    my @s = ();
    my @r = ();
    my @w = ();
    my @results = ([], []);
    foreach my $i (0 .. 1) {
        $s[$i] = Async::Selector->new();
        $r[$i] = Async::Selector::Sample::Resources->new($s[$i], 1..5);
        $w[$i] = $s[$i]->watch(2 => 2, 3 => 3, 4 => 4, 6 => 6, sub {
            my ($w, %res) = @_;
            is($w, $w[$i], "correct watcher");
            push(@{$results[$i]}, map { "${i}_$_:$res{$_}" } sort {$a cmp $b} keys %res);
            $w->cancel();
        });
    }
    ok($_->active, "both active") foreach @w;
    is_deeply(\@results, [[], []], "no results");
    $r[0]->set(1 => "aaaaa");
    $r[1]->set(5 => "eeeee");
    ok($_->active, "both active") foreach @w;
    is_deeply(\@results, [[], []], "still no results");
    $r[0]->set(3 => "cccc", 4 => "dddd");
    $r[1]->set(2 => "b", 4 => "ddd");
    ok(!$w[0]->active, "w0 fired");
    ok($w[1]->active, "w1 still active");
    is_deeply(\@results, [['0_3:cccc', '0_4:dddd'], []]);
    $r[0]->set(2 => "bbbbbbb");
    $r[1]->set(2 => "bbbbbbb");
    ok(!$w[1]->active, "w1 fired");
    is_deeply(\@results, [['0_3:cccc', '0_4:dddd'], ['1_2:bbbbbbb']]);
}

done_testing();