view release on metacpan or  search on metacpan

lib/App/UpdateCPANfile.pm  view on Meta::CPAN

package App::UpdateCPANfile;
use 5.010001;
use strict;
use warnings;
use Module::CPANfile;
use Module::CPANfile::Writer;
use App::UpdateCPANfile::CPANfileSnapshotParser;
use App::UpdateCPANfile::PackageDetails;
use App::UpdateCPANfile::Change;
use Module::CoreList;
use List::Util qw(shuffle);

our $VERSION = "1.1.1";

sub new {
    my ($class, $path, $snapshot_path, $options) = @_;
    bless {
        path => $path,
        snapshot_path => $snapshot_path,
        options => $options,
    }, $class;
}

sub path {
    $_[0]->{path} // 'cpanfile';
}

sub snapshot_path {
    $_[0]->{snapshot_path} // 'cpanfile.snapshot';
}

sub options {
    $_[0]->{options} // {};
}

sub parser {
    my ($self) = @_;

    $self->{parser} //= Module::CPANfile->load($self->path);
}

sub writer {
    my ($self) = @_;

    $self->{writer} //= Module::CPANfile::Writer->new($self->path);
}

sub package_details {
    my ($self) = @_;

    $self->{package_details} //= App::UpdateCPANfile::PackageDetails->new;
}

sub pin_dependencies {
    my ($self) = @_;
    my $changeset = $self->create_pin_dependencies_changeset;
    $self->_save_changes_to_file($changeset);
    return $changeset;
}

sub update_dependencies {
    my ($self) = @_;
    my $changeset = $self->create_update_dependencies_changeset;
    my $writer = $self->writer;
    $self->_save_changes_to_file($changeset);
    return $changeset;
}

sub create_pin_dependencies_changeset {
    my ($self) = @_;

    my $distributions = App::UpdateCPANfile::CPANfileSnapshotParser->scan_deps($self->snapshot_path);

    my $prereqs = $self->parser->prereqs;
    my $added_dependencies = [];

    my $all_phases = {};
    for my $phase ($prereqs->phases) {
        for my $type ($prereqs->types_in($phase)) {
            $all_phases->{$type}++;
        }
    }

    # If arguments are omitted, it defaults to "runtime", "build" and "test" for phases and "requires" and "recommends" for types.
    my $requirements = $prereqs->merged_requirements([$self->parser->prereqs->phases], [keys %$all_phases]);

    for my $module (sort $requirements->required_modules) {
        next if $self->_is_perl($module);
        my $required_version = $requirements->requirements_for_module($module);
        my $installed_module = $self->_find_installed_module($distributions, $module);
        my $installed_version = defined $installed_module && $installed_module->version_for($module);
        next if $self->_is_core_module($module, $installed_version);
        if (defined $installed_module && defined $installed_version && (! defined $required_version || $required_version ne "== $installed_version") && ($installed_version ne 'undef')) {
            push @$added_dependencies, App::UpdateCPANfile::Change->new(package_name => $module, version => $installed_version, path => $installed_module->pathname);
        }

    }

    return $self->_apply_filter($added_dependencies);
}

sub create_update_dependencies_changeset {
    my ($self) = @_;

    my $prereqs = $self->parser->prereqs;

    my $all_phases = {};
    for my $phase ($prereqs->phases) {
        for my $type ($prereqs->types_in($phase)) {
            $all_phases->{$type}++;
        }
    }

    # If arguments are omitted, it defaults to "runtime", "build" and "test" for phases and "requires" and "recommends" for types.
    my $requirements = $prereqs->merged_requirements([$self->parser->prereqs->phases], [keys %$all_phases]);

    my $added_dependencies = [];

    for my $module (sort $requirements->required_modules) {
        my $required_version = $requirements->requirements_for_module($module);
        next if $self->_is_perl($module, $required_version);