#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
#   file: t/PluginTester.pm
#
#   Copyright © 2015 Van de Bugger
#
#   This file is part of perl-Dist-Zilla-Role-TextTemplater.
#
#   perl-Dist-Zilla-Role-TextTemplater is free software: you can redistribute it and/or modify it
#   under the terms of the GNU General Public License as published by the Free Software Foundation,
#   either version 3 of the License, or (at your option) any later version.
#
#   perl-Dist-Zilla-Role-TextTemplater is distributed in the hope that it will be useful, but
#   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
#   PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License along with
#   perl-Dist-Zilla-Role-TextTemplater. If not, see <http://www.gnu.org/licenses/>.
#
#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

# TODO: Documentation.

package PluginTester;

#   The test is written using `Moose`-based `Test::Routine`. It is not big deal, because we are
#   testing plugin for `Dist::Zilla`, and `Dist-Zilla` is also `Moose`-based.

use autodie ':all';
use namespace::autoclean;

use Test::Routine;

use File::Temp qw{ tempdir };
use Test::Deep qw{ cmp_deeply };
use Test::DZil qw{ dist_ini };
use Test::Fatal;
use Test::More;
use DistZillaTester;

# `AutoPrereqs` fails to detect these dependencies:
use Software::License::GPL_3::or_later ();      # Used by `dist.ini`.

# --------------------------------------------------------------------------------------------------

=attr plugin

Name of plugin we are going to test.

Currently used solely to build C<msg_prefix>.

=cut

has plugin => (
    is          => 'ro',
    isa         => 'Maybe[Str]',
    builder     => 'build_plugin',
);

sub build_plugin {
    my ( $self ) = @_;
    return undef;
};

# --------------------------------------------------------------------------------------------------

=attr ini_head

F<dist.ini> header (options before the first plugin).

=cut

has ini_head => (
    is          => 'ro',
    isa         => 'HashRef',
    required    => 1,
    lazy        => 1,
    builder     => 'build_ini_head',
);

sub build_ini_head {
    my ( $self ) = @_;
    return {
        name                => 'Dummy',
        version             => '0.001',
        author              => 'John Doe',
        license             => 'GPL_3::or_later',
        copyright_holder    => 'John Doe',
        copyright_year      => '2007',
    };
};

# --------------------------------------------------------------------------------------------------

=attr ini_body

Content of F<dist.ini> file (starting from the first plugin), in form acceptable by C<<
Builder->from_config >>.

=cut

has ini_body => (
    is          => 'ro',
    isa         => 'ArrayRef',
    required    => 1,
    lazy        => 1,
    builder     => 'build_ini_body',
);

sub build_ini_body {
    my ( $self ) = @_;
    return [];
};

# --------------------------------------------------------------------------------------------------

=attr tzil

Test C<Dist::Zilla> instance.

=cut

has tzil => (
    is          => 'ro',
    isa         => 'Object',
    required    => 1,
    lazy        => 1,
    builder     => 'build_tzil',
    init_arg    => undef,
    handles     => [ 'log_messages' ],
);

sub build_tzil {
    my ( $self ) = @_;
    return Builder->from_config(
        { dist_root => tempdir( CLEANUP => 1 ) },
        {
            add_files => {
                'source/lib/Dummy.pm' =>
                    "package Dummy;\n" .
                    "\n" .                  # Blank line for `PkgVersion`.
                    "# ABSTRACT: Dummy\n" .
                    "# VERSION\n" .
                    "1;\n",
                'source/dist.ini' => dist_ini(
                    $self->ini_head,
                    @{ $self->ini_body },
                ),
            },
        },
    );
};

# --------------------------------------------------------------------------------------------------

=attr exception

An exception occurred during C<Dist::Zilla> creation or building the distro.

=cut

has exception => (
    is          => 'ro',
    isa         => 'Str',
    writer      => '_set_exception',
    init_arg    => undef,
);

# --------------------------------------------------------------------------------------------------

=attr exp_exception

Exception expected from C<Dist::Zilla>. If not specified or undef, build is expected to complete
successfully.

=cut

has exp_exception => (
    is          => 'ro',
);

# --------------------------------------------------------------------------------------------------

=attr exp_messages

Expected log messages from <Dist::Zilla>.

Note: actual messages are grepped and mapped before comparison.

=cut

has exp_messages => (
    is          => 'ro',
    isa         => 'ArrayRef',
);

# --------------------------------------------------------------------------------------------------

=attr msg_prefix

Prefix printed in the beginning of each log message coming from the template. By default, C<plugin>
in brackets. Prefix is used to build default message grepper and mapper.

=cut

has msg_prefix => (
    is          => 'ro',
    isa         => 'Maybe[RegexpRef]',  # `Maybe` is a must, otherwise builder cannot return undef.
    lazy        => 1,
    builder     => 'build_msg_prefix',
);

sub build_msg_prefix {
    my ( $self ) = @_;
    return $self->plugin ? qr{^\[@{ [ $self->plugin ] }\] } : undef;
};

# --------------------------------------------------------------------------------------------------

=attr msg_grepper

Messages grepper. Actual messages are grepped (and mapped) before comparing them with expected
messages. Default grepper passes only messages match to C<msg_prefix> (i. e. messages coming from
the plugin we test), and filters out other messges.

=cut

has msg_grepper => (
    is          => 'ro',
    isa         => 'Maybe[CodeRef]',    # `Maybe` is a must, otherwise builder cannot return undef.
    lazy        => 1,
    builder     => 'build_msg_grepper',
);

sub build_msg_grepper {
    my ( $self ) = @_;
    return $self->msg_prefix ? sub { $_ =~ $self->msg_prefix } : undef;
};

# --------------------------------------------------------------------------------------------------

=attr msg_grepper

Message mapper. Actual messages are (grepped and) mapped before comparing them with expected
messages. Default mapper strips C<msg_prefix> from messages.

=cut

has msg_mapper => (
    is          => 'ro',
    isa         => 'Maybe[CodeRef]',    # `Maybe` is a must, otherwise builder cannot return undef.
    lazy        => 1,
    builder     => 'build_msg_mapper',
);

sub build_msg_mapper {
    my ( $self ) = @_;
    return $self->msg_prefix ? sub { $_ =~ s{@{ [ $self->msg_prefix ] }}{}; $_; } : undef;
};

# --------------------------------------------------------------------------------------------------

=test check build exception

The test creates C<Dist::Zilla> builder and builds the distro, then check exception.

=cut

test 'check build exception' => sub {
    my ( $self ) = @_;
    plan 'no_plan';
        # Some check may be run inside `$self->tzil->build()`, I do not know how many.
    my $exception = exception { $self->tzil->build(); };
    if ( $exception ) {
        chomp( $exception );
        $self->_set_exception( $exception );
    };
    if ( $self->exp_exception ) {
        note( "Expected exception: " . $self->exp_exception );
        cmp_deeply( $self->exception, $self->exp_exception, 'build must fail' )
            or $self->anno();
    } else {
        is( $self->exception, undef, 'build must pass' )
            or $self->anno();
    };
};

# --------------------------------------------------------------------------------------------------

=test check build messages

The test should run after C<check_build_exception>. The test check that (grepped and mapped) actual
build log contains only expected messages.

=cut

test 'check build messages' => sub {
    my ( $self ) = @_;
    if ( not $self->exp_messages ) {
        plan skip_all => 'expected messages not specified';
    };
    plan tests => 1;
    my @all     = @{ $self->log_messages };
    my @grepped = $self->msg_grepper ? grep( { $self->msg_grepper->() } @all     ) : @all;
    my @mapped  = $self->msg_mapper  ? map(  { $self->msg_mapper->()  } @grepped ) : @grepped;
    cmp_deeply( \@mapped, $self->exp_messages, 'dzil messages' )
        or $self->anno();
};

# TODO

sub _text {
    my ( $heading, @lines ) = @_;
    my $width = length( @lines + 0 );
    my $n = 0;
    for my $line ( @lines ) {
        ++ $n;
        $line = sprintf( "    %*d: %s", $width, $n, $line );
    };
    my $text = join( "\n", sprintf( '%s (%d lines):', $heading, @lines + 0 ), @lines );
    return $text;
};

sub anno {
    my ( $self ) = @_;
    my $log   = $self->log_messages;
    diag( _text( "Messages", @$log ) );
    if ( $self->has_exception ) {
        my $ex = $self->exception;
        diag( "Exception: $ex" );
    };
};

1;

# end of file #
