view release on metacpan or  search on metacpan

lib/BackPAN/Version/Discover.pm  view on Meta::CPAN

use Config;

use BackPAN::Version::Discover::Results qw();

# private patched version of BackPAN::Index. Just a hack for
# now, the next release may have the needed functionality.
use BackPAN::Version::Discover::_BackPAN::Index qw();

use Data::Dumper;

# 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 );

#print Dumper \@search_dirs, \@pm_files, \@module_names; exit;

    # get a hash of {mod_name => Module::Info obj} and an array with the
    # names of modules that module::info couldn't load/parse.
    my ($mi_objs, $non_loadable_mod_names) =
        $self->_get_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) =
        $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,
        scan_args         => \%args,
    );
}


# we want to only search dirs that will be useful... therefore, we need to
#  a. weed out obvious dead-ends like duplicate and non-existent paths.
#  b. resolve all paths and make them absolute, so the output data is sane.
sub _cleanup_dirs {
    my ($self, @dirs) = @_;

    my @search_dirs =
        grep { -e } uniq
            map { dir($_)->absolute } #->resolve }
                @dirs;

    # no need to return Path::Class: objects
    return map { "$_" } @search_dirs;
}


# find all the pm files, relative to each directory
# (for easier translation into module/package names)
sub _find_pm_files {
    my ($self, @search_dirs) = @_;

    my @pm_files;
    for my $dir ( @search_dirs ) {
        push @pm_files, File::Find::Rule
            ->extras( { follow => 1 } )
            ->relative
            ->file
            ->name( '*.pm' )
            ->in( $dir );
    }

    return @pm_files;
}


# turn pm file paths into module/package names. there may be duplicate
# entries, for example from modules installed both as a vendor package
# and from CPAN (and therefore in different paths), but we just need
# the name for now and will decide later *which* one is important,
# specifically, the one that perl would load when used in a script.
sub _get_module_names {
    my ($self, @pm_files) = @_;

    my @module_names =
        uniq
        map { join( '::', splitdir( substr( $_, 0, -3 ) ) ) }
        @pm_files;

    return @module_names;
}


# construct a Module::Info object for each module but keep