package CPANPLUS::Dist::YACSmoke;
$CPANPLUS::Dist::YACSmoke::VERSION = '1.08';
# Dist::Zilla: +PodWeaver
#ABSTRACT: CPANPLUS distribution class that integrates CPAN Testing services into CPANPLUS

use strict;
use warnings;

use base qw(CPANPLUS::Dist::Base);

use Carp;
use CPANPLUS::Internals::Utils;
use CPANPLUS::Internals::Constants;
use CPANPLUS::Internals::Constants::Report;
use CPANPLUS::Error;
use Params::Check qw[check];
use POSIX qw( O_CREAT O_RDWR );         # for SDBM_File
use version;
use SDBM_File;
use File::Spec::Functions;
use CPANPLUS::YACSmoke::ReAssemble;
use CPANPLUS::YACSmoke::IniFiles;

use constant DATABASE_FILE => 'cpansmoke.dat';
use constant CONFIG_FILE   => 'cpansmoke.ini';

{

$ENV{AUTOMATED_TESTING} = 1;
$ENV{PERL_MM_USE_DEFAULT} = 1; # despite verbose setting

my %Checked;
my $TiedObj;
my $exclude_dists;
my $exclude_auths;
my %throw_away;

  sub _is_excluded_dist {
    return unless $exclude_dists;
    my $dist = shift || return;
    return 1 if $dist =~ $exclude_dists->re();
  }

  sub _is_excluded_auth {
    return unless $exclude_auths;
    my $auth = shift || return;
    return 1 if $auth =~ $exclude_auths->re();
  }

  sub init {
    my $self = shift;
    my $mod  = $self->parent;
    my $cb   = $mod->parent;

    $self->status->mk_accessors(qw(_prepare _create _prereqs _skipbuild));

    my $conf = $cb->configure_object;

    if ( $conf->get_conf( 'prefer_makefile' ) ) {
        msg(qq{CPANPLUS is prefering Makefile.PL});
    }
    else {
        msg(qq{CPANPLUS is prefering Build.PL});
    }

    return 1 if $TiedObj;

    my $filename = catfile( $conf->get_conf('base'), DATABASE_FILE );
    msg(qq{Loading YACSmoke database "$filename"});
    $TiedObj = tie( %Checked, 'SDBM_File', $filename, O_CREAT|O_RDWR, 0644 )
	or error(qq{Failed to open "$filename": $!});

    my $config_file = catfile( $conf->get_conf('base'), CONFIG_FILE );
    if ( -r $config_file ) {
     my $cfg = CPANPLUS::YACSmoke::IniFiles->new(-file => $config_file);
     {
       my @list = $cfg->val( 'CONFIG', 'exclude_dists' );
       if ( @list ) {
          $exclude_dists = CPANPLUS::YACSmoke::ReAssemble->new();
          $exclude_dists->add( @list );
       }
     }
     {
       my @list = $cfg->val( 'CONFIG', 'exclude_auths' );
       if ( @list ) {
          $exclude_auths = CPANPLUS::YACSmoke::ReAssemble->new();
          $exclude_auths->add( @list );
       }
     }
    }

    # munge test report
    $cb->_register_callback(
        name => 'munge_test_report',
        code => sub {
		  my $mod    = shift;
		  my $report = shift || "";
		  my $grade  = shift;
      my $stack = CPANPLUS::Error->stack_as_string;
      my $cnf   = $mod->parent->configure_object;

		  SWITCH: {
        my $sv = version->new($CPANPLUS::Internals::VERSION) > version->new('0.9116');
        my $installer = $mod->status->installer_type;
        if ( $sv and $installer eq 'CPANPLUS::Dist::Build' ) {
          require CPANPLUS::Dist::Build;
          $sv = version->new($CPANPLUS::Dist::Build::VERSION) > version->new('0.60');
        }

		    if ( $grade ne GRADE_PASS and $stack =~ /Will not install prerequisite /s ) {
			      $throw_away{ $mod->package_name . '-' . $mod->package_version } = 'toss';
			      last SWITCH;
		    }
        if ( $grade ne GRADE_PASS and $stack =~ /You may have to resolve this dependency manually\./s ) {
            $throw_away{ $mod->package_name . '-' . $mod->package_version } = 'toss';
            last SWITCH;
        }
        if ( !$sv and $grade eq GRADE_PASS ) {
            my $last = ( split /MAKE TEST passed/, $stack )[-1];
            $report .= join('', 'MAKE TEST passed', $last, "\n\n");
            ### add a list of what modules have been loaded of your prereqs list
            $report .= REPORT_LOADED_PREREQS->($mod);
            ### add a list of versions of toolchain modules
            $report .= REPORT_TOOLCHAIN_VERSIONS->($mod);
            $report .= REPORT_MESSAGE_FOOTER->();
			      last SWITCH;
        }
		    if ( $grade ne GRADE_PASS and $stack =~ /No \'Makefile.PL\' found - attempting to generate one/s ) {
			      $throw_away{ $mod->package_name . '-' . $mod->package_version } = 'toss';
		    }
		  }

		  $report =~ s/\[MSG\].*may need to build a \'CPANPLUS::Dist::YACSmoke\' package for it as well.*?\n//sg;
      $report =~ s/\[MSG\] \[[\w: ]+\] Extracted '\S*?'\n//sg;
		  $report .=
			"\nThis report was machine-generated by CPANPLUS::Dist::YACSmoke $CPANPLUS::Dist::YACSmoke::VERSION.\n";
		  if ( $ENV{PERL5_MINIYACSMOKER} ) {
			$report .= "Powered by miniyacsmoker version " . $ENV{PERL5_MINIYACSMOKER} . "\n";
		  }
		  if ( $ENV{PERL5_MINISMOKEBOX} ) {
			$report .= "Powered by minismokebox version " . $ENV{PERL5_MINISMOKEBOX} . "\n";
		  }
      if ( $cnf->get_conf( 'prefer_makefile' ) ) {
        $report .= qq{\nCPANPLUS is prefering Makefile.PL\n};
      }
      else {
        $report .= qq{\nCPANPLUS is prefering Build.PL\n};
      }
		  $report .= _gen_report();
		  return $report;
        },
    );

    $cb->_register_callback(
      name => 'install_prerequisite',
      code => sub {
		my $mod   = shift;
		my $root = $mod->package_name .'-'. $mod->package_version;

		unless ($TiedObj) {
		  croak "Not connected to database!";
		}

		while (my $arg = shift) {
		  my $package = $arg->package_name .'-'. $arg->package_version;

		  # BUG: Exclusion does not seem to work for prereqs.
		  # Sometimes it seems that the install_prerequisite
		  # callback is not even called! Need to investigate.

		  if ( _is_excluded_dist($package) ) { # prereq on excluded list
			msg("Prereq $package is excluded");
			return;
		  }
		  if ( _is_excluded_auth($arg->author->cpanid) ) { # author is on excluded list
			msg("Author (" . $arg->author->cpanid . ") of prereq $package is excluded");
			return;
		  }

		  my $checked = $Checked{$package};
		  if (defined $checked &&
			  #$checked =~ /aborted|fail|na/ ) {
			  $checked =~ /fail|na/ ) {

			  msg("Known uninstallable prereqs $package - aborting install\n");
			  $Checked{$root} = "aborted";
			  return;
		  }
		}
		return 1;
      },
    );

    $cb->_register_callback(
      name => 'send_test_report',
      code => sub {

		unless ($TiedObj) {
		  exit error("Not connected to database!");
		}
		my $mod   = shift;
		my $grade = lc shift;
		my $package = $mod->package_name .'-'. $mod->package_version;
		my $checked = $Checked{$package};

		# Did we want to throw away this report?
		my $throw = delete $throw_away{ $package };
		return if $throw;

          # Simplified algorithm for reporting:
          # * don't send a report if
          #   - we get the same results as the last report sent
          #   - it passed the last test but not now
          #   - it didn't pass the last test or now

		return if (defined $checked && (
                    ($checked eq $grade)                     ||
		    ($checked ne 'pass' && $grade ne 'pass')));

		  $Checked{$package} = $grade;

		return 1;
      },
    );

    $cb->_register_callback(
      name => 'edit_test_report',
      code => sub { return; },
    );


    return 1;
  }

  sub create {
    my $self = shift;
    my $mod  = $self->parent;
    my $dist_cpan = $mod->status->dist_cpan;

    if ( $dist_cpan->status->created ) {
       my %hash = @_;
       my $conf = $mod->parent->configure_object;
       my $args;
       my($force,$verbose,$prereq_target,$prereq_format, $prereq_build);
       {   local $Params::Check::ALLOW_UNKNOWN = 1;
          my $tmpl = {
            force           => {    default => $conf->get_conf('force'),
                                    store   => \$force },
            verbose         => {    default => $conf->get_conf('verbose'),
                                    store   => \$verbose },
            prereq_target   => {    default => '', store => \$prereq_target },
            prereq_format   => {    #default => $self->status->installer_type,
                                    default => '',
                                    store   => \$prereq_format },
            prereq_build    => {    default => 0, store => \$prereq_build },
          };
          $args = check( $tmpl, \%hash ) or return;
       }
       return 0 unless
	                  $self->_resolve_prereqs(
                        force           => $force,
                        format          => $prereq_format,
                        verbose         => $verbose,
                        prereqs         => $mod->status->prereqs,
                        target          => $prereq_target,
                        prereq_build    => $prereq_build,
                    );
       $mod->add_to_includepath();
       return 1;
    }

    my $package = $mod->package_name .'-'. $mod->package_version;
    msg(qq{Checking for previous PASS result for "$package"});
    my $checked = $Checked{$package};
    {
      # Don't propagate 'skiptest'
      my %args = @_;
      delete $args{skiptest};
      @_ = %args;
    }
    if ( $checked and $checked eq 'pass' ) {
       msg(qq{Found previous PASS result for "$package" skipping tests.});
       push @_, skiptest => 1;
    }
    $self->SUPER::create( @_ );
  }

sub _env_report {
  my @env_vars= qw(
    /PERL/
    /LC_/
    /HARNESS/
    CFLAGS
    LDFLAGS
    LANG
    LANGUAGE
    PATH
    SHELL
    COMSPEC
    TERM
    AUTOMATED_TESTING
    NONINTERACTIVE_TESTING
    AUTHOR_TESTING
    RELEASE_TESTING
    INCLUDE
    LIB
    LD_LIBRARY_PATH
    PROCESSOR_IDENTIFIER
    NUMBER_OF_PROCESSORS
  );
    my @vars_found;
    for my $var ( @env_vars ) {
        if ( $var =~ m{^/(.+)/$} ) {
            push @vars_found, grep { /$1/ } keys %ENV;
        }
        else {
            push @vars_found, $var if exists $ENV{$var};
        }
    }

    my $report = "";
    for my $var ( sort @vars_found ) {
        $report .= "    $var = $ENV{$var}\n" if defined $ENV{$var};
    }
    return $report;
}

sub _special_vars_report {
    my $special_vars = << "HERE";
    Perl: \$^X = $^X
    UID:  \$<  = $<
    EUID: \$>  = $>
    GID:  \$(  = $(
    EGID: \$)  = $)
HERE
    if ( $^O eq 'MSWin32' && eval "require Win32" ) {
        my @getosversion = Win32::GetOSVersion();
        my $getosversion = join(", ", @getosversion);
        $special_vars .= "    Win32::GetOSName = " . Win32::GetOSName() . "\n";
        $special_vars .= "    Win32::GetOSVersion = $getosversion\n";
        $special_vars .= "    Win32::IsAdminUser = " . Win32::IsAdminUser() . "\n";
    }
    return $special_vars;
}

sub _gen_report {
  my $env_vars = _env_report;
  my $special_vars = _special_vars_report();
  my $return = << "ADDREPORT";

------------------------------
ENVIRONMENT AND OTHER CONTEXT
------------------------------

Environment variables:

$env_vars
Perl special variables (and OS-specific diagnostics, for MSWin32):

$special_vars

-------------------------------

ADDREPORT

  return $return;
}

}

'Yakkity Yac';

__END__

=pod

=encoding UTF-8

=head1 NAME

CPANPLUS::Dist::YACSmoke - CPANPLUS distribution class that integrates CPAN Testing services into CPANPLUS

=head1 VERSION

version 1.08

=head1 SYNOPSIS

  # CPANPLUS shell - use CPANPLUS::Dist::YACSmoke services during manual use.

  cpanp> s conf dist_type CPANPLUS::Dist::YACSmoke

  cpanp> s save

=head1 DESCRIPTION

CPANPLUS::Dist::YACSmoke is a L<CPANPLUS> distribution class that integrates a number of CPAN Testing services
into L<CPANPLUS>.

It will create a database file in the F<.cpanplus> directory, which it
uses to track tested distributions.  This information will be used to
keep from posting multiple reports for the same module, and to keep
from testing modules that use non-passing modules as prerequisites.

If C<prereqs> have been tested previously and have resulted in a C<pass> grade then the tests for those
C<prereqs> will be skipped, speeding up smoke testing.

By default it uses L<CPANPLUS> configuration settings.

It can be utilised during manual use of L<CPANPLUS> by setting the C<dist_type> configuration variable.

Its main utility is in conjunction with L<CPANPLUS::YACSmoke>.

=head1 CONFIGURATION FILE

CPANPLUS::Dist::YACSmoke only honours the C<exclude_dists> in L<CPAN::YACSmoke> style C<ini> files.

The C<exclude_dists> setting, which is laid out as:

  [CONFIG]
  exclude_dists=<<HERE
  mod_perl
  HERE

The above would then ignore any distribution that include the string
'mod_perl' in its name. This is useful for distributions which use
external C libraries, which are not installed, or for which testing
is problematic.

See L<Config::IniFiles> for more information on the INI file format.

=head1 METHODS OVERIDDEN

CPANPLUS::Dist::YACSmoke overrides a number of methods provided by L<CPANPLUS::Dist::Base>

=over

=item C<init>

This method is called just after the new dist object is set up. It initialises the database file if it hasn't been initialised already
and loads the list of excluded distributions from the C<ini> file if that hasn't been loaded already. It also registers callbacks with
the L<CPANPLUS> backend.

=item C<prepare>

This runs the preparation step of your distribution. This step is meant to set up the environment so the create step can create the actual distribution(file).
This can mean running either C<Makefile.PL> or C<Build.PL>.

CPANPLUS::Dist::YACSmoke will check for the existence of a C<.yacsmoke.yml> in the extracted build directory. If it exists it will
load the meta data that it contains and sets C<$dist-E<gt>status-E<gt>_skipbuild> to true.

=item C<create>

This runs the creation step of your distribution, by running C<make> and C<make test> for instance. The distribution is checked against
the database to see if a C<pass> grade has already been reported for this distribution, if so then C<skiptest> is set and the testsuite
will not be run.

If C<$dist-E<gt>status-E<gt>_skipbuild> is set to true, CPANPLUS::Dist::YACSmoke will skip the build and test stages completely and resolve
any prereqs for the distribution before adding the build directories C<blib> structure to the include path.

=back

=head1 KUDOS

Based on L<CPAN::YACSmoke> by Robert Rothenberg and Barbie.

Contributions and patience from Jos Boumans the L<CPANPLUS> guy!

=head1 SEE ALSO

L<CPANPLUS>

L<CPANPLUS::YACSmoke>

L<CPAN::YACSmoke>

=head1 AUTHOR

Chris Williams <chris@bingosnet.co.uk>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2019 by Chris Williams, Jos Boumans, Robert Rothenberg and Barbie.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut