view release on metacpan or  search on metacpan

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

    die "ERROR: Installation target \"${installation_name}\" already exists\n"
        if $installation_path->exists;

    my $path = $self->root->dists
        ->child("skaji-relocatable-perl")
        ->child($detail->{version})
        ->mkpath()
        ->child($detail->{original_filename});

    if (-f $path) {
        print "Re-using the downloaded $path\n";
    } else {
        my $url = $detail->{url};
        print "Downloading $url as $path\n";
        my $error = http_download( $detail->{url}, $path );
        if ($error) {
            die "Failed to download from $url\nError: $error";
        }
    }

    my $extracted_path = $self->do_extract_skaji_relocatable_perl_tarball($detail, $path);

    move $extracted_path, $installation_path;

    print "$installation_name is installed at $installation_path.\n";

    print "$installation_name is successfully installed.\n";
}

sub do_extract_skaji_relocatable_perl_tarball {
    my ($self, $detail, $tarball_path) = @_;

    my $workdir = $self->builddir
        ->child("skaji-relocatable-perl")
        ->child($detail->{version});

    $workdir->rmpath()
        if $workdir->exists();

    $workdir->mkpath();

    my $tarx = "tar xzf";
    my $extract_command = "cd $workdir; $tarx $tarball_path";

    system($extract_command) == 0
        or die "Failed to extract $tarball_path";

    my ($extracted_path) = $workdir->children;

    return $extracted_path;
}

sub do_install_program_from_url {
    my ( $self, $url, $program_name, $body_filter ) = @_;

    my $out = $self->root->bin($program_name);

    if ( -f $out && !$self->{force} && !$self->{yes} ) {
        require ExtUtils::MakeMaker;

        my $ans = ExtUtils::MakeMaker::prompt( "\n$out already exists, are you sure to override ? [y/N]", "N" );

        if ( $ans !~ /^Y/i ) {
            print "\n$program_name installation skipped.\n\n" unless $self->{quiet};
            return;
        }
    }

    my $body = http_get($url)
        or die "\nERROR: Failed to retrieve $program_name executable.\n\n";

    unless ( $body =~ m{\A#!/}s ) {
        my $x = App::Perlbrew::Path->new( $self->env('TMPDIR') || "/tmp", "${program_name}.downloaded.$$" );
        my $message =
"\nERROR: The downloaded $program_name program seem to be invalid. Please check if the following URL can be reached correctly\n\n\t$url\n\n...and try again latter.";

        unless ( -f $x ) {
            open my $OUT, ">", $x;
            print $OUT $body;
            close($OUT);
            $message .= "\n\nThe previously downloaded file is saved at $x for manual inspection.\n\n";
        }

        die $message;
    }

    if ( $body_filter && ref($body_filter) eq "CODE" ) {
        $body = $body_filter->($body);
    }

    $self->root->bin->mkpath;
    open my $OUT, '>', $out or die "cannot open file($out): $!";
    print $OUT $body;
    close $OUT;
    chmod 0755, $out;
    print "\n$program_name is installed to\n\n    $out\n\n" unless $self->{quiet};
}

sub do_exit_with_error_code {
    my ( $self, $code ) = @_;
    exit($code);
}

sub do_system_with_exit_code {
    my ( $self, @cmd ) = @_;
    return system(@cmd);
}

sub do_system {
    my ( $self, @cmd ) = @_;
    return !$self->do_system_with_exit_code(@cmd);
}

sub do_capture {
    my ( $self, @cmd ) = @_;
    return Capture::Tiny::capture(
        sub {
            $self->do_system(@cmd);
        }
    );
}

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

sub run_command_self_upgrade {
    my ($self) = @_;

    require FindBin;
    unless ( -w $FindBin::Bin ) {
        die "Your perlbrew installation appears to be system-wide.  Please upgrade through your package manager.\n";
    }

    my $TMPDIR       = $ENV{TMPDIR} || "/tmp";
    my $TMP_PERLBREW = App::Perlbrew::Path->new( $TMPDIR, "perlbrew" );

    http_download( 'https://raw.githubusercontent.com/gugod/App-perlbrew/master/perlbrew', $TMP_PERLBREW );

    chmod 0755, $TMP_PERLBREW;
    my $new_version = qx($TMP_PERLBREW version);
    chomp $new_version;
    if ( $new_version =~ /App::perlbrew\/(\d+\.\d+)$/ ) {
        $new_version = $1;
    }
    else {
        $TMP_PERLBREW->unlink;
        die "Unable to detect version of new perlbrew!\n";
    }

    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} ) {