view release on metacpan or  search on metacpan

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

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

    my @installed  = $self->installed_perls(@_);
    my $is_verbose = $self->{verbose};

    my @sections = ( ['perl', 'available_perl_distributions'] );

    for (@sections) {
        my ( $header, $method ) = @$_;

        print "# $header\n";

        my $perls = $self->$method;

        # sort the keys of Perl installation (Randal to the rescue!)
        my @sorted_perls = $self->sort_perl_versions( keys %$perls );

        for my $available (@sorted_perls) {
            my $url = $perls->{$available};
            my $ctime;

            for my $installed (@installed) {
                my $name = $installed->{name};
                my $cur  = $installed->{is_current};
                if ( $available eq $installed->{name} ) {
                    $ctime = $installed->{ctime};
                    last;
                }
            }

            printf "%1s %12s  %s %s\n", $ctime ? 'i' : '', $available,
                (
                  $is_verbose
                ? $ctime
                        ? "INSTALLED on $ctime via"
                        : 'available from '
                : ''
                ),
                ( $is_verbose ? "<$url>" : '' );
        }
        print "\n\n";
    }

    return;
}

sub available_perls {
    my ($self) = @_;
    my %dists = ( %{ $self->available_perl_distributions } );
    return $self->sort_perl_versions( keys %dists );
}

# -> Map[ NameVersion =>  URL ]
sub available_perl_distributions {
    my ($self) = @_;
    my $perls = {};
    my @perllist;

    # we got impatient waiting for cpan.org to get updated to show 5.28...
    # So, we also fetch from metacpan for anything that looks perlish,
    # and we do our own processing to filter out the development
    # releases and minor versions when needed (using
    # filter_perl_available)
    my $json = http_get('https://fastapi.metacpan.org/v1/release/versions/perl')
        or die "\nERROR: Unable to retrieve list of perls from Metacpan.\n\n";

    my $decoded = decode_json($json);
    for my $release ( @{ $decoded->{releases} } ) {
        next
            if !$release->{authorized};
        push @perllist, [$release->{name}, $release->{download_url}];
    }
    foreach my $perl ( $self->filter_perl_available( \@perllist ) ) {
        $perls->{ $perl->[0] } = $perl->[1];
    }

    return $perls;
}

# $perllist is an arrayref of arrayrefs.  The inner arrayrefs are of the
# format: [ <perl_name>, <perl_url> ]
#   perl_name = something like perl-5.28.0
#   perl_url  = URL the Perl is available from.
#
# If $self->{all} is true, this just returns a list of the contents of
# the list referenced by $perllist
#
# Otherwise, this looks for even middle numbers in the version and no
# suffix (like -RC1) following the URL, and returns the list of
# arrayrefs that so match
#
# If any "newest" Perl has a
sub filter_perl_available {
    my ( $self, $perllist ) = @_;

    if ( $self->{all} ) { return @$perllist; }

    my %max_release;
    foreach my $perl (@$perllist) {
        my $ver = $perl->[0];
        if ( $ver !~ m/^perl-5\.[0-9]*[02468]\.[0-9]+$/ ) { next; }    # most likely TRIAL or RC, or a DEV release

        my ( $release_line, $minor ) = $ver =~ m/^perl-5\.([0-9]+)\.([0-9]+)/;
        if ( exists $max_release{$release_line} ) {
            if ( $max_release{$release_line}->[0] > $minor ) { next; }    # We have a newer release
        }

        $max_release{$release_line} = [$minor, $perl];
    }

    return map { $_->[1] } values %max_release;
}

sub perl_release {
    my ( $self, $version ) = @_;
    my $mirror = $self->cpan_mirror();

    # try CPAN::Perl::Releases
    my $tarballs = CPAN::Perl::Releases::perl_tarballs($version);

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

    # dynamic methods: release_detail_perl_local, release_detail_perl_remote
    my $m_local  = "release_detail_${dist_type}_local";
    my $m_remote = "release_detail_${dist_type}_remote";

    unless ($self->can($m_local) && $self->can($m_remote)) {
        die "ERROR: Unknown dist type: $dist_type\n";
    }

    my ($error) = $self->$m_local( $dist, $rd );
    ($error) = $self->$m_remote( $dist, $rd ) if $error;

    if ($error) {
        die "ERROR: Fail to get the tarball URL for dist: $dist\n";
    }

    return $rd;
}

sub run_command_init {
    my $self = shift;
    my @args = @_;

    if ( @args && $args[0] eq '-' ) {
        if ( $self->current_shell_is_bashish ) {
            $self->run_command_init_in_bash;
        }
        exit 0;
    }

    $_->mkpath for ( grep { !-d $_ } map { $self->root->$_ } qw(perls dists build etc bin) );

    my ( $f, $fh ) = @_;

    my $etc_dir = $self->root->etc;

    for (
        ["bashrc",                   "BASHRC_CONTENT"],
        ["cshrc",                    "CSHRC_CONTENT"],
        ["csh_reinit",               "CSH_REINIT_CONTENT"],
        ["csh_wrapper",              "CSH_WRAPPER_CONTENT"],
        ["csh_set_path",             "CSH_SET_PATH_CONTENT"],
        ["perlbrew-completion.bash", "BASH_COMPLETION_CONTENT"],
        ["perlbrew.fish",            "PERLBREW_FISH_CONTENT"],
        )
    {
        my ( $file_name, $method ) = @$_;
        my $path = $etc_dir->child($file_name);
        if ( !-f $path ) {
            open( $fh, ">", $path )
                or die "Fail to create $path. Please check the permission of $etc_dir and try `perlbrew init` again.";
            print $fh $self->$method;
            close $fh;
        }
        else {
            if ( -w $path && open( $fh, ">", $path ) ) {
                print $fh $self->$method;
                close $fh;
            }
            else {
                print "NOTICE: $path already exists and not updated.\n" unless $self->{quiet};
            }
        }
    }

    my $root_dir = $self->root->stringify_with_tilde;

    # Skip this if we are running in a shell that already 'source's perlbrew.
    # This is true during a self-install/self-init.
    # Ref. https://github.com/gugod/App-perlbrew/issues/525
    if ( $ENV{PERLBREW_SHELLRC_VERSION} ) {
        print("\nperlbrew root ($root_dir) is initialized.\n");
    }
    else {
        my $shell = $self->current_shell;
        my ( $code, $yourshrc );
        if ( $shell =~ m/(t?csh)/ ) {
            $code     = "source $root_dir/etc/cshrc";
            $yourshrc = $1 . "rc";
        }
        elsif ( $shell =~ m/zsh\d?$/ ) {
            $code     = "source $root_dir/etc/bashrc";
            $yourshrc = $self->_firstrcfile(
                qw(
                    .zshenv
                    .bash_profile
                    .bash_login
                    .profile
                )
            ) || ".zshenv";
        }
        elsif ( $shell =~ m/fish/ ) {
            $code     = ". $root_dir/etc/perlbrew.fish";
            $yourshrc = '.config/fish/config.fish';
        }
        else {
            $code     = "source $root_dir/etc/bashrc";
            $yourshrc = $self->_firstrcfile(
                qw(
                    .bash_profile
                    .bash_login
                    .profile
                )
            ) || ".bash_profile";
        }

        if ( $self->home ne App::Perlbrew::Path->new( $self->env('HOME'), ".perlbrew" ) ) {
            my $pb_home_dir = $self->home->stringify_with_tilde;
            if ( $shell =~ m/fish/ ) {
                $code = "set -x PERLBREW_HOME $pb_home_dir\n    $code";
            }
            else {
                $code = "export PERLBREW_HOME=$pb_home_dir\n    $code";
            }
        }

        print <<INSTRUCTION;

perlbrew root ($root_dir) is initialized.

Append the following piece of code to the end of your ~/${yourshrc} and start a