Think ive got it working
This commit is contained in:
parent
a6fe212c6a
commit
8fce8438cf
2 changed files with 94 additions and 0 deletions
|
@ -6,6 +6,7 @@ use Module::CoreList;
|
||||||
use Storable;
|
use Storable;
|
||||||
use IPC::Run qw/run/;
|
use IPC::Run qw/run/;
|
||||||
no warnings 'experimental';
|
no warnings 'experimental';
|
||||||
|
use Carp qw/croak carp cluck confess/;
|
||||||
|
|
||||||
has 'name' => (is => 'ro');
|
has 'name' => (is => 'ro');
|
||||||
has 'dist' => (is => 'ro',
|
has 'dist' => (is => 'ro',
|
||||||
|
@ -25,6 +26,8 @@ sub _get_dist {
|
||||||
}
|
}
|
||||||
|
|
||||||
our %cache;
|
our %cache;
|
||||||
|
our %rev_depcache;
|
||||||
|
|
||||||
if (-e 'modcache.stor') {
|
if (-e 'modcache.stor') {
|
||||||
eval {
|
eval {
|
||||||
my $cache_href=retrieve('modcache.stor');
|
my $cache_href=retrieve('modcache.stor');
|
||||||
|
@ -34,17 +37,29 @@ if (-e 'modcache.stor') {
|
||||||
print STDERR "Couldn't load cache $@\n";
|
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 {
|
sub __save_cache {
|
||||||
store \%cache, 'modcache.stor';
|
store \%cache, 'modcache.stor';
|
||||||
|
store \%rev_depcache, 'revdepcache.stor';
|
||||||
};
|
};
|
||||||
END {__save_cache};
|
END {__save_cache};
|
||||||
|
|
||||||
sub new_module {
|
sub new_module {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $module = shift;
|
my $module = shift;
|
||||||
|
confess "\n\nNo module name given\n" unless $module;
|
||||||
my ($name, $version) = split (/[\-~]/, $module);
|
my ($name, $version) = split (/[\-~]/, $module);
|
||||||
|
|
||||||
|
|
||||||
my $dist = $Dist::mod_to_dist{$name} // $name;
|
my $dist = $Dist::mod_to_dist{$name} // $name;
|
||||||
|
|
||||||
return $cache{$dist} if exists $cache{$dist};
|
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;
|
1;
|
||||||
|
|
31
statfailures.pl
Executable file
31
statfailures.pl
Executable 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);
|
||||||
|
}
|
||||||
|
}
|
Loading…
Add table
Reference in a new issue