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';