133 lines
3.2 KiB
Perl
133 lines
3.2 KiB
Perl
package TestCpanInc;
|
|
use 5.22.0;
|
|
|
|
use strict;
|
|
use autodie;
|
|
use warnings;
|
|
use Data::Dumper;
|
|
use List::Util qw/uniq/;
|
|
use IPC::Run qw/run timeout harness/;
|
|
use Module;
|
|
use Time::HiRes qw/sleep time/;
|
|
|
|
our $perlbrew_env = 'blead';
|
|
|
|
sub remove_imc {
|
|
my ($module, $incstatus) = @_;
|
|
|
|
print "Removing MI\r";
|
|
$ENV{PERL_USE_UNSAFE_INC} = 1;
|
|
my @cmd = (qw/perlbrew exec --with/, $perlbrew_env, qw|cpanm --force --uninstall inc::Module::Install |);
|
|
|
|
my $out;
|
|
run \@cmd, '>&', \$out;
|
|
print " \r";
|
|
}
|
|
|
|
our $last_dep = time();
|
|
our %total_deps = ();
|
|
|
|
sub dep_order {
|
|
my $module = shift;
|
|
my $level = shift || 0;
|
|
|
|
my @orders;
|
|
|
|
for my $dep ($module->depends->@*) {
|
|
|
|
if (time() - $last_dep >= 10 || $level >= 200) {
|
|
print $dep->name," ",$dep->dist, " " ,$level, "\n";
|
|
$last_dep = time();
|
|
}
|
|
|
|
next if (Module::_is_banned($dep->name));
|
|
next if ($total_deps{$dep->dist}); # skip it if we've already added this to the total deps
|
|
$total_deps{$dep->dist} = 1;
|
|
push @orders, dep_order($dep, $level+1);
|
|
}
|
|
|
|
push @orders, $module;
|
|
|
|
return @orders;
|
|
}
|
|
|
|
sub run_cpanm {
|
|
my ($incstatus, $timeout, @arguments) = @_;
|
|
|
|
$ENV{PERL_USE_UNSAFE_INC} = !!$incstatus;
|
|
my @cmd = (qw/perlbrew exec --with/, $perlbrew_env, 'cpanm', @arguments);
|
|
|
|
my $out;
|
|
my $in='';
|
|
$|++;
|
|
|
|
$timeout = $timeout > 0? $timeout : 600; # default to 10 min, even if you passed 0.
|
|
|
|
my $h = harness \@cmd, '<', \$in, '>&', \$out, timeout($timeout); # timeout after 10 minutes
|
|
eval {
|
|
$h->start();
|
|
my $st = time();
|
|
while($h->pumpable()) { # still getting output
|
|
$h->pump_nb();
|
|
if (length($out) > 10*1024*1024) { # 20 meg limit on output
|
|
die "Output too long. Failing build\n";
|
|
}
|
|
sleep(0.1);
|
|
printf "%03.03f %08d\r", time()-$st, length($out);
|
|
die "Timeout" if time()-$st > $timeout;
|
|
}
|
|
|
|
$h->finish();
|
|
};
|
|
my $err = $@;
|
|
print " "x20, "\r";
|
|
$h->kill_kill(); # reap all the kids
|
|
eval {print "Double finish\n"; $h->finish();} if $err;
|
|
my $exitcode = $err || $h->full_result();
|
|
|
|
return ($exitcode, $out);
|
|
}
|
|
|
|
sub test_install {
|
|
my ($module, $incstatus) = @_;
|
|
|
|
$ENV{PERL_USE_UNSAFE_INC} = !!$incstatus;
|
|
my @cmd = (qw/perlbrew exec --with/, $perlbrew_env, qw|cpanm --reinstall --verbose |, $module);
|
|
|
|
my ($exitcode, $out) = run_cpanm($incstatus, 600, qw/--reinstall --verbose/, $module);
|
|
|
|
return ($exitcode, $out);
|
|
}
|
|
|
|
sub test_module {
|
|
my $module = shift;
|
|
|
|
return "banned module" if (Module::_is_banned($module));
|
|
|
|
remove_imc();
|
|
my ($ret, $noincout) = test_install($module, 0);
|
|
|
|
if ($ret) {
|
|
remove_imc();
|
|
my ($ret2, $incout) = test_install($module, 1);
|
|
|
|
if (!$ret2) {
|
|
print ">>>>Module $module failed to build without UNSAFE INC\n";
|
|
open(my $fh, ">", "logs/${module}_incfailure.log");
|
|
print $fh $noincout;
|
|
|
|
return "inc failed";
|
|
} else {
|
|
print "<<<<Module $module fails to build entirely\n";
|
|
|
|
open(my $fh, ">", "logs/${module}_genfailure.log");
|
|
print $fh $incout;
|
|
|
|
return "gen failed";
|
|
}
|
|
}
|
|
|
|
return "success";
|
|
}
|
|
|
|
1;
|