Think ive got it working

This commit is contained in:
Your Name 2017-04-18 17:10:16 -04:00
parent a6fe212c6a
commit 8fce8438cf
2 changed files with 94 additions and 0 deletions

View file

@ -6,6 +6,7 @@ use Module::CoreList;
use Storable;
use IPC::Run qw/run/;
no warnings 'experimental';
use Carp qw/croak carp cluck confess/;
has 'name' => (is => 'ro');
has 'dist' => (is => 'ro',
@ -25,6 +26,8 @@ sub _get_dist {
}
our %cache;
our %rev_depcache;
if (-e 'modcache.stor') {
eval {
my $cache_href=retrieve('modcache.stor');
@ -34,17 +37,29 @@ if (-e 'modcache.stor') {
print STDERR "Couldn't load cache $@\n";
}
}
if (-e 'revdepcache.stor') {
eval {
my $cache_href=retrieve('revdepcache.stor');
%rev_depcache = $cache_href->%*;
};
if ($@) {
print STDERR "Couldn't load cache $@\n";
}
}
sub __save_cache {
store \%cache, 'modcache.stor';
store \%rev_depcache, 'revdepcache.stor';
};
END {__save_cache};
sub new_module {
my $class = shift;
my $module = shift;
confess "\n\nNo module name given\n" unless $module;
my ($name, $version) = split (/[\-~]/, $module);
my $dist = $Dist::mod_to_dist{$name} // $name;
return $cache{$dist} if exists $cache{$dist};
@ -106,4 +121,52 @@ sub _print_deps {
}
}
sub depends_on {
my ($self, $module) = @_;
my $dist = $module->_get_dist();
for my $dep ($self->depends->@*) {
return 1 if $dep->_get_dist eq $dist;
}
return 0;
}
# Look at all failed modules, see if they might have depended on us.
sub get_failed_descendants {
my $self = shift;
my $candidates = shift;
my $level = shift || 0;
my $loop = shift || [];
my $sdist = $self->_get_dist;
if (grep {$_->_get_dist eq $sdist} @$loop) {
print "Loop detected with ", $self->name, ". Short circuiting\n";
return();
}
if (ref($rev_depcache{$self->name}) eq 'ARRAY') {
return $rev_depcache{$self->name}->@*;
}
my @total;
my $c=1;
for my $mod_name (@$candidates) {
printf "%03d %05d\r", $level, $c++;
my $module = Module->new_module($mod_name);
if ($module->depends_on($self)) {
push @total, $module->get_failed_descendants($candidates, $level+1, [@$loop, $self]);
}
}
print "\n";
$rev_depcache{$self->name} = \@total;
return @total;
}
1;

31
statfailures.pl Executable file
View file

@ -0,0 +1,31 @@
#!/usr/bin/env perl
use 5.24.0;
use strict;
use warnings;
use lib './lib';
use Module;
use Dist;
use Storable qw/retrieve/;
use Data::Dumper;
my $data = retrieve 'everything.stor';
my @failed_list = grep {$data->{jobstatus}{$_}{status} ne 'success'} grep {defined $_ && $_ ne ''} keys($data->{jobstatus}->%*);
my %mods;
LOOP: for my $mod ($data->{modules}->@*) {
my $status = $data->{jobstatus}{$mod}{status} // "";
if ($status ne 'success') {
print "DEP Checking $mod\n";
my $module = Module->new_module($mod);
my @dependedonby = $module->get_failed_descendants(\@failed_list);
$mods{$mod} = \@dependedonby;
print Dumper(\@dependedonby);
}
}