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 tests => 5;
use Sub::Install qw(install_sub);

use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../lib";
use lib File::Basename::dirname(__FILE__)."/../..";
use UR;

subtest 'setup test' => sub {
    plan tests => 3;

    UR::Object::Type->define(
        class_name => 'SomeModule',
    );
    ok(SomeModule->__meta__, 'defined SomeModule');

    install_sub({
        into => 'SomeModule',
        as => 'do_something',
        code => sub {
            my $self = shift;
            $self->debug_message('do_something');
        },
    });

    for my $base_class ('Command::V1', 'Command::V2') {
        my $class_name = 'Some' . $base_class;

        UR::Object::Type->define(
            class_name => $class_name,
            is => $base_class,
        );
        ok($class_name->__meta__, "defined $class_name");

        install_sub({
            into => $class_name,
            as => '_execute_body',
            code => sub {
                my $self = shift;
                $self->debug_message('execute');
                my $sm = SomeModule->create();
                $sm->do_something();
            },
        });

        install_sub({
            into => $class_name,
            as => 'debug',
            code => sub {
                my $self = shift;
                my $debug = $self->super_can('debug');
                if ($self->$debug) {
                    return IO::File->new('/dev/null', 'w');
                } else {
                    return 0;
                }
            },
        });
    }
};

my $command_test_count = 6;
my $command_test = sub {
    my $class = shift;
    my $debug = shift;

    my ($dump_debug_messages, $debug_message) = setup_subtest($class);

    is($dump_debug_messages->{'SomeModule'}, 0,
        'dump_debug_messages disabled on SomeModule');
    is($dump_debug_messages->{$class}, 0,
        "dump_debug_messages disabled on $class");

    $class->_execute_delegate_class_with_params($class, {debug => $debug});

    is($debug_message->{'SomeModule'}, 1, 'debug_message fired on SomeModule');
    is($debug_message->{$class}, 1, "debug_message fired on $class");

    my $status = $debug ? 'enabled' : 'disabled';
    ok(!!$dump_debug_messages->{'SomeModule'} == !!$debug,
        "dump_debug_messages $status on SomeModule");
    ok(!!$dump_debug_messages->{$class} == !!$debug,
        "dump_debug_messages $status on $class");
};

subtest 'Command::V1 with --debug' => sub {
    plan tests => $command_test_count;
    $command_test->('SomeCommand::V1', 1);
};
subtest 'Command::V1 without --debug' => sub {
    plan tests => $command_test_count;
    $command_test->('SomeCommand::V1', 0);
};
subtest 'Command::V2 with --debug' => sub {
    plan tests => $command_test_count;
    $command_test->('SomeCommand::V2', 1);
};
subtest 'Command::V2 without --debug' => sub {
    plan tests => $command_test_count;
    $command_test->('SomeCommand::V2', 0);
};

sub setup_subtest {
    my $cmd_class = shift;

    UR::ModuleBase->dump_debug_messages(0);
    $cmd_class->dump_debug_messages(0);

    my %dump_debug_messages = (
        'SomeModule' => SomeModule->dump_debug_messages,
        $cmd_class => $cmd_class->dump_debug_messages,
    );
    my %debug_message = (
        'SomeModule' => 0,
        $cmd_class => 0,
    );
    my $callback = sub {
        my ($self, $type, $message) = @_;
        my $class = $self->class;
        $dump_debug_messages{$class} = $self->dump_debug_messages;
        $debug_message{$class} = 1;
    };

    SomeModule->add_observer(
        aspect => 'debug_message',
        callback => $callback,
    );

    $cmd_class->add_observer(
        aspect => 'debug_message',
        callback => $callback,
    );

    return (\%dump_debug_messages, \%debug_message);
}