view release on metacpan or  search on metacpan

devdata/Menlo-CLI-Compat.v1.9022.pm.txt  view on Meta::CPAN

    $self->setup_verify if $self->{verify};

    if (my $action = $self->{action}) {
        $self->$action() and return 1;
    }

    return $self->show_help(1)
        unless @{$self->{argv}} or $self->{load_from_stdin};

    $self->configure_mirrors;

    my $cwd = Cwd::cwd;

    my @fail;
    for my $module (@{$self->{argv}}) {
        if ($module =~ s/\.pm$//i) {
            my ($volume, $dirs, $file) = File::Spec->splitpath($module);
            $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
        }
        ($module, my $version) = $self->parse_module_args($module);

        $self->chdir($cwd);
        if ($self->{cmd} eq 'uninstall') {
            $self->uninstall_module($module)
              or push @fail, $module;
        } else {
            $self->install_module($module, 0, $version)
                or push @fail, $module;
        }
    }

    if ($self->{base} && $self->{auto_cleanup}) {
        $self->cleanup_workdirs;
    }

    if ($self->{installed_dists}) {
        my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
        $self->diag("$self->{installed_dists} $dists installed\n", 1);
    }

    if ($self->{scandeps}) {
        $self->dump_scandeps();
    }
    # Workaround for older File::Temp's
    # where creating a tempdir with an implicit $PWD
    # causes tempdir non-cleanup if $PWD changes
    # as paths are stored internally without being resolved
    # absolutely.
    # https://rt.cpan.org/Public/Bug/Display.html?id=44924
    $self->chdir($cwd);

    return !@fail;
}

sub setup_home {
    my $self = shift;

    $self->{home} = $self->env('HOME') if $self->env('HOME');

    unless (_writable($self->{home})) {
        die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
    }

    $self->{base} = "$self->{home}/work/" . time . ".$$";
    File::Path::mkpath([ $self->{base} ], 0, 0777);

    # native path because we use shell redirect
    $self->{log} = File::Spec->catfile($self->{base}, "build.log");
    my $final_log = "$self->{home}/build.log";

    { open my $out, ">$self->{log}" or die "$self->{log}: $!" }

    if (CAN_SYMLINK) {
        my $build_link = "$self->{home}/latest-build";
        unlink $build_link;
        symlink $self->{base}, $build_link;

        unlink $final_log;
        symlink $self->{log}, $final_log;
    } else {
        my $log = $self->{log}; my $home = $self->{home};
        $self->{at_exit} = sub {
            my $self = shift;
            my $temp_log = "$home/build.log." . time . ".$$";
            File::Copy::copy($log, $temp_log)
                && unlink($final_log);
            rename($temp_log, $final_log);
        }
    }

    $self->chat("cpanm ($self->{name}) $Menlo::VERSION on perl $] built for $Config{archname}\n" .
                "Work directory is $self->{base}\n");
}

sub search_mirror_index_local {
    my ($self, $local, $module, $version) = @_;
    require CPAN::Common::Index::LocalPackage;
    my $index = CPAN::Common::Index::LocalPackage->new({ source => $local });
    $self->search_common($index, { package => $module }, $version);
}

sub search_mirror_index {
    my ($self, $mirror, $module, $version) = @_;
    require Menlo::Index::Mirror;
    my $index = Menlo::Index::Mirror->new({
        mirror => $mirror,
        cache => $self->source_for($mirror),
        fetcher => sub { $self->mirror(@_) },
    });
    $self->search_common($index, { package => $module }, $version);
}

sub search_common {
    my($self, $index, $search_args, $want_version) = @_;

    $index->refresh_index;

    my $found = $index->search_packages($search_args);
    $found = $self->cpan_module_common($found) if $found;

    return $found unless $self->{cascade_search};