view release on metacpan or  search on metacpan

lib/App/cpm/Master.pm  view on Meta::CPAN

package App::cpm::Master;
use v5.24;
use warnings;
use experimental qw(lexical_subs signatures);

use App::cpm::CircularDependency;
use App::cpm::Distribution;
use App::cpm::Logger;
use App::cpm::Logger::Terminal;
use App::cpm::Task;
use App::cpm::version;
use CPAN::DistnameInfo;
use Module::Metadata;
use File::pushd 'pushd';

sub new ($class, %argv) {
    my $self = bless {
        %argv,
        installed_distributions => 0,
        tasks => +{},
        distributions => +{},
        dependency_ready => +{},
        _fail_resolve => +{},
        _fail_install => +{},
        _is_installed => +{},
    }, $class;
    if ($self->{target_perl}) {
        require Module::CoreList;
        if (!exists $Module::CoreList::version{$self->{target_perl}}) {
            die "Module::CoreList does not have target perl $self->{target_perl} entry, abort.\n";
        }
        if (!exists $Module::CoreList::version{$]}) {
            die "Module::CoreList does not have our perl $] entry, abort.\n";
        }
    }
    if (!$self->{global}) {
        if (eval { require Module::CoreList }) {
            if (!exists $Module::CoreList::version{$]}) {
                die "Module::CoreList does not have our perl $] entry, abort.\n";
            }
            $self->{_has_corelist} = 1;
        } else {
            my $msg = "You don't have Module::CoreList. "
                    . "The local-lib may result in incomplete self-contained directory.";
            App::cpm::Logger->log(result => "WARN", message => $msg);
        }
    }
    $self;
}

sub fail ($self, $ctx) {
    my @fail_resolve = sort keys $self->{_fail_resolve}->%*;
    my @fail_install = sort keys $self->{_fail_install}->%*;
    my @not_installed = grep { !$self->{_fail_install}{$_->distfile} && !$_->installed } $self->_final_install_distributions(1);
    return if !@fail_resolve && !@fail_install && !@not_installed;

    my $detector = App::cpm::CircularDependency->new;
    for my $dist (@not_installed) {
        my $req = $dist->requirements([qw(configure build test runtime)])->as_array;
        $detector->add($dist->distfile, $dist->provides, $req);
    }
    $detector->finalize;

    my $detected = $detector->detect;
    for my $distfile (sort keys $detected->%*) {
        my $distvname = $self->distribution($distfile)->distvname;
        my @circular = $detected->{$distfile}->@*;
        my $msg = join " -> ", map { $self->distribution($_)->distvname } @circular;
        local $ctx->{logger}{context} = $distvname;
        $ctx->log("Detected circular dependencies $msg");
        $ctx->log("Failed to install distribution");
    }
    for my $dist (sort { $a->distvname cmp $b->distvname } grep { !$detected->{$_->distfile} } @not_installed) {
        local $ctx->{logger}{context} = $dist->distvname;
        $ctx->log("Failed to install distribution, "
                            ."because of installing some dependencies failed");
    }

    my @fail_install_name = map { CPAN::DistnameInfo->new($_)->distvname || $_ } @fail_install;
    my @not_installed_name = map { $_->distvname } @not_installed;
    if (@fail_resolve || @fail_install_name) {
        $ctx->log("--");
        $ctx->log(
            "Installation failed. "
            . "The direct cause of the failure comes from the following packages/distributions; "
            . "you may want to grep this log file by them:"
        );
        $ctx->log(" * $_") for @fail_resolve, sort @fail_install_name;
    }
    { resolve => \@fail_resolve, install => [sort @fail_install_name, @not_installed_name] };
}

sub tasks ($self) { values $self->{tasks}->%* }

sub add_task ($self, $ctx, %task) {
    my $new = App::cpm::Task->new(%task);
    if (my ($existing) = grep { $_->equals($new) } $self->tasks) {
        $existing->{final_target} ||= $new->{final_target};
        return 0;
    } else {
        $self->{tasks}{$new->uid} = $new;
        return 1;
    }
}

sub get_task ($self, $ctx) {
    if (my @task = grep { !$_->in_charge } $self->tasks) {
        return @task;
    }
    $self->_add_tasks($ctx);
    return if !$self->tasks;
    if (my @task = grep { !$_->in_charge } $self->tasks) {
        return @task;
    }
    return;
}

sub register_result ($self, $ctx, $result) {
    my ($task) = grep { $_->uid eq $result->{uid} } $self->tasks;
    die "Missing task that has uid=$result->{uid}" if !$task;

    $task->%* = $result->%*; # XXX

    my $logged = $self->info($task);
    my $method = "_register_@{[$task->{type}]}_result";
    $self->$method($ctx, $task);
    $self->remove_task($ctx, $task);

    return 1;
}

sub info ($self, $task) {
    my $type = $task->type;
    if (!$App::cpm::Logger::VERBOSE && $task->{ok}) {
        return if !($self->{notest} && $type eq "fetch" && $task->{prebuilt})
            && !($self->{notest} && $type eq "build" && !$task->{prebuilt})
            && !(!$self->{notest} && $type eq "test");
    }
    my $name = $task->distvname;
    my ($message, $optional);
    if ($type eq "resolve") {
        $message = $task->{package};
        $message .= " -> $name" . ($task->{ref} ? "\@$task->{ref}" : "") if $task->{ok};
        $optional = "from $task->{from}" if $task->{ok} and $task->{from};
    } else {
        $message = $name;
        $optional = "using cache" if $type eq "fetch" and $task->{using_cache};
        $optional = "using prebuilt" if $task->{prebuilt};
    }
    my $elapsed = defined $task->{elapsed} ? sprintf "(%.3fsec) ", $task->{elapsed} : "";