view release on metacpan or  search on metacpan

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

or run '$brew_name mode shim' to use 'shim' mode which doesn't require a shell hook.
EOL
        exit 1;
    }

    my $arg = shift(@args) // 'help';

    if ($arg eq 'version' || $arg eq 'current') {
        if (my $c = get_version()) {
            if (@args && $args[0] eq '--short') {
                say "$c"
            }
            else {
                say "Currently running $c"
            }
        } else {
            say STDERR "Not running anything at the moment. Use '$brew_name switch' to set a version";
            exit 1;
        }

    } elsif ($arg eq 'versions' || $arg eq 'list') {
        my $cur = get_version() // '';
        map {
            my $version_line = '';
            $version_line .= 'BROKEN ' if is_version_broken($_);
            $version_line .= $_ eq $cur ? '* ' : '  ';
            $version_line .= $_;
            $version_line .= ' -> ' . (get_version_path($_, 1) || '') if is_registered_version($_);
            say $version_line;
        } get_versions();

    } elsif ($arg eq 'global' || $arg eq 'switch') {
        if (!@args) {
            my $version = get_global_version();
            if ($version) {
                say $version;
            }
            else {
                say "$brew_name: no global version configured";
            }
        }
        else {
            $self->match_and_run($args[0], sub {
                set_global_version(shift);
            });
        }

    } elsif ($arg eq 'shell') {
        if (!@args) {
            my $shell_version = get_shell_version();
            if (defined $shell_version) {
                say "$shell_version";
            }
            else {
                say "$brew_name: no shell-specific version configured";
            }
        }
        else {
            my $version = shift @args;
            if ($version ne '--unset') {
                verify_version($version);
            }
        }

    } elsif ($arg eq 'local') {
        validate_brew_mode();
        if (!@args) {
            my $version = get_local_version();
            if ($version) {
                say $version;
            }
            else {
                say "$brew_name: no local version configured for this directory";
            }
        }
        else {
            my $version = shift @args;
            if ($version eq '--unset') {
                set_local_version(undef);
            }
            else {
                $self->match_and_run($version, sub {
                    set_local_version(shift);
                });
            }
        }

    } elsif ($arg eq 'nuke' || $arg eq 'unregister') {
        my $version = shift @args;
        $self->nuke($version);

    } elsif ($arg eq 'rehash') {
        validate_brew_mode();
        rehash();

    } elsif ($arg eq 'list-available' || $arg eq 'available') {
        my ($cur_backend, $cur_rakudo) = split '-', (get_version() // ''), 2;
        $cur_backend //= '';
        $cur_rakudo  //= '';

        my @downloadables = App::Rakubrew::Download::available_precomp_archives();
        say "Available Rakudo versions:";
        map {
            my $ver = $_;
            my $d = (grep {$_->{ver} eq $ver} @downloadables) ? 'D' : ' ';
            my $s = $cur_rakudo eq $ver                       ? '*' : ' ';
            say "$s$d $ver";
        } App::Rakubrew::Build::available_rakudos();
        say '';
        $cur_backend |= '';
        $cur_rakudo |= '';
        say "Available backends:";
        map { say $cur_backend eq $_ ? "* $_" : "  $_" } App::Rakubrew::Variables::available_backends();

    } elsif ($arg eq 'build-rakudo' || $arg eq 'build') {
        my ($impl, $ver, @args) =
            App::Rakubrew::VersionHandling::match_version(@args);
        if (!$ver) {
            my @versions = App::Rakubrew::Build::available_rakudos();
            @versions = grep { /^\d\d\d\d\.\d\d/ } @versions;
            $ver = $versions[-1];

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

            $command = 'download-rakudo' if $command eq 'download';
            $command = 'build-rakudo'    if $command eq 'build';

            Pod::Usage::pod2usage(
                -exitval   => "NOEXIT",  # do not terminate this script!
                -verbose   => 99,        # 99 = indicate the sections
                -sections  => "COMMAND: " . lc( $command ), # e.g.: COMMAND: list
                -output    => $pod_fh,   # filehandle reference
                -noperldoc => 1          # do not call perldoc
            );

            # some cleanup
            $help_text =~ s/\A[^\n]+\n//s;
            $help_text =~ s/^    //gm;

            $help_text = "Cannot find documentation for [$command]!" if ($help_text =~ /\A\s*\Z/);
        }
        else {
            # Generic help or unknown command
            Pod::Usage::pod2usage(
                -exitval   => "NOEXIT",  # do not terminate this script!
                -verbose   => $verbose ? 2 : 1, # 1 = only SYNOPSIS, 2 = print everything
                -output    => $pod_fh,   # filehandle reference
                -noperldoc => 1          # do not call perldoc
            );
        }

        close $pod_fh;

        my $backends = join '|', App::Rakubrew::Variables::available_backends(), 'all';

        say $help_text;
    }
}

sub match_and_run {
    my ($self, $version, $action) = @_;
    if (!$version) {
        say "Which version do you mean?";
        say "Available builds:";
        map {say} get_versions();
        return;
    }
    if (grep { $_ eq $version } get_versions()) {
        $action->($version);
    }
    else {
        say "Sorry, '$version' not found.";
        my @match = grep { /\Q$version/ } get_versions();
        if (@match) {
            say "Did you mean:";
            say $_ for @match;
        }
    }
}

sub test {
    my ($self, $version) = @_;
    $self->match_and_run($version, sub {
        my $matched = shift;
        verify_version($matched);
        my $v_dir = catdir($versions_dir, $matched);
        if (!-d $v_dir) {
            say STDERR "Version $matched was not built by rakubrew.";
            say STDERR "Refusing to try running spectest there.";
            exit 1;
        }
        chdir catdir($versions_dir, $matched);
        say "Spectesting $matched";
        if (!-f 'Makefile') {
            say STDERR "Can only run spectest in self built Rakudos.";
            say STDERR "This Rakudo is not self built.";
            exit 1;
        }
        run(App::Rakubrew::Build::determine_make($matched), 'spectest');
    });
}

sub nuke {
    my ($self, $version) = @_;
    $self->match_and_run($version, sub {
        my $matched = shift;
        if (is_registered_version($matched)) {
            say "Unregistering $matched";
            unlink(catfile($versions_dir, $matched));
        }
        elsif ($matched eq 'system') {
            say 'I refuse to nuke system Raku!';
            exit 1;
        }
        elsif ($matched eq get_version()) {
            say "$matched is currently active. I refuse to nuke.";
            exit 1;
        }
        else {
            say "Nuking $matched";
            remove_tree(catdir($versions_dir, $matched));
        }
    });
    # Might have lost executables -> rehash
    rehash();
}

sub init {
    my $self = shift;
    my $brew_exec = catfile($RealBin, $brew_name);
    if (+@_ == 1) {
        # We have an argument. That has to be the shell.
        # We already retrieved the shell above, so no need to look at the passed argument here again.
        say $self->{hook}->get_init_code;
    }
    else {
        my $shell = ref($self->{hook});
        $shell =~ s/.+:://;
        my $shell_text = join('|', App::Rakubrew::Shell->available_shells);
    my $text = <<EOT;
Your shell has been identified as $shell. If that's wrong, run

  $brew_exec init --shell $shell_text
EOT
        say $text;