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";
                    say STDERR "$filepath";
                    say STDERR "file. This version is not installed. Ignoring.";
                    say STDERR '';
                }
            }
        }
        pop @fragments;
    }
    return undef;
}

sub is_version_broken {
    my $version = shift;
    return 0 if $version eq 'system';
    my $path = get_version_path($version, 1);
    return 1 if !$path;
    return 0 if !is_version_path_broken($path);
    return 1;
}

sub is_version_path_broken {
    my $path = shift;
    $path = clean_version_path($path);
    return 1 if !$path;
    for my $exec ('raku', 'raku.bat', 'raku.exe', 'perl6', 'perl6.bat', 'perl6.exe', 'rakudo', 'rakudo.bat', 'rakudo.exe') {
        if (-f catfile($path, 'bin', $exec)) {
            return 0;
        }
    }
    return 1;
}

sub verify_version {
    my $version = shift;

    if (! version_exists($version) ) {
        say STDERR "$brew_name: version '$version' is not installed.";
        exit 1;
    }

    if ( is_version_broken($version) ) {
        say STDERR "Version $version is broken. Refusing to switch to it.";
        exit 1;
    }
}

sub set_local_version {
    my $version = shift;
    if ($version) {
        verify_version($version);
        spurt($local_filename, $version);
    }
    else {
        unlink $local_filename;
        unlink '.perl6-version';
    }
}

sub get_global_version {
    if (!-e catfile($prefix, 'CURRENT')) {
        set_global_version('system', 1);
    }
    my $cur = slurp(catfile($prefix, 'CURRENT'));
    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 {