App-ShellCompleter-cpanm

 view release on metacpan or  search on metacpan

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

use File::Which qw(which);
use Getopt::Long ();
use Symbol ();
use version ();

use constant BAD_TAR => ($^O eq 'solaris' || $^O eq 'hpux');
use constant CAN_SYMLINK => eval { symlink("", ""); 1 };

our $VERSION = '1.9022';

if ($INC{"App/FatPacker/Trace.pm"}) {
    require version::vpp;
}

sub qs($) {
    Menlo::Util::shell_quote($_[0]);
}

sub determine_home {
    my $class = shift;

    my $homedir = $ENV{HOME}
      || eval { require File::HomeDir; File::HomeDir->my_home }
      || join('', @ENV{qw(HOMEDRIVE HOMEPATH)}); # Win32

    if (WIN32) {
        require Win32; # no fatpack
        $homedir = Win32::GetShortPathName($homedir);
    }

    return "$homedir/.cpanm";
}

sub new {
    my $class = shift;

    my $self = bless {
        name => "Menlo",
        home => $class->determine_home,
        cmd  => 'install',
        seen => {},
        notest => undef,
        test_only => undef,
        installdeps => undef,
        force => undef,
        sudo => undef,
        make  => undef,
        verbose => undef,
        quiet => undef,
        interactive => undef,
        log => undef,
        mirrors => [],
        mirror_only => undef,
        mirror_index => undef,
        cpanmetadb => "http://cpanmetadb.plackperl.org/v1.0/",
        perl => $^X,
        argv => [],
        local_lib => undef,
        self_contained => undef,
        exclude_vendor => undef,
        prompt_timeout => 0,
        prompt => undef,
        configure_timeout => 60,
        build_timeout => 3600,
        test_timeout => 1800,
        try_lwp => 1,
        try_wget => 1,
        try_curl => 1,
        uninstall_shadows => ($] < 5.012),
        skip_installed => 1,
        skip_satisfied => 0,
        static_install => 1,
        auto_cleanup => 7, # days
        pod2man => 1,
        installed_dists => 0,
        install_types => ['requires'],
        with_develop => 0,
        with_configure => 0,
        showdeps => 0,
        scandeps => 0,
        scandeps_tree => [],
        format   => 'tree',
        save_dists => undef,
        skip_configure => 0,
        verify => 0,
        report_perl_version => !$class->maybe_ci,
        build_args => {},
        features => {},
        pure_perl => 0,
        cpanfile_path => 'cpanfile',
        @_,
    }, $class;

    $self;
}

sub env {
    my($self, $key) = @_;
    $ENV{"PERL_CPANM_" . $key};
}

sub maybe_ci {
    my $class = shift;
    grep $ENV{$_}, qw( TRAVIS CI AUTOMATED_TESTING AUTHOR_TESTING );
}

sub install_type_handlers {
    my $self = shift;

    my @handlers;
    for my $type (qw( recommends suggests )) {
        push @handlers, "with-$type" => sub {
            my %uniq;
            $self->{install_types} = [ grep !$uniq{$_}++, @{$self->{install_types}}, $type ];
        };
        push @handlers, "without-$type" => sub {
            $self->{install_types} = [ grep $_ ne $type, @{$self->{install_types}} ];
        };
    }

    @handlers;
}

sub build_args_handlers {
    my $self = shift;

    my @handlers;
    for my $phase (qw( configure build test install )) {
        push @handlers, "$phase-args=s" => \($self->{build_args}{$phase});
    }

    @handlers;
}

sub parse_options {
    my $self = shift;

    local @ARGV = @{$self->{argv}};
    push @ARGV, grep length, split /\s+/, $self->env('OPT');
    push @ARGV, @_;

    Getopt::Long::Configure("bundling");
    Getopt::Long::GetOptions(
        'f|force'   => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
        'n|notest!' => \$self->{notest},
        'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
        'S|sudo!'   => \$self->{sudo},
        'v|verbose' => \$self->{verbose},
        'verify!'   => \$self->{verify},
        'q|quiet!'  => \$self->{quiet},
        'h|help'    => sub { $self->{action} = 'show_help' },
        'V|version' => sub { $self->{action} = 'show_version' },
        'perl=s'    => sub {
            $self->diag("--perl is deprecated since it's known to be fragile in figuring out dependencies. Run `$_[1] -S cpanm` instead.\n", 1);
            $self->{perl} = $_[1];
        },
        'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
        'L|local-lib-contained=s' => sub {
            $self->{local_lib} = $self->maybe_abs($_[1]);
            $self->{self_contained} = 1;
            $self->{pod2man} = undef;
        },
        'self-contained!' => \$self->{self_contained},
        'exclude-vendor!' => \$self->{exclude_vendor},
        'mirror=s@' => $self->{mirrors},
        'mirror-only!' => \$self->{mirror_only},
        'mirror-index=s' => sub { $self->{mirror_index} = $self->maybe_abs($_[1]) },
        'M|from=s' => sub {
            $self->{mirrors}     = [$_[1]];
            $self->{mirror_only} = 1;
        },
        'cpanmetadb=s'    => \$self->{cpanmetadb},
        'cascade-search!' => \$self->{cascade_search},
        'prompt!'   => \$self->{prompt},
        'installdeps' => \$self->{installdeps},
        'skip-installed!' => \$self->{skip_installed},
        'skip-satisfied!' => \$self->{skip_satisfied},
        'reinstall'    => sub { $self->{skip_installed} = 0 },
        'interactive!' => \$self->{interactive},
        'i|install'    => sub { $self->{cmd} = 'install' },
        'info'         => sub { $self->{cmd} = 'info' },
        'look'         => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
        'U|uninstall'  => sub { $self->{cmd} = 'uninstall' },
        'self-upgrade' => sub { $self->{action} = 'self_upgrade' },
        'uninst-shadows!'  => \$self->{uninstall_shadows},
        'lwp!'    => \$self->{try_lwp},
        'wget!'   => \$self->{try_wget},
        'curl!'   => \$self->{try_curl},
        'auto-cleanup=s' => \$self->{auto_cleanup},
        'man-pages!' => \$self->{pod2man},
        'scandeps'   => \$self->{scandeps},
        'showdeps'   => sub { $self->{showdeps} = 1; $self->{skip_installed} = 0 },
        'format=s'   => \$self->{format},
        'save-dists=s' => sub {
            $self->{save_dists} = $self->maybe_abs($_[1]);
        },
        'skip-configure!' => \$self->{skip_configure},
        'static-install!' => \$self->{static_install},
        'dev!'       => \$self->{dev_release},
        'metacpan!'  => \$self->{metacpan},
        'report-perl-version!' => \$self->{report_perl_version},
        'configure-timeout=i' => \$self->{configure_timeout},
        'build-timeout=i' => \$self->{build_timeout},
        'test-timeout=i' => \$self->{test_timeout},
        'with-develop' => \$self->{with_develop},
        'without-develop' => sub { $self->{with_develop} = 0 },
        'with-configure' => \$self->{with_configure},
        'without-configure' => sub { $self->{with_configure} = 0 },
        'with-feature=s' => sub { $self->{features}{$_[1]} = 1 },
        'without-feature=s' => sub { $self->{features}{$_[1]} = 0 },
        'with-all-features' => sub { $self->{features}{__all} = 1 },
        'pp|pureperl!' => \$self->{pure_perl},
        "cpanfile=s" => \$self->{cpanfile_path},
        $self->install_type_handlers,
        $self->build_args_handlers,
    );

    if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
        push @ARGV, $self->load_argv_from_fh(\*STDIN);
        $self->{load_from_stdin} = 1;
    }

    $self->{argv} = \@ARGV;
}

sub check_upgrade {
    my $self = shift;
    my $install_base = $ENV{PERL_LOCAL_LIB_ROOT} ? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}) : $Config{installsitebin};
    if ($0 eq '-') {
        # run from curl, that's fine
        return;
    } elsif ($0 !~ /^$install_base/) {
        if ($0 =~ m!perlbrew/bin!) {
            die <<DIE;

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


        push @argv, split ' ', $line if $line;
    }
    return @argv;
}

sub show_version {
    my $self = shift;

    print "cpanm ($self->{name}) version $VERSION ($0)\n";
    print "perl version $] ($^X)\n\n";

    print "  \%Config:\n";
    for my $key (qw( archname installsitelib installsitebin installman1dir installman3dir
                     sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp )) {
        print "    $key=$Config{$key}\n" if $Config{$key};
    }

    print "  \%ENV:\n";
    for my $key (grep /^PERL/, sort keys %ENV) {
        print "    $key=$ENV{$key}\n";
    }

    print "  \@INC:\n";
    for my $inc (@INC) {
        print "    $inc\n" unless ref($inc) eq 'CODE';
    }

    return 1;
}

sub show_help {
    my $self = shift;

    if ($_[0]) {
        print <<USAGE;
Usage: cpanm [options] Module [...]

Try `cpanm --help` or `man cpanm` for more options.
USAGE
        return;
    }

    print <<HELP;
Usage: cpanm [options] Module [...]

Options:
  -v,--verbose              Turns on chatty output
  -q,--quiet                Turns off the most output
  --interactive             Turns on interactive configure (required for Task:: modules)
  -f,--force                force install
  -n,--notest               Do not run unit tests
  --test-only               Run tests only, do not install
  -S,--sudo                 sudo to run install commands
  --installdeps             Only install dependencies
  --showdeps                Only display direct dependencies
  --reinstall               Reinstall the distribution even if you already have the latest version installed
  --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
  --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
  -M,--from                 Use only this mirror base URL and its index file
  --prompt                  Prompt when configure/build/test fails
  -l,--local-lib            Specify the install base to install modules
  -L,--local-lib-contained  Specify the install base to install all non-core modules
  --self-contained          Install all non-core modules, even if they're already installed.
  --auto-cleanup            Number of days that cpanm's work directories expire in. Defaults to 7

Commands:
  --self-upgrade            upgrades itself
  --info                    Displays distribution info on CPAN
  --look                    Opens the distribution with your SHELL
  -U,--uninstall            Uninstalls the modules (EXPERIMENTAL)
  -V,--version              Displays software version

Examples:

  cpanm Test::More                                          # install Test::More
  cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
  cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
  cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
  cpanm --interactive Task::Kensho                          # Configure interactively
  cpanm .                                                   # install from local directory
  cpanm --installdeps .                                     # install all the deps for the current directory
  cpanm -L extlib Plack                                     # install Plack and all non-core deps into extlib
  cpanm --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
  cpanm -M https://cpan.metacpan.org App::perlbrew          # use only this secure mirror and its index

You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:

  export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"

Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.

HELP

    return 1;
}

sub _writable {
    my $dir = shift;
    my @dir = File::Spec->splitdir($dir);
    while (@dir) {
        $dir = File::Spec->catdir(@dir);
        if (-e $dir) {
            return -w _;
        }
        pop @dir;
    }

    return;
}

sub maybe_abs {
    my($self, $lib) = @_;
    if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)) {
        return $lib;
    } else {
        return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(), $lib));
    }
}

sub local_lib_target {
    my($self, $root) = @_;
    # local::lib 1.008025 changed the order of PERL_LOCAL_LIB_ROOT
    (grep { $_ ne '' } split /\Q$Config{path_sep}/, $root)[0];
}

sub bootstrap_local_lib {
    my $self = shift;

    # If -l is specified, use that.
    if ($self->{local_lib}) {
        return $self->setup_local_lib($self->{local_lib});
    }

    # PERL_LOCAL_LIB_ROOT is defined. Run as local::lib mode without overwriting ENV
    if ($ENV{PERL_LOCAL_LIB_ROOT} && $ENV{PERL_MM_OPT}) {
        return $self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}), 1);
    }

    # root, locally-installed perl or --sudo: don't care about install_base
    return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));

    # local::lib is configured in the shell -- yay
    if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
        return;
    }

    $self->setup_local_lib;

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

        'ExtUtils::Install' => '1.46',
    });

    if ($deps{"ExtUtils::MakeMaker"}) {
        $deps{"ExtUtils::MakeMaker"}->merge_with($reqs);
    } elsif ($deps{"Module::Build"}) {
        $deps{"Module::Build"}->merge_with($reqs);
        $deps{"ExtUtils::Install"} ||= Menlo::Dependency->new("ExtUtils::Install", 0, 'configure');
        $deps{"ExtUtils::Install"}->merge_with($reqs);
    }

    @$config_deps = values %deps;
}

sub _core_only_inc {
    my($self, $base) = @_;
    require local::lib;
    (
        local::lib->resolve_path(local::lib->install_base_arch_path($base)),
        local::lib->resolve_path(local::lib->install_base_perl_path($base)),
        (!$self->{exclude_vendor} ? grep {$_} @Config{qw(vendorarch vendorlibexp)} : ()),
        @Config{qw(archlibexp privlibexp)},
    );
}

sub _setup_local_lib_env {
    my($self, $base) = @_;

    $self->diag(<<WARN, 1) if $base =~ /\s/;
WARNING: Your lib directory name ($base) contains a space in it. It's known to cause issues with perl builder tools such as local::lib and MakeMaker. You're recommended to rename your directory.
WARN

    local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
    local::lib->setup_env_hash_for($base, 0);
}

sub setup_local_lib {
    my($self, $base, $no_env) = @_;
    $base = undef if $base eq '_';

    require local::lib;
    {
        local $0 = 'cpanm'; # so curl/wget | perl works
        $base ||= "~/perl5";
        $base = local::lib->resolve_path($base);
        if ($self->{self_contained}) {
            my @inc = $self->_core_only_inc($base);
            $self->{search_inc} = [ @inc ];
        } else {
            $self->{search_inc} = [
                local::lib->install_base_arch_path($base),
                local::lib->install_base_perl_path($base),
                @INC,
            ];
        }
        $self->_setup_local_lib_env($base) unless $no_env;
        $self->{local_lib} = $base;
    }
}

sub prompt_bool {
    my($self, $mess, $def) = @_;

    my $val = $self->prompt($mess, $def);
    return lc $val eq 'y';
}

sub prompt {
    my($self, $mess, $def) = @_;

    my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
    my $dispdef = defined $def ? "[$def] " : " ";
    $def = defined $def ? $def : "";

    if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
        return $def;
    }

    local $|=1;
    local $\;
    my $ans;
    eval {
        local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
        print STDOUT "$mess $dispdef";
        alarm $self->{prompt_timeout} if $self->{prompt_timeout};
        $ans = <STDIN>;
        alarm 0;
    };
    if ( defined $ans ) {
        chomp $ans;
    } else { # user hit ctrl-D or alarm timeout
        print STDOUT "\n";
    }

    return (!defined $ans || $ans eq '') ? $def : $ans;
}

sub diag_ok {
    my($self, $msg) = @_;
    chomp $msg;
    $msg ||= "OK";
    if ($self->{in_progress}) {
        $self->_diag("$msg\n");
        $self->{in_progress} = 0;
    }
    $self->log("-> $msg\n");
}

sub diag_fail {
    my($self, $msg, $always) = @_;
    chomp $msg;
    if ($self->{in_progress}) {
        $self->_diag("FAIL\n");
        $self->{in_progress} = 0;
    }

    if ($msg) {
        $self->_diag("! $msg\n", $always, 1);
        $self->log("-> FAIL $msg\n");
    }
}

sub diag_progress {
    my($self, $msg) = @_;
    chomp $msg;
    $self->{in_progress} = 1;
    $self->_diag("$msg ... ");
    $self->log("$msg\n");
}

sub _diag {
    my($self, $msg, $always, $error) = @_;
    my $fh = $error ? *STDERR : *STDOUT;
    print {$fh} $msg if $always or $self->{verbose} or !$self->{quiet};
}

sub diag {
    my($self, $msg, $always) = @_;
    $self->_diag($msg, $always);
    $self->log($msg);
}

sub chat {
    my $self = shift;
    print STDERR @_ if $self->{verbose};

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

    if (exists $ENV{PERL_USE_UNSAFE_INC}) {
        return $ENV{PERL_USE_UNSAFE_INC};
    }

    # it's set in CPAN Meta, prefer what the author says
    if (exists $dist->{meta}{x_use_unsafe_inc}) {
        $self->chat("Distribution opts in x_use_unsafe_inc: $dist->{meta}{x_use_unsafe_inc}\n");
        return $dist->{meta}{x_use_unsafe_inc};
    }

    # otherwise set to 1 as a default to allow for old modules
    return 1;
}

sub configure {
    my($self, $cmd, $dist, $depth) = @_;

    # trick AutoInstall
    local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;

    # e.g. skip CPAN configuration on local::lib
    local $ENV{PERL5_CPANM_IS_RUNNING} = $$;

    my $use_default = !$self->{interactive};
    local $ENV{PERL_MM_USE_DEFAULT} = $use_default;

    local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
    local $ENV{PERL_MB_OPT} = $ENV{PERL_MB_OPT};

    # skip man page generation
    unless ($self->{pod2man}) {
        $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
        $ENV{PERL_MB_OPT} .= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir=";
    }

    # Lancaster Consensus
    if ($self->{pure_perl}) {
        $ENV{PERL_MM_OPT} .= " PUREPERL_ONLY=1";
        $ENV{PERL_MB_OPT} .= " --pureperl-only";
    }

    local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);

    $cmd = $self->append_args($cmd, 'configure') if $depth == 0;

    local $self->{verbose} = $self->{verbose} || $self->{interactive};
    $self->run_timeout($cmd, $self->{configure_timeout});
}

sub build {
    my($self, $cmd, $distname, $dist, $depth) = @_;

    local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};

    local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);

    $cmd = $self->append_args($cmd, 'build') if $depth == 0;

    return 1 if $self->run_timeout($cmd, $self->{build_timeout});
    while (1) {
        my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
        return                                              if $ans eq 's';
        return $self->build($cmd, $distname, $dist, $depth) if $ans eq 'r';
        $self->show_build_log                               if $ans eq 'e';
        $self->look                                         if $ans eq 'l';
    }
}

sub test {
    my($self, $cmd, $distname, $dist, $depth) = @_;
    return 1 if $self->{notest};

    # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
    local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};

    # https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md
    local $ENV{NONINTERACTIVE_TESTING} = !$self->{interactive};

    local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);

    $cmd = $self->append_args($cmd, 'test') if $depth == 0;

    return 1 if $self->run_timeout($cmd, $self->{test_timeout});
    if ($self->{force}) {
        $self->diag_fail("Testing $distname failed but installing it anyway.");
        return 1;
    } else {
        $self->diag_fail;
        while (1) {
            my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
            return                                             if $ans eq 's';
            return $self->test($cmd, $distname, $dist, $depth) if $ans eq 'r';
            return 1                                           if $ans eq 'f';
            $self->show_build_log                              if $ans eq 'e';
            $self->look                                        if $ans eq 'l';
        }
    }
}

sub install {
    my($self, $cmd, $uninst_opts, $dist, $depth) = @_;

    if ($depth == 0 && $self->{test_only}) {
        return 1;
    }

    return $self->run_command($cmd) if ref $cmd eq 'CODE';

    local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);

    if ($self->{sudo}) {
        unshift @$cmd, "sudo";
    }

    if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
        push @$cmd, @$uninst_opts;
    }

    $cmd = $self->append_args($cmd, 'install') if $depth == 0;

    $self->run_command($cmd);
}

sub look {
    my $self = shift;

    my $shell = $ENV{SHELL};
    $shell  ||= $ENV{COMSPEC} if WIN32;
    if ($shell) {
        my $cwd = Cwd::cwd;
        $self->diag("Entering $cwd with $shell\n");
        system $shell;
    } else {
        $self->diag_fail("You don't seem to have a SHELL :/");
    }
}

sub show_build_log {
    my $self = shift;

    my @pagers = (
        $ENV{PAGER},
        (WIN32 ? () : ('less')),
        'more'
    );
    my $pager;
    while (@pagers) {
        $pager = shift @pagers;
        next unless $pager;
        $pager = which($pager);

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

        return unless $_ eq '.packlist' && -f $_;
        for my $file ($self->unpack_packlist($File::Find::name)) {
            $packlist ||= $File::Find::name if $file eq $metadata->filename;
        }
    };

    {
        require File::pushd;
        my $pushd = File::pushd::pushd();
        my @search = grep -d $_, map File::Spec->catdir($_, 'auto'), @$inc;
        File::Find::find($wanted, @search);
    }

    return $metadata, $packlist;
}

sub uninstall_target {
    my($self, $metadata, $packlist) = @_;

    # If the module has a shadow install, or uses local::lib, then you can't just remove
    # all files in .packlist since it might have shadows in there
    if ($self->has_shadow_install($metadata) or $self->{local_lib}) {
        grep $self->should_unlink($_), $self->unpack_packlist($packlist);
    } else {
        $self->unpack_packlist($packlist);
    }
}

sub has_shadow_install {
    my($self, $metadata) = @_;

    # check if you have the module in site_perl *and* perl
    my @shadow = grep defined, map Module::Metadata->new_from_module($metadata->name, inc => [$_]), @INC;
    @shadow >= 2;
}

sub should_unlink {
    my($self, $file) = @_;

    # If local::lib is used, everything under the directory can be safely removed
    # Otherwise, bin and man files might be shared with the shadows i.e. site_perl vs perl
    # This is not 100% safe to keep the script there hoping to work with older version of .pm
    # files in the shadow, but there's nothing you can do about it.
    if ($self->{local_lib}) {
        $file =~ /^\Q$self->{local_lib}\E/;
    } else {
        !(grep $file =~ /^\Q$_\E/, @Config{qw(installbin installscript installman1dir installman3dir)});
    }
}

sub ask_permission {
    my ($self, $module, $files) = @_;

    $self->diag("$module contains the following files:\n\n");
    for my $file (@$files) {
        $self->diag("  $file\n");
    }
    $self->diag("\n");

    return 'force uninstall' if $self->{force};
    local $self->{prompt} = 1;
    return $self->prompt_bool("Are you sure you want to uninstall $module?", 'y');
}

sub unpack_packlist {
    my ($self, $packlist) = @_;
    open my $fh, '<', $packlist or die "$packlist: $!";
    map { chomp; $_ } <$fh>;
}

sub uninstall_files {
    my ($self, @files) = @_;

    $self->diag("\n");

    for my $file (@files) {
        $self->diag("Unlink: $file\n");
        unlink $file or $self->diag_fail("$!: $file");
    }

    $self->diag("\n");

    return 1;
}

sub format_dist {
    my($self, $dist) = @_;

    # TODO support --dist-format?
    return "$dist->{cpanid}/$dist->{filename}";
}

sub trim {
    local $_ = shift;
    tr/\n/ /d;
    s/^\s*|\s*$//g;
    $_;
}

sub fetch_module {
    my($self, $dist) = @_;

    $self->chdir($self->{base});

    for my $uri (@{$dist->{uris}}) {
        $self->mask_output( diag_progress => "Fetching $uri" );

        # Ugh, $dist->{filename} can contain sub directory
        my $filename = $dist->{filename} || $uri;
        my $name = File::Basename::basename($filename);

        my $cancelled;
        my $fetch = sub {
            my $file;
            eval {
                local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
                $self->mirror($uri, $name);
                $file = $name if -e $name;
            };
            $self->diag("ERROR: " . trim("$@") . "\n", 1) if $@ && $@ ne "SIGINT\n";
            return $file;
        };

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

sub install_deps {
    my($self, $dir, $depth, @deps) = @_;

    my(@install, %seen, @fail);
    for my $dep (@deps) {
        next if $seen{$dep->module};
        if ($dep->module eq 'perl') {
            if ($dep->is_requirement && !$self->check_perl_version($dep->version)) {
                $self->diag("Needs perl @{[$dep->version]}, you have $]\n");
                push @fail, 'perl';
            }
        } elsif ($self->should_install($dep->module, $dep->version)) {
            push @install, $dep;
            $seen{$dep->module} = 1;
        }
    }

    if (@install) {
        $self->diag("==> Found dependencies: " . join(", ",  map $_->module, @install) . "\n");
    }

    for my $dep (@install) {
        $self->install_module($dep->module, $depth + 1, $dep->version, $dep);
    }

    $self->chdir($self->{base});
    $self->chdir($dir) if $dir;

    if ($self->{scandeps}) {
        return 1; # Don't check if dependencies are installed, since with --scandeps they aren't
    }
    my @not_ok = $self->unsatisfied_deps(@deps);
    if (@not_ok) {
        return 0, \@not_ok;
    } else {
        return 1;
    }
}

sub unsatisfied_deps {
    my($self, @deps) = @_;

    require CPAN::Meta::Check;
    require CPAN::Meta::Requirements;

    my $reqs = CPAN::Meta::Requirements->new;
    for my $dep (grep $_->is_requirement, @deps) {
        $reqs->add_string_requirement($dep->module => $dep->requires_version || '0');
    }

    my $ret = CPAN::Meta::Check::check_requirements($reqs, 'requires', $self->{search_inc});
    grep defined, values %$ret;
}

sub install_deps_bailout {
    my($self, $target, $dir, $depth, @deps) = @_;

    my($ok, $fail) = $self->install_deps($dir, $depth, @deps);
    if (!$ok) {
        $self->diag_fail("Installing the dependencies failed: " . join(", ", @$fail), 1);
        unless ($self->prompt_bool("Do you want to continue building $target anyway?", "n")) {
            $self->diag_fail("Bailing out the installation for $target.", 1);
            return;
        }
    }

    return 1;
}

sub build_stuff {
    my($self, $stuff, $dist, $depth) = @_;

    if ($self->{verify} && -e 'SIGNATURE') {
        $self->verify_signature($dist) or return;
    }

    require CPAN::Meta;

    my($meta_file) = grep -f, qw(META.json META.yml);
    if ($meta_file) {
        $self->chat("Checking configure dependencies from $meta_file\n");
        $dist->{cpanmeta} = eval { CPAN::Meta->load_file($meta_file) };
    } elsif ($dist->{dist} && $dist->{version}) {
        $self->chat("META.yml/json not found. Creating skeleton for it.\n");
        $dist->{cpanmeta} = CPAN::Meta->new({ name => $dist->{dist}, version => $dist->{version} });
    }

    $dist->{meta} = $dist->{cpanmeta} ? $dist->{cpanmeta}->as_struct : {};

    if ($self->opts_in_static_install($dist->{cpanmeta})) {
        $dist->{static_install} = 1;
    }

    my @config_deps;

    if ($dist->{cpanmeta}) {
        push @config_deps, Menlo::Dependency->from_prereqs(
            $dist->{cpanmeta}->effective_prereqs, ['configure'], $self->{install_types},
        );
    }

    if (-e 'Build.PL' && !@config_deps) {
        push @config_deps, Menlo::Dependency->from_versions(
            { 'Module::Build' => '0.38' }, 'configure',
        );
    }

    $self->merge_with_cpanfile($dist, \@config_deps);

    $self->upgrade_toolchain(\@config_deps);

    my $target = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};

    unless ($self->skip_configure($dist, $depth)) {
        $self->install_deps_bailout($target, $dist->{dir}, $depth, @config_deps)
          or return;
    }

    $self->diag_progress("Configuring $target");

    my $configure_state = $self->configure_this($dist, $depth);

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

    if ($self->{skip_configure}) {
        my $eumm = -e 'Makefile';
        my $mb   = -e 'Build' && -f _;
        return {
            configured => 1,
            configured_ok => $eumm || $mb,
            use_module_build => $mb,
        };
    }

    if ($deps_only && $self->no_dynamic_config($dist->{meta})) {
        return {
            configured => 1,
            configured_ok => exists $dist->{meta}{prereqs},
            use_module_build => 0,
        };
    }

    my $state = {};

    my $try_static = sub {
        if ($dist->{static_install}) {
            $self->chat("Distribution opts in x_static_install: $dist->{meta}{x_static_install}\n");
            $self->static_install_configure($state, $dist, $depth);
        }
    };

    my $try_eumm = sub {
        if (-e 'Makefile.PL') {
            $self->chat("Running Makefile.PL\n");

            # NOTE: according to Devel::CheckLib, most XS modules exit
            # with 0 even if header files are missing, to avoid receiving
            # tons of FAIL reports in such cases. So exit code can't be
            # trusted if it went well.
            if ($self->configure([ $self->{perl}, "Makefile.PL" ], $dist, $depth)) {
                $state->{configured_ok} = -e 'Makefile';
            }
            $state->{configured}++;
        }
    };

    my $try_mb = sub {
        if (-e 'Build.PL') {
            $self->chat("Running Build.PL\n");
            if ($self->configure([ $self->{perl}, "Build.PL" ], $dist, $depth)) {
                $state->{configured_ok} = -e 'Build' && -f _;
            }
            $state->{use_module_build}++;
            $state->{configured}++;
        }
    };

    for my $try ($try_static, $try_mb, $try_eumm) {
        $try->();
        last if $state->{configured_ok};
    }

    unless ($state->{configured_ok}) {
        while (1) {
            my $ans = lc $self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
            last                                        if $ans eq 's';
            return $self->configure_this($dist, $depth) if $ans eq 'r';
            $self->show_build_log                       if $ans eq 'e';
            $self->look                                 if $ans eq 'l';
        }
    }

    return $state;
}

sub static_install_configure {
    my($self, $state, $dist, $depth) = @_;

    my $args = $depth == 0 ? $self->{build_args}{configure} : [];

    require Menlo::Builder::Static;
    my $builder = Menlo::Builder::Static->new(meta => $dist->{cpanmeta});
    $self->configure(sub { $builder->configure($args || []) }, $dist, $depth);

    $state->{configured_ok} = 1;
    $state->{static_install} = $builder;
    $state->{configured}++;
}

sub find_module_name {
    my($self, $state) = @_;

    return unless $state->{configured_ok};

    if ($state->{use_module_build} &&
        -e "_build/build_params") {
        my $params = do { open my $in, "_build/build_params"; eval(join "", <$in>) };
        return eval { $params->[2]{module_name} } || undef;
    } elsif (-e "Makefile") {
        open my $mf, "Makefile";
        while (<$mf>) {
            if (/^\#\s+NAME\s+=>\s+(.*)/) {
                return eval($1);
            }
        }
    }

    return;
}

sub list_files {
    my $self = shift;

    if (-e 'MANIFEST') {
        require ExtUtils::Manifest;
        my $manifest = eval { ExtUtils::Manifest::manifind() } || {};
        return sort { lc $a cmp lc $b } keys %$manifest;
    } else {
        require File::Find;
        my @files;
        my $finder = sub {
            my $name = $File::Find::name;
            $name =~ s!\.[/\\]!!;
            push @files, $name;
        };

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


    require JSON::PP;
    open my $fh, ">", "blib/meta/install.json" or die $!;
    print $fh JSON::PP::encode_json($local);

    File::Copy::copy("MYMETA.json", "blib/meta/MYMETA.json");

    my @cmd = (
        ($self->{sudo} ? 'sudo' : ()),
        $^X,
        '-MExtUtils::Install=install',
        '-e',
        qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],
    );
    $self->run_command(\@cmd);
}

sub install_base {
    my($self, $mm_opt) = @_;
    $mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;
    die "Your PERL_MM_OPT doesn't contain INSTALL_BASE";
}

sub configure_features {
    my($self, $dist, @features) = @_;
    map $_->identifier, grep { $self->effective_feature($dist, $_) } @features;
}

sub effective_feature {
    my($self, $dist, $feature) = @_;

    if ($dist->{depth} == 0) {
        my $value = $self->{features}{$feature->identifier};
        return $value if defined $value;
        return 1 if $self->{features}{__all};
    }

    if ($self->{interactive}) {
        require CPAN::Meta::Requirements;

        $self->diag("[@{[ $feature->description ]}]\n", 1);

        my $req = CPAN::Meta::Requirements->new;
        for my $phase (@{$dist->{want_phases}}) {
            for my $type (@{$self->{install_types}}) {
                $req->add_requirements($feature->prereqs->requirements_for($phase, $type));
            }
        }

        my $reqs = $req->as_string_hash;
        my @missing;
        for my $module (keys %$reqs) {
            if ($self->should_install($module, $req->{$module})) {
                push @missing, $module;
            }
        }

        if (@missing) {
            my $howmany = @missing;
            $self->diag("==> Found missing dependencies: " . join(", ", @missing) . "\n", 1);
            local $self->{prompt} = 1;
            return $self->prompt_bool("Install the $howmany optional module(s)?", "y");
        }
    }

    return;
}

sub find_prereqs {
    my($self, $dist) = @_;

    my @deps = $self->extract_meta_prereqs($dist);

    if ($dist->{module} =~ /^Bundle::/i) {
        push @deps, $self->bundle_deps($dist);
    }

    $self->merge_with_cpanfile($dist, \@deps);

    return @deps;
}

sub merge_with_cpanfile {
    my($self, $dist, $deps) = @_;

    if ($self->{cpanfile_requirements} && !$dist->{cpanfile}) {
        for my $dep (@$deps) {
            $dep->merge_with($self->{cpanfile_requirements});
        }
    }

    if ($self->{cpanfile_global}) {
        for my $dep (@$deps) {
            my $opts = $self->{cpanfile_global}->options_for_module($dep->module)
              or next;

            $dep->dist($opts->{dist})     if $opts->{dist};
            $dep->mirror($opts->{mirror}) if $opts->{mirror};
            $dep->url($opts->{url})       if $opts->{url};
        }
    }
}

sub extract_meta_prereqs {
    my($self, $dist) = @_;

    if ($dist->{cpanfile}) {
        my @features = $self->configure_features($dist, $dist->{cpanfile}->features);
        my $prereqs = $dist->{cpanfile}->prereqs_with(@features);
        # TODO: creating requirements is useful even without cpanfile to detect conflicting prereqs
        $self->{cpanfile_requirements} = $prereqs->merged_requirements($dist->{want_phases}, ['requires']);
        return Menlo::Dependency->from_prereqs($prereqs, $dist->{want_phases}, $self->{install_types});
    }

    require CPAN::Meta;

    my @meta = qw(MYMETA.json MYMETA.yml);
    if ($self->no_dynamic_config($dist->{meta})) {
        push @meta, qw(META.json META.yml);
    }

    my @deps;



( run in 1.541 second using v1.01-cache-2.11-cpan-6aa56a78535 )