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 8896f003e12e947c28c33c779211ae44e888d1d9 1 parent ca66d27
@semuel authored
Showing with 105 additions and 75 deletions.
  1. +105 −75 lib/Dist/Surveyor.pm
View
180 lib/Dist/Surveyor.pm
@@ -121,79 +121,8 @@ sub determine_installed_releases {
}
module_progress_indicator($module) unless $VERBOSE;
-
- my $mod_version = do {
- # silence warnings about duplicate VERSION declarations
- # eg Catalyst::Controller::DBIC::API* 2.002001
- local $SIG{__WARN__} = sub { warn @_ if $_[0] !~ /already declared with version/ };
- my $mm = Module::Metadata->new_from_file($mod_file);
- $mm->version; # only one version for one package in file
- };
- $mod_version ||= 0; # XXX
- my $mod_file_size = -s $mod_file;
-
- # Eliminate modules that will be supplied by the target perl version
- if ( my $cv = $Module::CoreList::version{ $options->{opt_perlver} }->{$module} ) {
- $cv =~ s/ //g;
- if (version->parse($cv) >= version->parse($mod_version)) {
- warn "$module is core in perl $options->{opt_perlver} (lib: $mod_version, core: $cv) - skipped\n";
- next;
- }
- }
-
- my $mi = $installed_mod_info{$module} = {
- file => $mod_file,
- module => $module,
- version => $mod_version,
- version_obj => version->parse($mod_version),
- size => $mod_file_size,
- };
-
- # ignore modules we know aren't indexed
- next if $module =~ /^Moose::Meta::Method::Accessor::Native::/;
-
- # XXX could also consider file mtime: releases newer than the mtime
- # of the module file can't be the origin of that module file.
- # (assuming clocks and file times haven't been messed with)
-
- eval {
- my $ccdr = get_candidate_cpan_dist_releases($module, $mod_version, $mod_file_size);
- if (not %$ccdr) {
- $ccdr = get_candidate_cpan_dist_releases($module, $mod_version, 0);
- if (%$ccdr) {
- # probably either a local change/patch or installed direct from repo
- # but with a version number that matches a release
- warn "$module $mod_version on CPAN but with different file size (not $mod_file_size)\n"
- if $mod_version or $VERBOSE;
- $mi->{file_size_mismatch}++;
- }
- elsif ($ccdr = get_candidate_cpan_dist_releases_fallback($module, $mod_version) and %$ccdr) {
- warn "$module $mod_version not on CPAN but assumed to be from @{[ sort keys %$ccdr ]}\n"
- if $mod_version or $VERBOSE;
- $mi->{cpan_dist_fallback}++;
- }
- else {
- $mi->{version_not_on_cpan}++;
- # Possibly:
- # - a local change/patch or installed direct from repo
- # with a version number that was never released.
- # - a private module never released on cpan.
- # - a build-time create module eg common/sense.pm.PL
- warn "$module $mod_version not found on CPAN\n"
- if $mi->{version} # no version implies uninteresting
- or $VERBOSE;
- # XXX could try finding the module with *any* version on cpan
- # to help with later advice. ie could select as candidates
- # the version above and the version below the number we have,
- # and set a flag to inform later logic.
- }
- }
- $mi->{candidate_cpan_dist_releases} = $ccdr if %$ccdr;
- };
- if ($@) {
- warn "Failed get_candidate_cpan_dist_releases($module, $mod_version, $mod_file_size): $@";
- }
-
+ my $mi = get_installed_mod_info($options, $module, $mod_file);
+ $installed_mod_info{$module} = $mi if $mi;
}
@@ -314,8 +243,8 @@ sub determine_installed_releases {
# note ordering: remnants first
for (($options->{opt_remnants} ? @remnant_dists : ()), $installed_dist) {
- my ($author, $distribution, $release)
- = @{$_->{dist}}{qw(author distribution release)};
+ my ($author, $release)
+ = @{$_->{dist}}{qw(author release)};
my $release_data = get_release_info($author, $release);
next unless $release_data;
@@ -340,6 +269,107 @@ sub determine_installed_releases {
return @installed_releases;
}
+# for each installed module, get the list of releases that it exists in
+# Parameters:
+# $options - uses only opt_perlver
+# $module - module name (i.e. 'Dist::Surveyor')
+# $mod_file - the location of this module on the filesystem
+# Return:
+# undef if this module should be skipped
+# otherwise, a hashref containing:
+# file => $mod_file,
+# module => $module,
+# version => $mod_version,
+# version_obj => same as version, but as an object,
+# size => $mod_file_size,
+# # optional flags:
+# file_size_mismatch => 1,
+# cpan_dist_fallback => 1, # could not find this module/version on cpan,
+# # but found a release with that version, containing such module
+# version_not_on_cpan> 1, # can not find this file on CPAN.
+# # releases info
+# candidate_cpan_dist_releases => hashref,
+#
+# candidate_cpan_dist_releases hashref contain a map of all the releases
+# that this module exists in. see get_candidate_cpan_dist_releases for more
+# info.
+sub get_installed_mod_info {
+ my ($options, $module, $mod_file) = @_;
+
+ my $mod_version = do {
+ # silence warnings about duplicate VERSION declarations
+ # eg Catalyst::Controller::DBIC::API* 2.002001
+ local $SIG{__WARN__} = sub { warn @_ if $_[0] !~ /already declared with version/ };
+ my $mm = Module::Metadata->new_from_file($mod_file);
+ $mm->version; # only one version for one package in file
+ };
+ $mod_version ||= 0; # XXX
+ my $mod_file_size = -s $mod_file;
+
+ # Eliminate modules that will be supplied by the target perl version
+ if ( my $cv = $Module::CoreList::version{ $options->{opt_perlver} }->{$module} ) {
+ $cv =~ s/ //g;
+ if (version->parse($cv) >= version->parse($mod_version)) {
+ warn "$module is core in perl $options->{opt_perlver} (lib: $mod_version, core: $cv) - skipped\n";
+ return;
+ }
+ }
+
+ my $mi = {
+ file => $mod_file,
+ module => $module,
+ version => $mod_version,
+ version_obj => version->parse($mod_version),
+ size => $mod_file_size,
+ };
+
+ # ignore modules we know aren't indexed
+ return $mi if $module =~ /^Moose::Meta::Method::Accessor::Native::/;
+
+ # XXX could also consider file mtime: releases newer than the mtime
+ # of the module file can't be the origin of that module file.
+ # (assuming clocks and file times haven't been messed with)
+
+ eval {
+ my $ccdr = get_candidate_cpan_dist_releases($module, $mod_version, $mod_file_size);
+ if (not %$ccdr) {
+ $ccdr = get_candidate_cpan_dist_releases($module, $mod_version, 0);
+ if (%$ccdr) {
+ # probably either a local change/patch or installed direct from repo
+ # but with a version number that matches a release
+ warn "$module $mod_version on CPAN but with different file size (not $mod_file_size)\n"
+ if $mod_version or $VERBOSE;
+ $mi->{file_size_mismatch}++;
+ }
+ elsif ($ccdr = get_candidate_cpan_dist_releases_fallback($module, $mod_version) and %$ccdr) {
+ warn "$module $mod_version not on CPAN but assumed to be from @{[ sort keys %$ccdr ]}\n"
+ if $mod_version or $VERBOSE;
+ $mi->{cpan_dist_fallback}++;
+ }
+ else {
+ $mi->{version_not_on_cpan}++;
+ # Possibly:
+ # - a local change/patch or installed direct from repo
+ # with a version number that was never released.
+ # - a private module never released on cpan.
+ # - a build-time create module eg common/sense.pm.PL
+ warn "$module $mod_version not found on CPAN\n"
+ if $mi->{version} # no version implies uninteresting
+ or $VERBOSE;
+ # XXX could try finding the module with *any* version on cpan
+ # to help with later advice. ie could select as candidates
+ # the version above and the version below the number we have,
+ # and set a flag to inform later logic.
+ }
+ }
+ $mi->{candidate_cpan_dist_releases} = $ccdr if %$ccdr;
+ };
+ if ($@) {
+ warn "Failed get_candidate_cpan_dist_releases($module, $mod_version, $mod_file_size): $@";
+ }
+ return $mi;
+}
+
# pick_best_cpan_dist_release - memoized
# for each %$ccdr adds a fraction_installed based on %$installed_mod_info
# returns ref to array of %$ccdr values that have the max fraction_installed
Please sign in to comment.
Something went wrong with that request. Please try again.