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

use Test2::V0;

use File::Spec;
use File::Temp qw( tempdir );
use JSON qw( decode_json );
use Test2::API qw( intercept );
use Test::Class::Moose::CLI;

{

    package FakeRunner;

    use Moose;

    has args => ( is => 'ro' );

    around BUILDARGS => sub {
        my $orig = shift;
        my $self = shift;

        return { args => $self->$orig(@_) };
    };

    sub runtests { }

    sub test_report { FakeReport->new }
}

{

    package FakeReport;

    use Moose;

    sub timing_data {
        return {
            timing => 'data',
        };
    }
}

{
    my @tests = (
        [   'empty args',
            {},
            {}
        ],
        [   '--classes',
            { classes      => [qw( Foo Bar Baz )] },
            { test_classes => [qw( Foo Bar Baz )] }
        ],
        [   '--tags',
            { tags         => [qw( Big DB )] },
            { include_tags => [qw( Big DB )] },
        ],
        [   '--methods',
            { methods => [qw( foo bar baz )] },
            { include => qr/^(?:foo|bar|baz)$/ }
        ],
        [   '--exclude-methods',
            { 'exclude-methods' => [qw( foo bar baz )] },
            { exclude           => qr/^(?:foo|bar|baz)$/ },
        ],
        [   '--color',
            { color        => undef },
            { color_output => 1 }
        ],
        [   '--no-color',
            { 'no-color'   => undef },
            { color_output => 0 }
        ],
        [   '--no-parallel-progress',
            { 'no-parallel-progress' => undef },
            { show_parallel_progress => 0 }
        ],
    );

    for my $test (@tests) {
        my ( $name, $argv, $expect ) = @{$test};

        subtest $name => sub {
            local @ARGV = _fake_argv($argv);

            my $runner = Test::Class::Moose::CLI->new_with_options(
                runner_class => 'FakeRunner' )->run;
            is( $runner->args,
                $expect,
                'got expected Runner args from CLI options'
            );
        };
    }
}

subtest 'timing data file' => sub {
    my $dir = File::Temp->newdir;
    my $file = File::Spec->catfile( $dir, 'timing.json' );

    my $time = time;
    local @ARGV = ( '--timing-data-file', $file );
    Test::Class::Moose::CLI->new_with_options( runner_class => 'FakeRunner' )
      ->run;

    ok( -f $file,
        'timing data file exists'
    );
    open my $fh, '<', $file or die $!;
    my $data = decode_json(
        do { local $/; <$fh> }
    );
    close $fh or die $!;

    is( $data,
        hash {
            field process_name => $0;
            field start_time =>
              validator( sub { defined $_ && $_ >= $time } );
            field timing => { timing => 'data' };
        },
        'timing data contains expected JSON data'
    );
};

subtest 'classes as paths' => sub {
    local @ARGV = (
        '--classes', 't/lib/TestFor/MyApp/Model.pm',
        '--classes', 't/lib/TestFor/MyApp/Controller.pm'
    );
    my $runner = Test::Class::Moose::CLI->new_with_options(
        runner_class => 'FakeRunner' )->run;
    is( $runner->args->{test_classes},
        [qw( TestFor::MyApp::Model TestFor::MyApp::Controller )],
        '--classes as paths are converted to class names'
    );
};

{

    package Test::CLI;

    use Moose;

    with 'Test::Class::Moose::Role::CLI';

    sub _test_lib_dirs { return ('t/clilib') }
}

subtest 'classes from CLI are loaded' => sub {
    local @ARGV = ( '--classes', 'Foo' );
    intercept { Test::CLI->new_with_options->run };

    no warnings 'once';
    ok( $Foo::LOADED,  'Foo class was loaded' );
    ok( !$Bar::LOADED, 'Bar class was not loaded' );

    local @ARGV = ( '--classes', 't/clilib/Bar.pm' );
    intercept { Test::CLI->new_with_options->run };
    ok( $Bar::LOADED, 'Bar class was loaded' );
};

{

    package My::CLI;

    use Moose;

    with 'Test::Class::Moose::Role::CLI';

    has before_count       => ( is => 'rw' );
    has load_classes_count => ( is => 'rw' );
    has after_count        => ( is => 'rw' );

    sub _munge_class { 'FR::' . $_[1] }

    sub _test_lib_dirs {qw( t/lib t/testlib )}

    sub _load_classes {
        $_[0]->load_classes_count( ( $_[0]->load_classes_count // 0 ) + 1 );
    }

    sub _before_run {
        $_[0]->before_count( ( $_[0]->before_count // 0 ) + 1 );
    }

    sub _after_run { $_[0]->after_count( ( $_[0]->after_count // 0 ) + 1 ) }
}

subtest 'role extension methods' => sub {
    local @ARGV
      = (
        qw( --classes Foo --classes Bar --classes t/lib/Baz.pm --classes t/testlib/Quux.pm )
      );
    my $cli = My::CLI->new_with_options( runner_class => 'FakeRunner' );
    my $runner = $cli->run;
    is( $runner->args->{test_classes},
        [ 'FR::Foo', 'FR::Bar', 'FR::Baz', 'FR::Quux' ],
        'class names were munged and paths were converted to classes'
    );
    is( $cli->before_count,
        1,
        '_before_run method was called once'
    );
    is( $cli->load_classes_count,
        1,
        '_load_classes method was called once'
    );
    is( $cli->after_count,
        1,
        '_after_run method was called once'
    );
};

done_testing();

sub _fake_argv {
    my $args = shift;

    my @argv;
    for my $key ( keys %{$args} ) {
        my $val = $args->{$key};

        my $option = '--' . $key;
        if ( ref $val ) {
            push @argv, map { $option => $_ } @{$val};
        }
        elsif ( defined $val ) {
            push @argv, $option => $val;
        }
        else {
            push @argv, $option;
        }
    }

    return @argv;
}