view release on metacpan or  search on metacpan

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

package App::Rakubrew::VersionHandling;
require Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw(
    get_versions
    get_version
    version_exists
    verify_version
    is_version_broken is_version_path_broken
    is_registered_version
    get_version_path clean_version_path
    get_shell_version
    get_local_version set_local_version
    get_global_version set_global_version
    set_brew_mode get_brew_mode get_brew_mode_shell validate_brew_mode
    get_raku
    which whence
    get_bin_paths
    rehash
);

use strict;
use warnings;
use 5.010;
use Encode::Locale qw(env);
use File::Spec::Functions qw(catfile catdir splitdir splitpath catpath canonpath);
use Cwd qw(realpath);
use File::Which qw();
use Try::Tiny;
use App::Rakubrew::Variables;
use App::Rakubrew::Tools;

sub get_versions {
    opendir(my $dh, $versions_dir);
    my @versions = (
        'system',
        sort({ $a cmp $b }
            grep({ /^[^.]/ } readdir($dh)))
    );
    closedir($dh);
    return @versions;
}

sub get_shell_version {
    # Check for shell version by looking for $RAKU_VERSION or $PL6ENV_VERSION the environment.
    if (defined $ENV{$env_var} || defined $ENV{PL6ENV_VERSION}) {
        my $version = env($env_var) // env('PL6ENV_VERSION');
        if (version_exists($version)) {
            return $version;
        }
        else {
            say STDERR "Version '$version' is set via the RAKU_VERSION environment variable.";
            say STDERR "This version is not installed. Ignoring.";
            say STDERR '';
            return undef;
        }
    }
    else {
        return undef;
    }
}

sub get_local_version {
    my ($vol, $path, undef) = splitpath(realpath(), 1);
    my @fragments = splitdir($path);
    while (@fragments) {
        for ($local_filename, '.perl6-version') {
            my $filepath = catpath($vol, catdir(@fragments), $_);
            if (-f $filepath) {
                my $version = trim(slurp($filepath));
                if(version_exists($version)) {
                    return $version;
                }
                else {
                    say STDERR "Version '$version' is given in the";

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

    chomp $cur;
    return $cur;
}

sub set_global_version {
    my $version = shift;
    my $silent = shift;
    verify_version($version);
    say "Switching to $version" unless $silent;
    spurt(catfile($prefix, 'CURRENT'), $version);
}

sub get_version {
    my $ignore = shift // '';
    my $version = $ignore eq 'shell' ? undef : get_shell_version();
    return $version if defined $version;
    
    if (get_brew_mode() eq 'shim') {
        # Local version is only supported in shim mode.
        # Check for local version by looking for a `.raku-version` file in the current and parent folders.
        $version = $ignore eq 'local' ? undef : get_local_version();
        return $version if defined $version;
    }

    # Check for global version by looking at `$prefix/CURRENT` (`$prefix/version`)
    return get_global_version();
}

sub set_brew_mode {
    my $mode = shift;
    if ($mode eq 'env') {
        spurt(catfile($prefix, 'MODE'), 'env');
    }
    elsif ($mode eq 'shim') {
        spurt(catfile($prefix, 'MODE'), 'shim');
        rehash();
    }
    else {
        say STDERR "Mode must either be 'env' or 'shim'";
    }
}

sub get_brew_mode {
    my $silent = shift;
    if (!-e catfile($prefix, 'MODE')) {
        spurt(catfile($prefix, 'MODE'), 'env');
    }

    my $mode = trim(slurp(catfile($prefix, 'MODE')));

    if ($mode ne 'env' && $mode ne 'shim') {
        say STDERR 'Invalid mode found: ' . $mode unless $silent;
        say STDERR 'Resetting to env-mode'        unless $silent;
        set_brew_mode('env');
        $mode = 'env';
    }

    return $mode;
}

sub validate_brew_mode {
    if (get_brew_mode() eq 'env') {
        say STDERR "This command is not available in 'env' mode. Switch to to 'shim' mode using '$brew_name mode shim'";
        exit 1;
    }
}

sub version_exists {
    my $version = shift;
    return undef if !defined $version;
    my %versionsMap = map { $_ => 1 } get_versions();
    return exists($versionsMap{$version});
}

sub is_registered_version {
    my $version = shift;
    my $version_file = catdir($versions_dir, $version);
    if (-f $version_file) {
        return 1;
    }
    else {
        return 0;
    }
}

sub clean_version_path {
    my $path = shift;

    my @cands = (catdir($path, 'install'), $path);
    for my $cand (@cands) {
        return $cand if -d catdir($cand, 'bin')
    }
    return undef;
}

sub get_version_path {
    my $version = shift;
    my $no_error = shift || 0;
    my $version_path = catdir($versions_dir, $version);
    $version_path = trim(slurp($version_path)) if -f $version_path;

    $version_path = clean_version_path($version_path);
    return $version_path if $version_path || $no_error;
    die "Installation is broken: $version";
}

sub get_raku {
    my $version = shift;

    return _which('raku', $version) // which('perl6', $version);
}

sub match_version {
    my $impl = shift // 'moar';
    my $ver = shift if @_ && $_[0] !~ /^--/;
    my @args = @_;

    if (!defined $ver) {
        my $version_regex = '^\d\d\d\d\.\d\d(?:\.\d+)?$';
        my $combined_regex = '('
            . join('|', App::Rakubrew::Variables::available_backends())