The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
use strict;
use warnings;

use Test::More;

#use t::tests qw( %runs );

plan tests => 8;

my $CLASS = 'Tree';
use_ok( $CLASS )
    or Test::More->builder->BAILOUT( "Cannot load $CLASS" );

my $tree = $CLASS->new( 'root' );

my @stack;
is( $tree->add_event_handler({
    add_child => sub {
        my ($node, @args) = @_;
        push @stack, "Added @args to $node";
    },
    value => sub {
        my ($node, $old, $new) = @_;
        push @stack, "Value changed: $old -> $new from $node";
    },
}), $tree, "add_event_handler() chains and handles multiple entries" );


my $child = $CLASS->new;
$tree->add_child( $child );

is( $stack[0], "Added $child to $tree", "Event triggered handler" );

my $child2 = $CLASS->new;
$child->add_child( $child2 );
is( $stack[1], "Added $child2 to $child", "Events bubble upwards to the parent" );

$child->add_event_handler({
    remove_child => sub {
        my ($node, @args) = @_;
        push @stack, "Removed @args from $node";
    },
});

$child->remove_child( $child2 );

is( $stack[2], "Removed $child2 from $child", "remove_child event" );

$tree->remove_child( $child );
cmp_ok( @stack, '==', 3, "Events trigger on the actor, not the acted-upon" );

$tree->set_value( 'new value' );

is( $stack[3], "Value changed: root -> new value from $tree", "remove_child event" );

$tree->value();

cmp_ok( @stack, '==', 4, "The value event only triggers when it's set, not accessed" );