Better caching, split stuff up to be easier to read
This commit is contained in:
Ryan Voots
parent
093af1bee1
commit
9f8f6586df
6 changed files with 191197 additions and 187 deletions
190929
02packages.details.txt
Normal file
190929
02packages.details.txt
Normal file
File diff suppressed because it is too large
Load diff
33
lib/CpanFile.pm
Executable file
33
lib/CpanFile.pm
Executable file
|
|
@ -0,0 +1,33 @@
|
||||||
|
package cpanfile;
|
||||||
|
# HACK since cpan files are valid perl, i'm just using do/require
|
||||||
|
use 5.22.0;
|
||||||
|
|
||||||
|
our @mods;
|
||||||
|
|
||||||
|
sub __parse_file {
|
||||||
|
my $file = shift;
|
||||||
|
|
||||||
|
require $file;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub requires {
|
||||||
|
push @mods, $_[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub recommends {
|
||||||
|
push @mods, $_[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub conflicts {} # IGNORE These
|
||||||
|
|
||||||
|
# we expect all types
|
||||||
|
sub on {
|
||||||
|
my ($env, $code) = @_;
|
||||||
|
$code->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub feature {
|
||||||
|
my ($feat, $desc, $code) = @_;
|
||||||
|
$code->();
|
||||||
|
}
|
||||||
|
1;
|
||||||
21
lib/Dist.pm
Executable file
21
lib/Dist.pm
Executable file
|
|
@ -0,0 +1,21 @@
|
||||||
|
package Dists;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
our %dist_to_mod;
|
||||||
|
our %mod_to_dist;
|
||||||
|
|
||||||
|
open(my $fh, "<", "02packages.details.txt");
|
||||||
|
|
||||||
|
while (my $l = <$fh>) {
|
||||||
|
chomp $l;
|
||||||
|
my ($module, $version, $dist) = split(' ', $l,3);
|
||||||
|
|
||||||
|
push $dist_to_mod{$dist}->@*, $module;
|
||||||
|
$mod_to_dist{$module} = $dist;
|
||||||
|
}
|
||||||
|
|
||||||
|
print Dumper(\%dist_to_mod);
|
||||||
|
|
||||||
|
1;
|
||||||
127
lib/Module.pm
Executable file
127
lib/Module.pm
Executable file
|
|
@ -0,0 +1,127 @@
|
||||||
|
package Module;
|
||||||
|
use 5.22.0;
|
||||||
|
use Moose;
|
||||||
|
use Dist;
|
||||||
|
use Module::CoreList;
|
||||||
|
use Storable;
|
||||||
|
use IPC::Run qw/run/;
|
||||||
|
no warnings 'experimental';
|
||||||
|
|
||||||
|
has 'name' => (is => 'ro');
|
||||||
|
|
||||||
|
has 'depends' => (
|
||||||
|
builder => 'get_deps',
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'ArrayRef[Module]',
|
||||||
|
lazy => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
our %cache;
|
||||||
|
if (-e 'modcache.stor') {
|
||||||
|
eval {
|
||||||
|
my $cache_href=retrieve('modcache.stor');
|
||||||
|
%cache = $cache_href->%*;
|
||||||
|
};
|
||||||
|
if ($@) {
|
||||||
|
print STDERR "Couldn't load cache $@\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
END {
|
||||||
|
store \%cache, 'modcache.stor';
|
||||||
|
};
|
||||||
|
|
||||||
|
sub new_module {
|
||||||
|
my $class = shift;
|
||||||
|
my $module = shift;
|
||||||
|
my ($name, $version) = split (/[\-~]/, $module);
|
||||||
|
|
||||||
|
my $dist = $Dist::mod_to_dist{$name} // $name;
|
||||||
|
|
||||||
|
return $cache{$dist} if exists $cache{$dist};
|
||||||
|
|
||||||
|
$cache{$dist} = Module->new(name => $name);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _is_core {
|
||||||
|
my $module = shift;
|
||||||
|
my ($name, $version) = split (/[\-~]/, $module);
|
||||||
|
|
||||||
|
my $ret = ($name eq 'perl' || Module::CoreList->first_release($name)) // 0;
|
||||||
|
|
||||||
|
return $ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_dist {
|
||||||
|
my $self=shift;
|
||||||
|
my $module = $self->name;
|
||||||
|
|
||||||
|
# skip perl, or core modules
|
||||||
|
return 'perl' if _is_core($module);
|
||||||
|
|
||||||
|
my @cmd = (qw|cpanm --quiet --mirror http://cpan.simcop2387.info/ --info|, $module);
|
||||||
|
my $out;
|
||||||
|
run \@cmd, '>&', \$out;
|
||||||
|
|
||||||
|
chomp $out;
|
||||||
|
return $out;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_deps {
|
||||||
|
my $self=shift;
|
||||||
|
my $module = $self->name;
|
||||||
|
|
||||||
|
# skip perl, or core modules
|
||||||
|
return [] if _is_core($module);
|
||||||
|
|
||||||
|
my @cmd = (qw|cpanm --quiet --mirror http://cpan.simcop2387.info/ --showdeps|, $module);
|
||||||
|
|
||||||
|
my $out;
|
||||||
|
run \@cmd, '>&', \$out;
|
||||||
|
|
||||||
|
return [map {Module->new_module($_)} grep {!_is_core($_)} split($/, $out)];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub print_deps {
|
||||||
|
my ($self, $level, $v) = @_;
|
||||||
|
|
||||||
|
for my $dep ($self->depends->@*) {
|
||||||
|
my $name = $dep->name;
|
||||||
|
print ((" " x $level), $name, "\n");
|
||||||
|
$dep->print_deps($level+1, [@$v, $name]) unless ($name ~~ @$v);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
package cpanfile;
|
||||||
|
# HACK since cpan files are valid perl, i'm just using do/require
|
||||||
|
|
||||||
|
our @mods;
|
||||||
|
|
||||||
|
sub __parse_file {
|
||||||
|
my $file = shift;
|
||||||
|
|
||||||
|
require $file;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub requires {
|
||||||
|
push @mods, $_[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub recommends {
|
||||||
|
push @mods, $_[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub conflicts {} # IGNORE These
|
||||||
|
|
||||||
|
# we expect all types
|
||||||
|
sub on {
|
||||||
|
my ($env, $code) = @_;
|
||||||
|
$code->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub feature {
|
||||||
|
my ($feat, $desc, $code) = @_;
|
||||||
|
$code->();
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
61
lib/TestCpanInc.pm
Normal file
61
lib/TestCpanInc.pm
Normal file
|
|
@ -0,0 +1,61 @@
|
||||||
|
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/;
|
||||||
|
|
||||||
|
our $perlbrew_env = 'blead';
|
||||||
|
|
||||||
|
sub dep_order {
|
||||||
|
my $module = shift;
|
||||||
|
|
||||||
|
my @orders;
|
||||||
|
|
||||||
|
for my $dep ($module->depends->@*) {
|
||||||
|
print "\r", $dep->name, " ";
|
||||||
|
push @orders, dep_order($dep);
|
||||||
|
}
|
||||||
|
|
||||||
|
push @orders, $module;
|
||||||
|
|
||||||
|
return @orders;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub run_cpanm {
|
||||||
|
my ($module, $incstatus) = @_;
|
||||||
|
|
||||||
|
$ENV{PERL_USE_UNSAFE_INC} = !!$incstatus;
|
||||||
|
my @cmd = (qw/perlbrew exec --with/, $perlbrew_env, qw|cpanm --reinstall --verbose --mirror http://cpan.simcop2387.info/ |, $module);
|
||||||
|
|
||||||
|
my $out;
|
||||||
|
run \@cmd, '>&', \$out;
|
||||||
|
|
||||||
|
my $exitcode = $?;
|
||||||
|
|
||||||
|
return ($exitcode, $out);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub test_module {
|
||||||
|
my $module = shift;
|
||||||
|
my ($ret, $noincout) = run_cpanm($module, 0);
|
||||||
|
|
||||||
|
if ($ret) {
|
||||||
|
my ($ret2, $incout) = run_cpanm($module, 1);
|
||||||
|
|
||||||
|
if (!$ret2) {
|
||||||
|
print ">>>>Module $module failed to build without UNSAFE INC\n";
|
||||||
|
open(my $fh, ">", "logs/${$}_${module}_incfailure.log");
|
||||||
|
print $fh $noincout;
|
||||||
|
} else {
|
||||||
|
print "<<<<Module $module fails to build entirely\n";
|
||||||
|
|
||||||
|
open(my $fh, ">", "logs/${$}_${module}_genfailure.log");
|
||||||
|
print $fh $incout;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
219
run.pl
219
run.pl
|
|
@ -1,218 +1,57 @@
|
||||||
#!/usr/bin/env perl
|
#!/usr/bin/env perl
|
||||||
use 5.22.0;
|
use 5.22.0;
|
||||||
|
|
||||||
package Module;
|
use FindBin;
|
||||||
use Moose;
|
use lib $FindBin::Bin.'/lib';
|
||||||
use Module::CoreList;
|
|
||||||
use Storable;
|
|
||||||
use IPC::Run qw/run/;
|
|
||||||
|
|
||||||
has 'name' => (is => 'ro');
|
|
||||||
has 'version' => (is => 'ro');
|
|
||||||
|
|
||||||
has 'depends' => (
|
|
||||||
builder => 'get_deps',
|
|
||||||
is => 'ro',
|
|
||||||
isa => 'ArrayRef[Module]',
|
|
||||||
lazy => 1,
|
|
||||||
);
|
|
||||||
|
|
||||||
our %cache;
|
|
||||||
if (-e 'cache.stor') {
|
|
||||||
eval {
|
|
||||||
my $cache_href=retrieve('cache.stor');
|
|
||||||
%cache = $cache_href->%*;
|
|
||||||
};
|
|
||||||
if ($@) {
|
|
||||||
print STDERR "Couldn't load cache $@\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
END {
|
|
||||||
store \%cache, 'cache.stor';
|
|
||||||
};
|
|
||||||
|
|
||||||
sub new_module {
|
|
||||||
my $class = shift;
|
|
||||||
my $module = shift;
|
|
||||||
chomp $module;
|
|
||||||
my ($name, $version) = split (/[\-~]/, $module);
|
|
||||||
|
|
||||||
return $cache{$name} if exists $cache{$name};
|
|
||||||
|
|
||||||
$cache{$name} = Module->new(name => $name);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub _is_core {
|
|
||||||
my $module = shift;
|
|
||||||
chomp $module;
|
|
||||||
my ($name, $version) = split (/[\-~]/, $module);
|
|
||||||
|
|
||||||
my $ret = ($name eq 'perl' || Module::CoreList->first_release($name)) // 0;
|
|
||||||
|
|
||||||
return $ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_deps {
|
|
||||||
my $self=shift;
|
|
||||||
my $module = $self->name;
|
|
||||||
|
|
||||||
# skip perl, or core modules
|
|
||||||
return [] if _is_core($module);
|
|
||||||
|
|
||||||
my @cmd = (qw|cpanm --quiet --mirror http://cpan.simcop2387.info/ --showdeps|, $module);
|
|
||||||
|
|
||||||
my $out;
|
|
||||||
run \@cmd, '>&', \$out;
|
|
||||||
|
|
||||||
return [map {Module->new_module($_)} grep {!_is_core($_)} split($/, $out)];
|
|
||||||
}
|
|
||||||
|
|
||||||
sub print_deps {
|
|
||||||
my ($self, $level, $v) = @_;
|
|
||||||
|
|
||||||
for my $dep ($self->depends->@*) {
|
|
||||||
my $name = $dep->name;
|
|
||||||
print ((" " x $level), $name, "\n");
|
|
||||||
$dep->print_deps($level+1, [@$v, $name]) unless ($name ~~ @$v);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
package cpanfile;
|
|
||||||
# HACK since cpan files are valid perl, i'm just using do/require
|
|
||||||
|
|
||||||
our @mods;
|
|
||||||
|
|
||||||
sub __parse_file {
|
|
||||||
my $file = shift;
|
|
||||||
|
|
||||||
require $file;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub requires {
|
|
||||||
push @mods, $_[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
sub recommends {
|
|
||||||
push @mods, $_[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
sub conflicts {} # IGNORE These
|
|
||||||
|
|
||||||
# we expect all types
|
|
||||||
sub on {
|
|
||||||
my ($env, $code) = @_;
|
|
||||||
$code->();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub feature {
|
|
||||||
my ($feat, $desc, $code) = @_;
|
|
||||||
$code->();
|
|
||||||
}
|
|
||||||
|
|
||||||
package main;
|
|
||||||
use strict;
|
use strict;
|
||||||
use autodie;
|
use autodie;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use List::Util qw/uniq/;
|
|
||||||
use IPC::Run qw/run/;
|
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
|
use List::Util qw/uniq/;
|
||||||
|
|
||||||
|
use Module;
|
||||||
|
use CpanFile;
|
||||||
|
use TestCpanInc;
|
||||||
|
|
||||||
our $opt_perlbrew_env='blead';
|
|
||||||
our $opt_module;
|
|
||||||
our $opt_cpanfile;
|
our $opt_cpanfile;
|
||||||
|
our $opt_module;
|
||||||
our $opt_help;
|
our $opt_help;
|
||||||
|
|
||||||
GetOptions ("module=s" => \$opt_module,
|
GetOptions ("module=s" => \$opt_module,
|
||||||
"cpanfile=s" => \$opt_cpanfile, # string
|
"cpanfile=s" => \$opt_cpanfile, # string
|
||||||
"perlbrew_env=s" => \$opt_perlbrew_env,
|
"perlbrew_env=s" => \$TestCpanInc::perlbrew_env,
|
||||||
"help" => \$opt_help); # flagV
|
"help" => \$opt_help); # flagV
|
||||||
|
|
||||||
if ((!$opt_module && !$opt_cpanfile) || ($opt_module && $opt_cpanfile) || $opt_help) {
|
if ((!$opt_module && !$opt_cpanfile) || ($opt_module && $opt_cpanfile) || $opt_help) {
|
||||||
usage(); exit(1);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub usage {
|
|
||||||
print "Call with either --cpanfile xor --module to specify what to test.\n",
|
print "Call with either --cpanfile xor --module to specify what to test.\n",
|
||||||
"Use --perlbrew_env to specify which perl install to use, defaults to blead\n";
|
"Use --perlbrew_env to specify which perl install to use, defaults to blead\n";
|
||||||
|
exit(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub dep_order {
|
$|++;
|
||||||
my $module = shift;
|
|
||||||
|
|
||||||
my @orders;
|
my @mods_to_test = ($opt_module);
|
||||||
|
|
||||||
for my $dep ($module->depends->@*) {
|
if ($opt_cpanfile) {
|
||||||
print "\r", $dep->name, " ";
|
# TODO read cpanfile, via do/require
|
||||||
push @orders, dep_order($dep);
|
|
||||||
}
|
|
||||||
|
|
||||||
push @orders, $module;
|
|
||||||
|
|
||||||
return @orders;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub run_cpanm {
|
|
||||||
my ($module, $incstatus) = @_;
|
|
||||||
|
|
||||||
$ENV{PERL_USE_UNSAFE_INC} = !!$incstatus;
|
|
||||||
my @cmd = (qw/perlbrew exec --with/, $opt_perlbrew_env, qw|cpanm --reinstall --verbose --mirror http://cpan.simcop2387.info/ |, $module);
|
|
||||||
|
|
||||||
my $out;
|
|
||||||
run \@cmd, '>&', \$out;
|
|
||||||
|
|
||||||
my $exitcode = $?;
|
|
||||||
|
|
||||||
return ($exitcode, $out);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub test_module {
|
|
||||||
my $module = shift;
|
|
||||||
my ($ret, $noincout) = run_cpanm($module, 0);
|
|
||||||
|
|
||||||
if ($ret) {
|
|
||||||
my ($ret2, $incout) = run_cpanm($module, 1);
|
|
||||||
|
|
||||||
if (!$ret2) {
|
|
||||||
print ">>>>Module $module failed to build without UNSAFE INC\n";
|
|
||||||
open(my $fh, ">", "logs/${$}_${module}_incfailure.log");
|
|
||||||
print $fh $noincout;
|
|
||||||
} else {
|
|
||||||
print "<<<<Module $module fails to build entirely\n";
|
|
||||||
|
|
||||||
open(my $fh, ">", "logs/${$}_${module}_genfailure.log");
|
|
||||||
print $fh $incout;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub main {
|
|
||||||
$|++;
|
|
||||||
|
|
||||||
my @mods_to_test = ($opt_module);
|
|
||||||
|
|
||||||
if ($opt_cpanfile) {
|
|
||||||
# TODO read cpanfile, via do/require
|
|
||||||
cpanfile::__parse_file($opt_cpanfile);
|
cpanfile::__parse_file($opt_cpanfile);
|
||||||
@mods_to_test = @cpanfile::mods;
|
@mods_to_test = @cpanfile::mods;
|
||||||
}
|
|
||||||
|
|
||||||
my @modules;
|
|
||||||
|
|
||||||
print "Building dep list sorry, this'll take a while\n";
|
|
||||||
for my $mtt (@mods_to_test) {
|
|
||||||
my $mod = Module->new_module($mtt);
|
|
||||||
push @modules, map {$_->name} uniq dep_order($mod);
|
|
||||||
}
|
|
||||||
|
|
||||||
print "\n";
|
|
||||||
@modules = uniq(@modules);
|
|
||||||
|
|
||||||
for my $mod (@modules) {
|
|
||||||
print "Testing $mod\n";
|
|
||||||
test_module($mod);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
main();
|
my @modules;
|
||||||
|
|
||||||
|
print "Building dep list sorry, this'll take a while\n";
|
||||||
|
for my $mtt (@mods_to_test) {
|
||||||
|
my $mod = Module->new_module($mtt);
|
||||||
|
push @modules, map {$_->name} uniq TestCpanInc::dep_order($mod);
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\n";
|
||||||
|
@modules = uniq(@modules);
|
||||||
|
|
||||||
|
for my $mod (@modules) {
|
||||||
|
print "Testing $mod\n";
|
||||||
|
TestCpanInc::test_module($mod);
|
||||||
|
}
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue