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

CPANPLUS-YACSmoke documentation Contained in the CPANPLUS-YACSmoke distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

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

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

  cpanp> s save

DESCRIPTION

Top

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

It will create a database file in the .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 prereqs have been tested previously and have resulted in a pass grade then the tests for those prereqs will be skipped, speeding up smoke testing.

By default it uses CPANPLUS configuration settings.

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

Its main utility is in conjunction with CPANPLUS::YACSmoke.

CONFIGURATION FILE

Top

CPANPLUS::Dist::YACSmoke only honours the exclude_dists in CPAN::YACSmoke style ini files.

The 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 Config::IniFiles for more information on the INI file format.

METHODS OVERIDDEN

Top

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

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 ini file if that hasn't been loaded already. It also registers callbacks with the CPANPLUS backend.

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 Makefile.PL or Build.PL.

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

create

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

If $dist->status->_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 blib structure to the include path.

AUTHOR

Top

Chris BinGOs Williams <chris@bingosnet.co.uk>

Based on CPAN::YACSmoke by Robert Rothenberg and Barbie.

Contributions and patience from Jos Boumans the CPANPLUS guy!

LICENSE

Top

Copyright (c) Chris Williams, Jos Boumans, Robert Rothenberg and Barbie.

This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.

SEE ALSO

Top

CPANPLUS

CPANPLUS::YACSmoke

CPAN::YACSmoke

CPANPLUS-YACSmoke documentation Contained in the CPANPLUS-YACSmoke distribution. 
package CPANPLUS::Dist::YACSmoke;

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 vars qw($VERSION);

$VERSION = '0.64';

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 %throw_away;

  sub _is_excluded_dist {
    return unless $exclude_dists;
    my $dist = shift || return;
    return 1 if $dist =~ $exclude_dists->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 );
       }
    }

    # munge test report
    $cb->_register_callback(
        name => 'munge_test_report',
        code => sub {
		  my $mod    = shift;
		  my $report = shift || "";
		  my $grade  = shift;
		  SWITCH: {
		    if ( $grade ne GRADE_PASS and $report =~ /Will not install prerequisite /s ) {
			      $throw_away{ $mod->package_name . '-' . $mod->package_version } = 'toss';
			      last SWITCH;
		    }
        if ( $grade eq GRADE_PASS ) {
		        my $buffer  = CPANPLUS::Error->stack_as_string;
            my $last = ( split /MAKE TEST passed/, $buffer )[-1];
            $report .= join('', 'MAKE TEST passed', $last, "\n");
			      last SWITCH;
        }
		    if ( $grade ne GRADE_PASS and $report =~ /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 $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";
		  }
		  $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;
		  }

		  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};
    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_/
    LANG
    LANGUAGE
    PATH
    SHELL
    COMSPEC
    TERM
    AUTOMATED_TESTING
    AUTHOR_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;
}

}

1;
__END__