view release on metacpan or  search on metacpan

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

        pureperl_only => 0,
        static_install => 1,
        use_install_command => 0,
        default_resolvers => 1,
        report_perl_version => !$class->maybe_ci,
        %argv
    }, $class;
}

sub maybe_ci ($class) {
    !!grep $ENV{$_}, qw(CI AUTOMATED_TESTING AUTHOR_TESTING);
}

sub _normalize_progress ($self, $progress) {
    return if !defined $progress;
    return $progress if $progress =~ /\A(?:auto|tty|plain)\z/;
    die "Unknown --progress mode '$progress' (expected: auto, tty, plain)\n";
}

sub _normalize_final_install ($self, $final_install) {
    return if !defined $final_install;
    return $final_install if $final_install =~ /\A(?:runtime|all)\z/;
    die "Unknown --final-install mode '$final_install' (expected: runtime, all)\n";
}

sub _normalize_top_level_phase ($self, $phase) {
    return $phase if grep { $phase eq $_ } @TOP_LEVEL_PHASE;
    die "Unknown --top-level-phase '$phase' (expected: configure, build, test, runtime, develop)\n";
}

sub _normalize_top_level_relationship ($self, $relationship) {
    return $relationship if grep { $relationship eq $_ } @TOP_LEVEL_RELATIONSHIP;
    die "Unknown --top-level-relationship '$relationship' (expected: requires, recommends, suggests)\n";
}

sub _set_top_level_phase ($self, @phase) {
    my %selected;
    for my $value (@phase) {
        $selected{$self->_normalize_top_level_phase($_)} = 1 for split /,/, $value;
    }
    $self->{top_level_phase} = [grep { $selected{$_} } @TOP_LEVEL_PHASE];
}

sub _set_top_level_relationship ($self, @relationship) {
    my %selected;
    for my $value (@relationship) {
        $selected{$self->_normalize_top_level_relationship($_)} = 1 for split /,/, $value;
    }
    $self->{top_level_relationship} = [grep { $selected{$_} } @TOP_LEVEL_RELATIONSHIP];
}

sub _warn_deprecated_top_level_option ($self, $option) {
    warn "$option is deprecated; use --top-level-phase and/or --top-level-relationship instead.\n";
}

sub _progress_default ($self) {
    !WIN32 && !$self->maybe_ci && !$self->{verbose} && -t STDERR && terminal_width > 60 ? "tty" : "plain";
}

sub parse_options ($self, @argv) {
    local @ARGV = @argv;
    my ($mirror, @resolver, @feature, $top_level_phase, $top_level_relationship);
    my $with_relationship_option = sub ($relationship) {
        (
            "with-$relationship",
            sub (@) {
                $self->_warn_deprecated_top_level_option("--with-$relationship");
                $self->_set_top_level_relationship($self->{top_level_relationship}->@*, $relationship);
            },
            "without-$relationship",
            sub (@) {
                $self->_warn_deprecated_top_level_option("--without-$relationship");
                $self->_set_top_level_relationship(grep { $_ ne $relationship } $self->{top_level_relationship}->@*);
            },
        );
    };
    my $with_phase_option = sub ($phase) {
        (
            "with-$phase",
            sub (@) {
                $self->_warn_deprecated_top_level_option("--with-$phase");
                $self->_set_top_level_phase($self->{top_level_phase}->@*, $phase);
            },
            "without-$phase",
            sub (@) {
                $self->_warn_deprecated_top_level_option("--without-$phase");
                $self->_set_top_level_phase(grep { $_ ne $phase } $self->{top_level_phase}->@*);
            },
        );
    };

    GetOptions
        "L|local-lib-contained=s" => \($self->{local_lib}),
        "color!" => \($self->{color}),
        "g|global" => \($self->{global}),
        "mirror=s" => \$mirror,
        "v|verbose" => \($self->{verbose}),
        "w|workers=i" => \($self->{workers}),
        "target-perl=s" => \my $target_perl,
        "test!" => sub ($, $value, @) { $self->{notest} = $value ? 0 : 1 },
        "cpanfile=s" => sub ($, $value, @) { $self->{dependency_file} = { type => "cpanfile", path => $value } },
        "cpmfile=s" => sub ($, $value, @) { $self->{dependency_file} = { type => "cpmfile", path => $value } },
        "metafile=s" => sub ($, $value, @) { $self->{dependency_file} = { type => "metafile", path => $value } },
        "snapshot=s" => \($self->{snapshot}),
        "r|resolver=s@" => \@resolver,
        "default-resolvers!" => \($self->{default_resolvers}),
        "mirror-only" => \($self->{mirror_only}),
        "dev" => \($self->{dev}),
        "man-pages" => \($self->{man_pages}),
        "home=s" => \($self->{home}),
        "retry!" => sub (@) {},
        "exclude-vendor!" => \($self->{exclude_vendor}),
        "configure-timeout=i" => \($self->{configure_timeout}),
        "build-timeout=i" => \($self->{build_timeout}),
        "test-timeout=i" => \($self->{test_timeout}),
        "final-install=s" => sub ($, $value, @) { $self->{final_install} = $self->_normalize_final_install($value) },
        "progress=s" => sub ($, $value, @) { $self->{progress} = $self->_normalize_progress($value) },
        "show-progress!" => sub (@) {},
        "prebuilt!" => \($self->{prebuilt}),
        "reinstall" => \($self->{reinstall}),
        "pp|pureperl|pureperl-only" => \($self->{pureperl_only}),