Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

refactoring determine_installed_releases

  • Loading branch information...
commit 84d4093902bde7d43fc1026f66e3c4705ae17725 1 parent 8896f00
@semuel authored
Showing with 72 additions and 65 deletions.
  1. +72 −65 lib/Dist/Surveyor.pm
View
137 lib/Dist/Surveyor.pm
@@ -194,78 +194,85 @@ sub determine_installed_releases {
for my $distname ( sort keys %best_dist ) {
my $releases = $best_dist{$distname};
+ push @installed_releases, refine_releases($options, $distname, $releases);
+ }
- my @dist_by_version = sort {
- $a->{dist}{version_obj} <=> $b->{dist}{version_obj} or
- $a->{dist}{fraction_installed} <=> $b->{dist}{fraction_installed}
- } values %$releases;
- my @dist_by_fraction = sort {
- $a->{dist}{fraction_installed} <=> $b->{dist}{fraction_installed} or
- $a->{dist}{version_obj} <=> $b->{dist}{version_obj}
- } values %$releases;
-
- my @remnant_dists = @dist_by_version;
- my $installed_dist = pop @remnant_dists;
-
- # is the most recent candidate dist version also the one with the
- # highest fraction_installed?
- if ($dist_by_version[-1] == $dist_by_fraction[-1]) {
- # this is the common case: we'll assume that's installed and the
- # rest are remnants of earlier versions
- }
- elsif ($dist_by_fraction[-1]{dist}{fraction_installed} == 100) {
- warn "Unsure which $distname is installed from among @{[ keys %$releases ]}\n";
- @remnant_dists = @dist_by_fraction;
- $installed_dist = pop @remnant_dists;
- warn "Selecting the one that apprears to be 100% installed\n";
- }
- else {
- # else grumble so the user knows to ponder the possibilities
- warn "Can't determine which $distname is installed from among @{[ keys %$releases ]}\n";
- warn Dumper([\@dist_by_version, \@dist_by_fraction]);
- warn "\tSelecting based on latest version\n";
- }
+ # sorting into dependency order could be added later, maybe
- if (@remnant_dists or $DEBUG) {
- warn "Distributions with remnants (chosen release is first):\n"
- unless our $dist_with_remnants_warning++;
- warn "@{[ map { $_->{dist}{release} } reverse @dist_by_fraction ]}\n";
- for ($installed_dist, @remnant_dists) {
- my $fi = $_->{dist}{fraction_installed};
- my $modules = $_->{modules};
- my $mv_desc = join(", ", map { "$_->{module} $_->{version}" } @$modules);
- warn sprintf "\t%s\t%s%% installed: %s\n",
- $_->{dist}{release},
- $_->{dist}{percent_installed},
- (@$modules > 4 ? "(".@$modules." modules)" : $mv_desc),
- }
- }
+ return @installed_releases;
+}
- # note ordering: remnants first
- for (($options->{opt_remnants} ? @remnant_dists : ()), $installed_dist) {
- my ($author, $release)
- = @{$_->{dist}}{qw(author release)};
-
- my $release_data = get_release_info($author, $release);
- next unless $release_data;
-
- # shortcuts
- (my $url = $release_data->{download_url}) =~ s{ .*? \b authors/ }{authors/}x;
-
- push @installed_releases, {
- #
- %$release_data,
- # extra items mushed inhandy shortcuts
- url => $url,
- # raw data structures
- dist_data => $_->{dist},
- };
+sub refine_releases {
+ my ($options, $distname, $releases) = @_;
+
+ my @dist_by_version = sort {
+ $a->{dist}{version_obj} <=> $b->{dist}{version_obj} or
+ $a->{dist}{fraction_installed} <=> $b->{dist}{fraction_installed}
+ } values %$releases;
+ my @dist_by_fraction = sort {
+ $a->{dist}{fraction_installed} <=> $b->{dist}{fraction_installed} or
+ $a->{dist}{version_obj} <=> $b->{dist}{version_obj}
+ } values %$releases;
+
+ my @remnant_dists = @dist_by_version;
+ my $installed_dist = pop @remnant_dists;
+
+ # is the most recent candidate dist version also the one with the
+ # highest fraction_installed?
+ if ($dist_by_version[-1] == $dist_by_fraction[-1]) {
+ # this is the common case: we'll assume that's installed and the
+ # rest are remnants of earlier versions
+ }
+ elsif ($dist_by_fraction[-1]{dist}{fraction_installed} == 100) {
+ warn "Unsure which $distname is installed from among @{[ keys %$releases ]}\n";
+ @remnant_dists = @dist_by_fraction;
+ $installed_dist = pop @remnant_dists;
+ warn "Selecting the one that apprears to be 100% installed\n";
+ }
+ else {
+ # else grumble so the user knows to ponder the possibilities
+ warn "Can't determine which $distname is installed from among @{[ keys %$releases ]}\n";
+ warn Dumper([\@dist_by_version, \@dist_by_fraction]);
+ warn "\tSelecting based on latest version\n";
+ }
+
+ if (@remnant_dists or $DEBUG) {
+ warn "Distributions with remnants (chosen release is first):\n"
+ unless our $dist_with_remnants_warning++;
+ warn "@{[ map { $_->{dist}{release} } reverse @dist_by_fraction ]}\n";
+ for ($installed_dist, @remnant_dists) {
+ my $fi = $_->{dist}{fraction_installed};
+ my $modules = $_->{modules};
+ my $mv_desc = join(", ", map { "$_->{module} $_->{version}" } @$modules);
+ warn sprintf "\t%s\t%s%% installed: %s\n",
+ $_->{dist}{release},
+ $_->{dist}{percent_installed},
+ (@$modules > 4 ? "(".@$modules." modules)" : $mv_desc),
}
- #die Dumper(\@installed_releases);
}
- # sorting into dependency order could be added later, maybe
+ my @installed_releases;
+ # note ordering: remnants first
+ for (($options->{opt_remnants} ? @remnant_dists : ()), $installed_dist) {
+ my ($author, $release)
+ = @{$_->{dist}}{qw(author release)};
+ my $release_data = get_release_info($author, $release);
+ next unless $release_data;
+
+ # shortcuts
+ (my $url = $release_data->{download_url}) =~ s{ .*? \b authors/ }{authors/}x;
+
+ push @installed_releases, {
+ #
+ %$release_data,
+ # extra items mushed inhandy shortcuts
+ url => $url,
+ # raw data structures
+ dist_data => $_->{dist},
+ };
+ }
+ #die Dumper(\@installed_releases);
return @installed_releases;
}
Please sign in to comment.
Something went wrong with that request. Please try again.