diff --git a/lib/Module.pm b/lib/Module.pm index 430e961..1a485c9 100755 --- a/lib/Module.pm +++ b/lib/Module.pm @@ -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; diff --git a/statfailures.pl b/statfailures.pl new file mode 100755 index 0000000..86b17f0 --- /dev/null +++ b/statfailures.pl @@ -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); + } +}