BackPAN-Version-Discover
view release on metacpan or search on metacpan
BackPAN-Version-Discover
This module can be used to discover exactly which versions
of which cpan distributions you have installed, and give
you the path to those tarball releases on the backpan.
Note: this module is by no means a perfect solution. It makes
some educated guesses and some assumptions to try and figure
out exactly what you have installed.
Vendor-packages modules are a particularly odd case, since
many will be modified, and the maintainers may or may not
have updated the version numbers. However, most of the time,
they will at least install these modules to a separate set
of lib dirs that is designated by the perl binary as being
the place for them. By default, the scan this module performs
skips over those modules.
bin/original_script.pl view on Meta::CPAN
my ($mi_objs, $non_loadable_mod_names) =
load_module_info_objs( \@module_names, \@search_dirs );
# try to match installed modules to their CPAN distributions and get a
## bunch of other info on the possible dists and the modules. also, track
# modules that will be skipped for various reasons. (eg, no matching dist,
# couldn't parse out needed info, core/vendor-packaged modules, etc...)
my ($dist_info, $skipped_modules) =
collect_module_dist_info( $mi_objs, \@search_dirs );
# use all this data to guess what CPAN releases are installed on this
# machine. If we can find a matching dist name and version on the backpan
# we'll assume there's a match.
#
# $bp_releases is a hash of { dist name => [ dist file paths...] }
# $no_release_matched is an array of dist names where no matches were found
# $dist_info will have additional bits of data added, in case we really
# need to do more processing for some reason :)
my ($bp_releases, $no_release_matched) = find_backpan_releases( $dist_info );
print Dumper $bp_releases, {
bin/original_script.pl view on Meta::CPAN
$mod_data->{cpan_dist_latest_ver} = $latest_dist_ver;
push @{ $dist_info{$dist_name}{$latest_dist_ver}{module_data} }, $mod_data;
}
return \%dist_info, \%skipped_modules;
}
# use the info we have to:
# a. guess which version of the dist is installed
# b. look for a release (dist-name + version) in the backpan index.
sub find_backpan_releases {
my ($dist_info) = @_;
# releases we were able to match are hits
# dists where we couldn't find a match are misses
my %bp_hits; # dist_name => file_path
my @bp_misses; # dist_name
my $bp = BackPAN::Index->new();
bin/original_script.pl view on Meta::CPAN
my $release_data = $dist_info->{$dist_name}{$latest_dist_ver};
# THEORY: if we look at all the latest CPAN::Module objects
# in this release (supposedly the latest from CPAN) and at
# least one module has the same version as the dist, then
# we can assume that the "installed version" of that same
# module is the version of the dist we want to find as a
# release on the backpan.
my @version_types = qw( mb_mod_inst_ver mev_mod_inst_ver cpan_mod_inst_ver mi_mod_inst_ver );
my @version_guesses;
for my $mod_data ( @{ $release_data->{module_data} } ) {
next unless $latest_dist_ver eq $mod_data->{cpan_mod_latest_ver};
push @version_guesses, grep { $_ and $_ ne 'undef' }
@{$mod_data}{@version_types};
}
@version_guesses = reverse uniq sort @version_guesses;
if ( ! @version_guesses ) {
# if we couldn't find a correlation between the dist version
# and any of the module versions, move on.
#printf "%-30s %-15s [no matching module versions]\n", $dist_name, $latest_dist_ver;
push @bp_misses, $dist_name;
next DIST;
}
#printf "%-30s %-15s [%s] ", $dist_name, $latest_dist_ver, join ' ', @version_guesses;
# maybe we have to latest CPAN version?
if( grep { $_ eq $latest_dist_ver } @version_guesses ) {
#print "[LATEST]\n";
next DIST;
}
for my $ver_guess ( @version_guesses ) {
if( my $bp_release = $bp->release( $dist_name, $ver_guess ) ) {
my $rel_path = $bp_release->path;
push @{ $bp_hits{ $dist_name } ||= [] }, "$rel_path";
#print "[FOUND: " . join( ' ', $rel_path ). "]\n";
next DIST;
}
}
#print "[NOT FOUND]\n";
push @bp_misses, $dist_name;
}
}
lib/BackPAN/Version/Discover.pm view on Meta::CPAN
# yeah, it's only "OO" because that's what all the cool kids do.
sub new {
my ($class) = @_;
return bless {}, $class;
}
# scan the given directories (@INC by default) for modules,
# analyze them, then use the CPAN and BackPAN indices to
# guess exactly which version of which distribution each
# one came from.
sub scan {
my ($self, %args) = @_;
my @search_dirs = $self->_cleanup_dirs( @{ $args{dirs} || \@INC } );
my @pm_files = $self->_find_pm_files( @search_dirs );
my @module_names = $self->_get_module_names( @pm_files );
lib/BackPAN/Version/Discover.pm view on Meta::CPAN
# try to match installed modules to their CPAN distributions and get a
# bunch of other info on the possible dists and the modules. also, track
# modules that will be skipped for various reasons. (eg, no matching dist,
# couldn't parse out needed info, core/vendor-packaged modules, etc...)
my ($dist_info, $skipped_modules) =
$self->_get_dist_info( $mi_objs, \@search_dirs );
# add non-loadable to skipped 'cause, well, they're skipped, too, right?
$skipped_modules->{bad_mod_info} = $non_loadable_mod_names;
# finally, use all this data to try to guess which releases we actualy
# have installed. Some dists will have no matching release. $dist_info
# will also have various new bits of info added, if we need it later.
my ($bp_releases, $no_release_matched) =
$self->_guess_backpan_releases( $dist_info );
# the results object will have facilities to get the intresting
# info from the results, plus info needed to re-run the same scan
# any anything else people may ask for :)
return BackPAN::Version::Discover::Results->new(
releases_matched => $bp_releases,
skipped_modules => $skipped_modules,
dists_not_matched => $no_release_matched,
searched_dirs => \@search_dirs,
dist_info => $dist_info,
lib/BackPAN/Version/Discover.pm view on Meta::CPAN
# get info on the specific module that would be loaded by perl
map { [ $_, { mod_info => Module::Info->new_from_module( $_, @$search_dirs ) } ] }
# filter out invalid module names
grep { $_ !~ /[^\w\:]/ ? 1 : 0 * push @bad_modules, $_ }
@$module_names;
return \%module_data, \@bad_modules;
}
# extract/guess a bunch of info from each module, then try to match
# each module to a cpan distribution. also, exclude modules from
# analysis based on various criteria.
# NOTE: this could probably be split into two or more smaller subs.
sub _get_dist_info {
my ($self, $module_info_objs, $search_dirs) = @_;
my %dist_info; # info on dists that our modules match
my %skipped_modules = ( # info on modules we skip
is_core => [], # perl core, not from CPAN
is_vendor => [], # NOTE: right now these end up in no_dist_found.
lib/BackPAN/Version/Discover.pm view on Meta::CPAN
$mod_data->{cpan_dist_latest_ver} = $latest_dist_ver;
push @{ $dist_info{$dist_name}{$latest_dist_ver}{module_data} }, $mod_data;
}
return \%dist_info, \%skipped_modules;
}
# use the info we have to:
# a. guess which version of the dist is installed
# b. look for a release (dist-name + version) in the backpan index.
sub _guess_backpan_releases {
my ($self, $dist_info) = @_;
# releases we were able to match are hits
# dists where we couldn't find a match are misses
my %bp_hits; # dist_name => file_path
my @bp_misses; # dist_name
my $bp = BackPAN::Index->new();
DIST:
lib/BackPAN/Version/Discover.pm view on Meta::CPAN
# least one module has the same version as the dist, then
# we can assume that the "installed version" of that same
# module is the version of the dist we want to find as a
# release on the backpan.
my @version_types = qw(
mb_mod_inst_ver mev_mod_inst_ver
cpan_mod_inst_ver mi_mod_inst_ver
);
my @version_guesses;
for my $mod_data ( @{ $release_data->{module_data} } ) {
next unless $latest_dist_ver eq $mod_data->{cpan_mod_latest_ver};
push @version_guesses, grep { $_ and $_ ne 'undef' }
@{$mod_data}{@version_types};
}
@version_guesses = reverse uniq sort @version_guesses;
if ( ! @version_guesses ) {
# if we couldn't find a correlation between the dist version
# and any of the module versions, move on.
push @bp_misses, $dist_name;
next DIST;
}
# maybe we have to latest CPAN version?
if( grep { $_ eq $latest_dist_ver } @version_guesses ) {
next DIST;
}
for my $ver_guess ( @version_guesses ) {
if( my $bp_release = $bp->release( $dist_name, $ver_guess ) ) {
my $rel_path = $bp_release->path;
push @{ $bp_hits{ $dist_name } ||= [] }, "$rel_path";
next DIST;
}
}
push @bp_misses, $dist_name;
}
}
return \%bp_hits, \@bp_misses;
( run in 0.836 second using v1.01-cache-2.11-cpan-702932259ff )