view release on metacpan or  search on metacpan

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

        opt      => 'debug'
    },

    {
        d_option => 'cc=clang',
        opt      => 'clang'
    },
);

my %flavor;
my $flavor_ix = 0;
for (@flavors) {
    my ($name) = $_->{opt} =~ /([^|]+)/;
    $_->{name}     = $name;
    $_->{ix}       = ++$flavor_ix;
    $flavor{$name} = $_;
}
for (@flavors) {
    if ( my $implies = $_->{implies} ) {
        $flavor{$implies}{implied_by} = $_->{name};
    }
}

my %command_aliases = (
    'rm' => 'uninstall',
    'delete' => 'uninstall',
);

sub resolve_command_alias {
    my $x = shift;
    $command_aliases{$x};
}

### methods
sub new {
    my ( $class, @argv ) = @_;

    my %opt = (
        original_argv => \@argv,
        args          => [],
        yes           => 0,
        force         => 0,
        quiet         => 0,
        D             => [],
        U             => [],
        A             => [],
        sitecustomize => '',
        destdir       => '',
        noman         => '',
        variation     => '',
        both          => [],
        append        => '',
        reverse       => 0,
        verbose       => 0,
    );

    $opt{$_} = '' for keys %flavor;

    if (@argv) {

        # build a local @ARGV to allow us to use an older
        # Getopt::Long API in case we are building on an older system
        local (@ARGV) = @argv;

        Getopt::Long::Configure(
            'pass_through',
            'no_ignore_case',
            'bundling',
            'permute',    # default behaviour except 'exec'
        );

        $class->parse_cmdline( \%opt );

        $opt{args} = \@ARGV;

        # fix up the effect of 'bundling'
        foreach my $flags ( @opt{qw(D U A)} ) {
            foreach my $value ( @{$flags} ) {
                $value =~ s/^=//;
            }
        }
    }

    my $self = bless \%opt, $class;

    # Treat --root option same way as env variable PERLBREW_ROOT (with higher priority)
    if ( $opt{root} ) {
        $ENV{PERLBREW_ROOT} = $self->root( $opt{root} );
    }

    if ( $opt{builddir} ) {
        $self->{builddir} = App::Perlbrew::Path->new( $opt{builddir} );
    }

    # Ensure propagation of $PERLBREW_HOME and $PERLBREW_ROOT
    $self->root;
    $self->home;

    if ( $self->{verbose} ) {
        $App::Perlbrew::HTTP::HTTP_VERBOSE = 1;
    }

    return $self;
}

sub parse_cmdline {
    my ( $self, $params, @ext ) = @_;

    my @f = map { $flavor{$_}{opt} || $_ } keys %flavor;

    return Getopt::Long::GetOptions(
        $params,

        'yes',
        'force|f',
        'reverse',
        'notest|n',
        'quiet|q',
        'verbose|v',
        'input|i=s',
        'output|o=s',
        'as=s',
        'append=s',

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

    if ( $new_version <= $VERSION ) {
        print "Your perlbrew is up-to-date (version $VERSION).\n" unless $self->{quiet};
        $TMP_PERLBREW->unlink;
        return;
    }

    print "Upgrading from $VERSION to $new_version\n" unless $self->{quiet};

    system $TMP_PERLBREW, "self-install";
    $TMP_PERLBREW->unlink;
}

sub run_command_uninstall {
    my ( $self, $target ) = @_;

    unless ($target) {
        $self->run_command_help("uninstall");
        exit(-1);
    }

    my @installed = $self->installed_perls(@_);

    my ($to_delete) = grep { $_->{name} eq $target } @installed;

    die "'$target' is not installed\n" unless $to_delete;

    my @dir_to_delete;
    for ( @{ $to_delete->{libs} } ) {
        push @dir_to_delete, $_->{dir};
    }
    push @dir_to_delete, $to_delete->{dir};

    my $ans = ( $self->{yes} ) ? "Y" : undef;
    if ( !defined($ans) ) {
        require ExtUtils::MakeMaker;
        $ans = ExtUtils::MakeMaker::prompt(
            "\nThe following perl+lib installation(s) will be deleted:\n\n\t"
                . join( "\n\t", @dir_to_delete )
                . "\n\n... are you sure ? [y/N]",
            "N"
        );
    }

    if ( $ans =~ /^Y/i ) {
        for (@dir_to_delete) {
            print "Deleting: $_\n" unless $self->{quiet};
            App::Perlbrew::Path->new($_)->rmpath;
            print "Deleted:  $_\n" unless $self->{quiet};
        }
    }
    else {
        print "\nOK. Not deleting anything.\n\n";
        return;
    }
}

sub run_command_exec {
    my $self = shift;
    my %opts;

    local (@ARGV) = @{ $self->{original_argv} };

    Getopt::Long::Configure( 'require_order', 'nopass_through' );
    my @command_options = ( 'with=s', 'halt-on-error', 'min=s', 'max=s' );

    $self->parse_cmdline( \%opts, @command_options );
    shift @ARGV;    # "exec"
    $self->parse_cmdline( \%opts, @command_options );

    my @exec_with;
    if ( $opts{with} ) {
        my %installed = map { $_->{name} => $_ } map { ( $_, @{ $_->{libs} } ) } $self->installed_perls;

        my $d    = ( $opts{with} =~ m/ / ) ? qr( +) : qr(,+);
        my @with = grep { $_ } map {
            my ( $p, $l ) = $self->resolve_installation_name($_);
            $p .= "\@$l" if $l;
            $p;
        } split $d, $opts{with};

        @exec_with = map { $installed{$_} } @with;
    }
    else {
        @exec_with = grep {
            not -l $self->root->perls( $_->{name} );    # Skip Aliases
        } map { ( $_, @{ $_->{libs} } ) } $self->installed_perls;
    }

    if ( $opts{min} ) {

        # TODO use comparable version.
        # For now, it doesn't produce consistent results for 5.026001 and 5.26.1
        @exec_with = grep { $_->{orig_version} >= $opts{min} } @exec_with;
    }

    if ( $opts{max} ) {
        @exec_with = grep { $_->{orig_version} <= $opts{max} } @exec_with;
    }

    if ( 0 == @exec_with ) {
        print "No perl installation found.\n" unless $self->{quiet};
    }

    my $no_header = 0;
    if ( 1 == @exec_with ) {
        $no_header = 1;
    }

    my $overall_success = 1;
    for my $i (@exec_with) {
        my %env = $self->perlbrew_env( $i->{name} );
        next if !$env{PERLBREW_PERL};

        local %ENV = %ENV;
        $ENV{$_}       = defined $env{$_} ? $env{$_} : '' for keys %env;
        $ENV{PATH}     = join( ':', $env{PERLBREW_PATH},    $ENV{PATH} );
        $ENV{MANPATH}  = join( ':', $env{PERLBREW_MANPATH}, $ENV{MANPATH} || "" );
        $ENV{PERL5LIB} = $env{PERL5LIB} || "";

        print "$i->{name}\n==========\n" unless $no_header || $self->{quiet};