#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
#   file: t/DistZillaTester.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/>.
#
#   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

=encoding UTF-8

=head1 NAME

DistZillaTester - TODO

=head1 SYNOPSIS

Use C<DistZillaTester> instead of C<Dist::Zilla::Tester>:

    use DistZillaTester;    # instead of Dist::Zilla::Tester
    use Test::Deep qw{ cmp_deeply };
    use Test::Fatal;
    use Test::More;

    my $tzil = Builder->from_config( … );
    my $exception = exception { $tzil->build(); };
    is( $exception, undef, 'check build status ) or
        diag( join( "\n", $tzil->log_messages ) );
    cmd_deeply( $tzil->log_messages, $expected_messages );

=head1 DESCRIPTION

You may want to write some negative tests to check your plugin reaction on invalid input. However,
this task is a challenge, because trivial approach

    my $exception = exception{ $tzil = Builder->from_config( … ); };
    like( $exception, qr{…} );
    # Ok, <Dist::Zilla> died as expected, let us check the log:
    cmp_deeply( $tzil->log_messages, $expected_messages );  # Oops: $tzil is not defined.

does not work. C<< Builder->from_config( … ) >> dies, no C<Dist::Zilla> object is returned, and so
we do not have access to C<Dist::Zilla> logger and its content. Everything is lost.

This module is a replacement for C<Dist::Zilla::Tester>. If C<from_config> dies, the module catches
the exception and returns a stub builder. Stub builder has two methods: C<build>, which rethrows
exception caught in C<from_config>, and C<log_messages>, which returns log messages accumulated so
far.

=cut

#   Since `Dist::Zilla::Tester` does not meet my needs, let me extend it.
package DistZillaTester;

use Moose;
extends 'Dist::Zilla::Tester';

#   Mimic the `Dist::Zilla::Tester` export.
use Sub::Exporter -setup => {
  exports => [
    Builder => sub { $_[ 0 ]->can( 'builder' ) },
  ],
  groups  => [ default => [ qw{ Builder } ] ],
};

#   Replace `Dist::Zilla::Tester::_Builder` with my one.
sub builder { 'DistZillaTester::_Builder' };

{
    #   My `DistZillaTester::_Builder` extends `Dist::Zilla::Tester::_Builder`.
    package DistZillaTester::_Builder;
    use Moose;
    use namespace::autoclean;
    extends 'Dist::Zilla::Tester' . '::_Builder';
        #   ^Hide `Dist::Zilla::Tester::_Builder` from `AutoPrereqs`. If `…::_Builder` is added to
        #   prerequisities, `cpanm` starts downloading, testing and installing `Dist::Zilla`,
        #   ignoring the fact that `Dist::Zilla` is already installed.
    use Try::Tiny;
    our $Logger;
    around from_config => sub {
        my ( $orig, $self, @args ) = @_;
        local $Logger;      # Localize global variable, just in case.
        my $builder;
        try {
            #   Try to create original `Dist::Zilla::Tester::_Builder` first.
            $builder = $self->$orig( @args );
        } catch {
            #   If creation failed due to exception, create stub object instead.
            $builder = DistZillaTester::_Builder::Stub->new(
                exception => "$_",      # Stub object saves exception
                logger    => $Logger,   # and logger.
            );
        };
        return $builder;
    };
    #   Saving logger of real builder is not trivial. `from_config` is a class method. Before
    #   `$self->$orig()` call the builder does not exist yet, after call the builder does not exist
    #   already. I need to catch the moment when the builder already created but not yet died.
    #   `BUILD` object method is called right after builder creation.
    #   To pass information (logger reference) between object method `BUILD` and class method
    #   `from_config` I have to use global (class) variable.
    sub BUILD {
        my ( $self ) = @_;
        #   Builder's `logger` attribute keeps a reference to `Log::Dispatchouli::Proxy`, while I
        #   need real logger.
        $Logger = $self->logger->logger;
    };
    no Moose;
};

{
    #   This is a stub builder, which substitutes real builder when its creation fails.
    package DistZillaTester::_Builder::Stub;
    use Moose;
    use namespace::autoclean;
    has exception => (              # Stub builder stores exception
        is          => 'ro',
        isa         => 'Str',
        required    => 1,
    );
    has logger => (                 # and logger of the real builder. So I could check messages
        is          => 'ro',        # logged before real builder dies.
        isa         => 'Object',
        required    => 1,
    );
    #   Stub builder mimics real builder. I need only two methods:
    sub log_messages {              #   to have access to the log.
        my ( $self ) = @_;
        return [ map( $_->{ message }, @{ $self->logger->events } ) ];
    };
    sub build {                     #   Attempt to call `build` on stub rethrows
        my ( $self ) = @_;          #   caused real builder die.
        my $exception = $self->exception;
        chomp( $exception );
        die "Dist::Zilla died in construction: $exception\n";
    };
}

no Moose;

__PACKAGE__->meta->make_immutable;

1;

# end of file #
