From 060ce435589654d3a7fdcd8e7e4c5b61d1897e97 Mon Sep 17 00:00:00 2001 From: xaicron Date: Wed, 30 Nov 2011 02:42:39 +0900 Subject: [PATCH] if did not fetch vname then skip check desp. --- lib/App/pmuninstall.pm | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/lib/App/pmuninstall.pm b/lib/App/pmuninstall.pm index 3d9c4ea..56593fc 100644 --- a/lib/App/pmuninstall.pm +++ b/lib/App/pmuninstall.pm @@ -236,19 +236,7 @@ sub is_core_module { sub ask_permission { my($self, $module, $dist, $vname, $packlist) = @_; - my(@deps, %seen); - if ($self->{check_deps} && !$self->{force}) { - $vname ||= $self->vname_for($module) || $module; - $self->puts("Checking modules depending on $vname") if $self->{verbose}; - my $content = $self->fetch("$depended_on_by$vname") || ''; - for my $dep ($content =~ m|
  • ]+>([a-zA-Z0-9_:-]+)|smg) { - $dep =~ s/^\s+|\s+$//smg; # trim - next if $seen{$dep}++; - local $OUTPUT_INDENT_LEVEL = $OUTPUT_INDENT_LEVEL + 1; - $self->puts("Finding $dep in your \@INC (dependencies)") if $self->{verbose}; - push @deps, $dep if $self->locate_pack($dep); - } - } + my @deps = $self->find_deps($vname, $module); $self->puts if $self->{verbose}; $self->puts("$module is included in the distribution $dist and contains:\n") @@ -274,6 +262,27 @@ sub ask_permission { return lc($self->prompt("Are you sure to uninstall $dist?", $default)) eq 'y'; } +sub find_deps { + my ($self, $vname, $module) = @_; + + return unless $self->{check_deps} && !$self->{force}; + $vname ||= $self->vname_for($module) or return; + + $self->puts("Checking modules depending on $vname") if $self->{verbose}; + my $content = $self->fetch("$depended_on_by$vname") or return; + + my (@deps, %seen); + for my $dep ($content =~ m|
  • ]+>([a-zA-Z0-9_:-]+)|smg) { + $dep =~ s/^\s+|\s+$//smg; # trim + next if $seen{$dep}++; + local $OUTPUT_INDENT_LEVEL = $OUTPUT_INDENT_LEVEL + 1; + $self->puts("Finding $dep in your \@INC (dependencies)") if $self->{verbose}; + push @deps, $dep if $self->locate_pack($dep); + } + + return @deps; +} + sub prompt { my ($self, $msg, $default) = @_; require ExtUtils::MakeMaker;