### enable test reporting
$cb->configure_object->set_conf( cpantest => 1 );
-
+
### set custom mx host, shouldn't normally be needed
$cb->configure_object->set_conf( cpantest_mx => 'smtp.example.com' );
This function queries the CPAN testers database at
I<http://testers.cpan.org/> for test results of specified module objects,
-module names or distributions.
+module names or distributions.
The optional argument C<all_versions> controls whether all versions of
a given distribution should be grabbed. It defaults to false
my $res = do {
my $tempdir = File::Temp::tempdir();
my $where = $ff->fetch( to => $tempdir );
-
+
unless( $where ) {
error( loc( "Fetching report for '%1' failed: %2",
$url, $ff->error ) );
}
my $fh = OPEN_FILE->( $where );
-
+
do { local $/; <$fh> };
};
my @rv;
for my $href ( @$aref ) {
- next unless $all or defined $href->{'distversion'} &&
+ next unless $all or defined $href->{'distversion'} &&
$href->{'distversion'} eq $dist;
$href->{'details'} = $details;
-
+
### backwards compatibility :(
$href->{'dist'} ||= $href->{'distversion'};
$href->{'grade'} ||= $href->{'action'} || $href->{'status'};
}
### check arguments ###
- my ($buffer, $failed, $mod, $verbose, $force, $address, $save,
+ my ($buffer, $failed, $mod, $verbose, $force, $address, $save,
$tests_skipped );
my $tmpl = {
module => { required => 1, store => \$mod, allow => IS_MODOBJ },
store => \$verbose },
force => { default => $conf->get_conf('force'),
store => \$force },
- tests_skipped
+ tests_skipped
=> { default => 0, store => \$tests_skipped },
};
my $grade;
### check if this is a platform specific module ###
- ### if we failed the test, there may be reasons why
+ ### if we failed the test, there may be reasons why
### an 'NA' might have to be instead
GRADE: { if ( $failed ) {
-
+
### XXX duplicated logic between this block
### and REPORTED_LOADED_PREREQS :(
-
+
### figure out if the prereqs are on CPAN at all
### -- if not, send NA grade
### Also, if our version of prereqs is too low,
### -- send NA grade.
- ### This is to address bug: #25327: do not count
+ ### This is to address bug: #25327: do not count
### as FAIL modules where prereqs are not filled
{ my $prq = $mod->status->prereqs || {};
-
+
PREREQ: while( my($prq_name,$prq_ver) = each %$prq ) {
# 'perl' listed as prereq
$grade = GRADE_NA;
last GRADE;
}
+ next PREREQ;
}
my $obj = $cb->module_tree( $prq_name );
- my $sub = CPANPLUS::Module->can(
+ my $sub = CPANPLUS::Module->can(
'module_is_supplied_with_perl_core' );
-
+
### if we can't find the module and it's not supplied with core.
### this addresses: #32064: NA reports generated for failing
### tests where core prereqs are specified
### http://rt.cpan.org/Ticket/Display.html?id=32155
if( !$obj and !defined $sub->( $prq_name ) ) {
msg(loc( "Prerequisite '%1' for '%2' could not be obtained".
- " from CPAN -- sending N/A grade",
+ " from CPAN -- sending N/A grade",
$prq_name, $name ), $verbose );
$grade = GRADE_NA;
my $vcore = $sub->( $prq_name );
if ( $cb->_vcmp( $prq_ver, $vcore ) > 0 ) {
msg(loc( "Version of core module '%1' ('%2') is too low for ".
- "'%3' (needs '%4') -- sending N/A grade",
- $prq_name, $vcore,
+ "'%3' (needs '%4') -- sending N/A grade",
+ $prq_name, $vcore,
$name, $prq_ver ), $verbose );
-
+
$grade = GRADE_NA;
last GRADE;
}
if( $obj and $cb->_vcmp( $prq_ver, $obj->installed_version ) > 0 ) {
msg(loc( "Installed version of '%1' ('%2') is too low for ".
- "'%3' (needs '%4') -- sending N/A grade",
- $prq_name, $obj->installed_version,
+ "'%3' (needs '%4') -- sending N/A grade",
+ $prq_name, $obj->installed_version,
$name, $prq_ver ), $verbose );
-
+
$grade = GRADE_NA;
last GRADE;
- }
+ }
}
}
-
+
unless( RELEVANT_TEST_RESULT->($mod) ) {
msg(loc(
"'%1' is a platform specific module, and the test results on".
" your platform are not relevant --sending N/A grade.",
$name), $verbose);
-
+
$grade = GRADE_NA;
-
+
} elsif ( UNSUPPORTED_OS->( $buffer ) ) {
msg(loc(
"'%1' is a platform specific module, and the test results on".
" your platform are not relevant --sending N/A grade.",
$name), $verbose);
-
+
$grade = GRADE_NA;
-
- ### you dont have a high enough perl version?
+
+ ### you dont have a high enough perl version?
} elsif ( PERL_VERSION_TOO_LOW->( $buffer ) ) {
msg(loc("'%1' requires a higher version of perl than your current ".
"version -- sending N/A grade.", $name), $verbose);
} elsif ( $tests_skipped ) {
$message .= REPORT_TESTS_SKIPPED->();
} elsif( $grade eq GRADE_NA) {
-
+
### the bit where we inform what went wrong
$message .= REPORT_MESSAGE_FAIL_HEADER->( $stage, $buffer );
### reporter object ###
my $reporter = do {
my $args = $conf->get_conf('cpantest_reporter_args') || {};
-
+
unless( UNIVERSAL::isa( $args, 'HASH' ) ) {
error(loc("'%1' must be a hashref, ignoring...",
'cpantest_reporter_args'));
$args = {};
}
-
+
Test::Reporter->new(
grade => $grade,
distribution => $dist,
%$args,
);
};
-
+
### set a custom mx, if requested
- $reporter->mx( [ $conf->get_conf('cpantest_mx') ] )
+ $reporter->mx( [ $conf->get_conf('cpantest_mx') ] )
if $conf->get_conf('cpantest_mx');
### set the from address ###
### XXX should we do an 'already sent' check? ###
### something broke :( ###
- }
+ }
else {
my $status;
- eval {
+ eval {
$status = $reporter->send();
};
if ( $@ ) {
check( $tmpl, \%hash ) or return;
-
+
my %missing = map {$_ => 1} @$missing;
my $conf = $self->configure_object;
my $extract = $mod->status->extract;
for my $file ( @search ) {
if(-e $file and -r $file) {
my $slurp = $self->_get_file_contents(file => $file);
- my ($prereq) =
+ my ($prereq) =
($slurp =~ /'?(?:PREREQ_PM|requires)'?\s*=>\s*{(.*?)}/s);
- my @prereq =
+ my @prereq =
($prereq =~ /'?([\w\:]+)'?\s*=>\s*'?\d[\d\.\-\_]*'?/sg);
delete $missing{$_} for(@prereq);
}
projects / platform / upstream / perl.git / commitdiff