package Module; use 5.22.0; use Moose; use Dist; 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', builder => '_get_dist', lazy => 1); has 'depends' => ( builder => 'get_deps', is => 'ro', isa => 'ArrayRef[Module]', lazy => 1, ); sub _get_dist { my $self = shift; return $Dist::mod_to_dist{$self->name} // $self->name; } our %cache; our %rev_depcache; if (-e 'modcache.stor') { eval { my $cache_href=retrieve('modcache.stor'); %cache = $cache_href->%*; }; if ($@) { 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}; $cache{$dist} = Module->new(name => $name); } { my @banned = do {open (my $fh, "}; use Data::Dumper; sub _is_banned { my $module = shift; my $dist = $Dist::mod_to_dist{$module} // $module; return _is_core($module) || ($dist ~~ @banned); } } sub _is_core { my $module = shift; my ($name, $version) = split (/[\-~]/, $module); return 0 unless $name; 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_banned($module); print "Getting deps for $module\n"; my $out; my $ret; for my $tries (1..3) { my @cmd = (qw|cpanm --quiet --showdeps|, $module); $SIG{TERM}="ignore"; $ret = run \@cmd, '>&', \$out; warn "Failed to get deps for $module: $?" unless $ret; last if ($ret); } die "FATAL: no deps for $module" unless $ret; my $deps = [map {Module->new_module($_)} grep {!_is_core($_)} grep {defined $_ && $_ !~ /^\s*$/} split($/, $out)]; __save_cache; return $deps; } sub print_deps { my $self = shift; $self->_print_deps(0, []); } 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); } } 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 STDERR "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) { print STDERR sprintf "%03d %05d\r", $level, $c++; my $module = Module->new_module($mod_name); if ($module->depends_on($self)) { push @total, $module, $module->get_failed_descendants($candidates, $level+1, [@$loop, $self]); } } print STDERR "\n"; $rev_depcache{$self->name} = [@total]; __save_cache; return @total; } 1;