#!/usr/bin/env perl
# I AM RAKUDOBREW. ALSO POSSIBLY SPARTACUS. OUTLOOK CLOUDY, ASK AGAIN LATER.
use strict;
use warnings;
use 5.010;
use FindBin qw($RealBin $RealScript);
use lib "$RealBin/../lib";
use File::Path qw(remove_tree);
use File::Spec::Functions qw(catfile catdir splitpath updir);

use Rakudobrew::Variables;
use Rakudobrew::Tools;
use Rakudobrew::VersionHandling;
use Rakudobrew::Build;

# Detect incompatible version upgrade and notify user of the breakage.
{
    my $backends = join '|', Rakudobrew::Build::available_backends();
    opendir(my $dh, $prefix);
    my $old_version_found = grep { /^($backends)/ } readdir($dh);
    closedir $dh;

    if ($old_version_found) {
        say STDERR <<"EOS";
You seem to have upgraded rakudobrew to a newer version not compatible with
your current directory layout.

To use the new version you need to completely remove rakudobrew by deleting
$prefix and installing again. See

https://github.com/tadzik/rakudobrew

for installation instructions. You will also need to change the rakudobrew
entry in your shell startup file (~/.profile) a bit. Run `rakudobrew init`
again to see how.

If you don't want to upgrade, but just continue using the old version,
do the following:

cd $prefix && git checkout v1
EOS
        exit 1;
    }
}

unless (-d $shim_dir) {
    mkdir $shim_dir;
}
unless (-d $versions_dir) {
    mkdir $versions_dir;
}
unless (-d $git_reference) {
    mkdir $git_reference;
}

{ # Check whether we are called as a shim and forward if yes.
    my (undef, undef, $prog_name) = splitpath($0);

    # TODO: Mac is also case insensitive. Is this way to compensate for insensitivity safe?
    if ($prog_name ne $brew_name &&
    ($^O !~ /win32/i || $prog_name =~ /^\Q$brew_name\E\z/i)) {
        do_exec($prog_name, \@ARGV);
    }
}

if (@ARGV && $ARGV[0] eq 'internal_hooked') { # The hook is there, all good!
    shift; # Remove the hook so processing code below doesn't need to care about it.
}
elsif (@ARGV && $ARGV[0] =~ /^internal_/  # It's an internal_ method, all good!
|| !@ARGV || $ARGV[0] eq 'init' # We don't want to annoy the user with missing
                                # hook messages if she might not have even completed
                                # the installation process.
|| $^O =~ /win32/i )            # Windows doesn't support shell hooks. So don't whine about it here.
{}
elsif (get_brew_mode() eq 'env' || @ARGV && $ARGV[0] eq 'shell' || @ARGV >= 2 && $ARGV[0] eq 'mode' && $ARGV[1] eq 'env') {
    say STDERR "The shell hook required to use rakudobrew in 'env' mode and use the 'shell' command seems not to be installed.";
    say STDERR "Run '$brew_name init' for installation instructions.";
    exit 1;
}


my $arg = shift // 'help';

if ($arg eq 'version' || $arg eq 'current') {
    if (my $c = get_version()) {
        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 .= $_ eq $cur ? '* ' : '  ';
        $version_line .= $_;
        $version_line .= ' -> ' . get_version_path($_) if is_registered_version($_);
        say $version_line;
    } get_versions();

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

} elsif ($arg eq 'shell') {
    if ($^O =~ /win32/i) {
        say <<EOT;
To (un)set a version locally in this running shell session use the following commands:
CMD:
SET $env_var=YOUR_VERSION
SET $env_var=                # Unset. No trailing whitespace!

PowerShell:
\$Env:$env_var="YOUR_VERSION"
Remove-Item Env:\\$env_var    # Unset.
EOT
    }
    else {
        if (!@ARGV) {
            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;
            if ($version ne '--unset' && !version_exists($version)) {
                say STDERR "$brew_name: version '$version' not installed.";
                exit 1;
            }
        }
    }

} elsif ($arg eq 'local') {
    validate_brew_mode();
    if (!@ARGV) {
        my $version = get_local_version();
        if ($version) {
            say $version;
        }
        else {
            say "$brew_name: no local version configured for this directory";
        }
    }
    else {
        match_and_run($ARGV[0], sub {
            set_local_version(shift);
        });
    }

} elsif ($arg eq 'nuke' || $arg eq 'unregister') {
    my $version = shift;
    nuke($version);

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

} elsif ($arg eq 'list-available') {
    my ($cur_backend, $cur_rakudo) = split '-', (get_version() // ''), 2;
    $cur_backend //= '';
    $cur_rakudo  //= '';
    say "Available Rakudo versions:";
    map { say $cur_rakudo eq $_ ? "* $_" : "  $_" } Rakudobrew::Build::available_rakudos();
    say "";
    $cur_backend |= '';
    $cur_rakudo |= '';
    say "Available backends:";
    map { say $cur_backend eq $_ ? "* $_" : "  $_" } Rakudobrew::Build::available_backends();

} elsif ($arg eq 'build') {
    my $impl = shift // 'moar';
    my $ver = shift
        if @ARGV && $ARGV[0] !~ /^--/;

    if (!defined $ver) {
        if ($impl eq 'moar-blead') {
            $ver = 'master';
        }
        else {
            my @versions = Rakudobrew::Build::available_rakudos();
            @versions = grep { /^\d\d\d\d\.\d\d/ } @versions;
            $ver = $versions[-1];
        }
    }

    if ($impl eq "panda") {
        say "panda is discontinued; please use zef (rakudobrew build-zef) instead";
    } elsif ($impl eq "zef") {
        my $version = get_version();
        if (!$version) {
            say STDERR "$brew_name: No version set.";
            exit 1;
        }
        Rakudobrew::Build::build_zef($version);
        # Might have new executables now -> rehash.
        rehash();
        say "Done, built zef for $version";
    } elsif (!exists $impls{$impl}) {
        my $warning = "Cannot build Rakudo with backend '$impl': this backend ";
        if ($impl eq "parrot") {
            $warning .= "is no longer supported.";
        } else {
            $warning .= "does not exist.";
        }
        say $warning;
        exit 1;
    }
    else {
        my $configure_opts = '';
        if (@ARGV && $ARGV[0] =~ /^--configure-opts=/) {
            $configure_opts = shift;
            $configure_opts =~ s/^\-\-configure-opts=//;
            $configure_opts =~ s/^'//;
            $configure_opts =~ s/'$//;
        }

        my $name = "$impl-$ver";
        $name = $impl if $impl eq 'moar-blead' && $ver eq 'master';

        if ($impl && $impl eq 'all') {
            for (Rakudobrew::Build::available_backends()) {
                Rakudobrew::Build::build_impl($_, $ver, $configure_opts);
            }
        } else {
            Rakudobrew::Build::build_impl($impl, $ver, $configure_opts);
        }

        # Might have new executables now -> rehash.
        rehash();
        unless (get_version()) {
            set_global_version($name);
        }
        say "Done, $name built";
    }

} elsif ($arg eq 'triple') {
    my ($rakudo_ver, $nqp_ver, $moar_ver) = (shift, shift, shift);
    my $name = Rakudobrew::Build::build_triple($rakudo_ver, $nqp_ver, $moar_ver);

    # Might have new executables now -> rehash
    rehash();
    unless (get_version()) {
        set_global_version($name);
    }
    say "Done, $name built";

} elsif ($arg eq 'register') {
    my ($name, $path) = (shift, shift);
    if (!$name || !$path) {
        say STDERR "$brew_name: Need a version name and rakudo installation path";
        exit 1;
    }
    if (version_exists($name)) {
        say STDERR "$brew_name: Version $name already exists";
        exit 1;
    }

    sub invalid() {
        say STDERR "$brew_name: No valid rakudo installation found at '$path'";
        exit 1;
    }
    invalid() if !-d $path;
    $path = catdir($path, 'install') if !-f catfile($path, 'bin', 'perl6');
    invalid() if !-f catdir($path, 'bin', 'perl6');

    spurt(catfile($versions_dir, $name), $path);

} elsif ($arg eq 'build-zef') {
    my $version = get_version();
    if (!$version) {
        say STDERR "$brew_name: No version set.";
        exit 1;
    }
    Rakudobrew::Build::build_zef($version);
    # Might have new executables now -> rehash
    rehash();
    say "Done, built zef for $version";

} elsif ($arg eq 'build-panda') {
    say "panda is discontinued; please use zef (rakudobrew build-zef) instead";

} elsif ($arg eq 'exec') {
    my $prog_name = shift;
    do_exec($prog_name, \@ARGV);

} elsif ($arg eq 'which') {
    if (!@ARGV) {
        say STDERR "Usage: $brew_name which <command>";
    }
    else {
        my $version = get_version();
        if (!$version) {
            say STDERR "$brew_name: No version set.";
            exit 1;
        }
        map {say $_} which($ARGV[0], $version);
    }

} elsif ($arg eq 'whence') {
    if (!@ARGV) {
        say STDERR "Usage: $brew_name whence [--path] <command>";
    }
    else {
        my $param = shift;
        my $pathmode = $param eq '--path';
        my $prog = $pathmode ? shift : $param;
        map {say $_} whence($prog, $pathmode);
    }

} elsif ($arg eq 'mode') {
    if (!@ARGV) {
        say get_brew_mode();
    }
    else {
        set_brew_mode($ARGV[0]);
    }

} elsif ($arg eq 'self-upgrade') {
    self_upgrade();

} elsif ($arg eq 'init') {
    init(@ARGV);

} elsif ($arg eq 'test') {
    my $version = shift;
    if ($version && $version eq 'all') {
        for (get_versions()) {
            test($_);
        }
    } else {
        test($version);
    }
} elsif ($arg eq 'internal_shell_hook') {
    no strict 'refs';
    my $shell = shift;
    my $sub = shift;

    eval "require Rakudobrew::ShellHook::$shell";
    "Rakudobrew::ShellHook::${shell}::$sub"->(@ARGV);

} elsif ($arg eq 'internal_win_run') {
    my $prog_name = shift;
    my $path = which($prog_name, get_version());
    # Do some filetype detection:
    # - .exe/.bat/.cmd              -> return "filename"
    # - .nqp                        -> return "nqp filename"
    # - shebang line contains perl6 -> return "perl6 filename"
    # - shebang line contains perl  -> return "perl filename"
    # - nothing of the above        -> return "filename" # if we can't
    #                                  figure out what to do with this
    #                                  filename, let Windows have a try.
    # The first line is potentially the shebang. Thus the search for "perl" and/or perl6.
    my ($basename, undef, $suffix) = my_fileparse($prog_name);
    if($suffix =~ /^\Q\.(exe|bat|cmd)\E\z/i) {
        say $path;
    }
    elsif($suffix =~ /^\Q\.nqp\E\z/i) {
        say which('nqp', get_version()).' '.$path;
    }
    else {
        open(my $fh, '<', $path);
        my $first_line = <$fh>;
        close($fh);
        if($first_line =~ /#!.*perl6/) {
            say which('perl6', get_version()).' '.$path;
        }
        elsif($first_line =~ /#!.*perl/) {
            say 'perl '.$path;
        }
        else {
            say $path;
        }
    }

} else {
    my $backends = join '|', Rakudobrew::Build::available_backends(), 'all';
    say <<"EOT";
Usage:
$brew_name version          # or $brew_name current
$brew_name versions         # or $brew_name list
$brew_name global [version] # or $brew_name switch [version]
$brew_name shell [--unset|version]
$brew_name local [version]
$brew_name nuke [version]   # or $brew_name unregister [version]
$brew_name rehash

$brew_name list-available
$brew_name build [$backends] [tag|branch|sha-1] [--configure-opts=]
$brew_name triple [rakudo-ver [nqp-ver [moar-ver]]]
$brew_name register <name> <path>
$brew_name build-zef

$brew_name exec <command> [command-args]
$brew_name which <command>
$brew_name whence [--path] <command>
$brew_name mode [env|shim]
$brew_name self-upgrade
$brew_name init

$brew_name test [version|all]
EOT
}

exit;

sub match_and_run {
    my ($version, $action) = @_;
    if (!$version) {
        say "Which version do you mean?";
        say "Available builds:";
        map {say} get_versions();
        return;
    }
    opendir(my $dh, $versions_dir);
    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 self_upgrade {
    chdir $prefix;
    run "$GIT pull";
}

sub test {
    my $version = shift || get_version();
    if (!$version) {
        say STDERR "$brew_name: No version set.";
        exit 1;
    }
    my @match = grep { /\Q$version/ } get_versions();
    my ($matched, $ambiguous) = @match;
    if ($ambiguous) {
        my ($exact) = grep { $_ eq $version } @match;
        if ($exact) {
            ($matched, $ambiguous) = $exact;
        }
    }
    if ($matched and not $ambiguous) {
        say "Spectesting $matched";
        chdir catdir($versions_dir, $matched);
        Rakudobrew::Build::make('spectest');
    } elsif (@match) {
        say "Sorry, I'm not sure if you mean:";
        say $_ for @match;
    } else {
        say "Sorry, I have no idea what '$version' is";
        say "Have you run '$brew_name build $version' yet?";
    }
}

sub nuke {
    my $version = shift;
    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 Perl 6!';
            exit 1;
        }
        else {
            say "Nuking $matched";
            remove_tree(catdir($versions_dir, $matched));
        }
    });
    # Might have lost executables -> rehash
    rehash();
}

sub init {
    my $brew_exec = catfile($RealBin, $brew_name);
    if ($^O =~ /win32/i) {
        say <<EOT;
# CMD:
# To install $brew_name permanently type the following into your terminal:
#   SETX PATH "$RealBin;$shim_dir;%PATH%"
# To make use of $brew_name in this session only use
#   SET PATH=$RealBin;$shim_dir;%PATH%
#
# PowerShell:
# To install $brew_name permanently type the following into your terminal
# (only works with an administrative console window):
#   [Environment]::SetEnvironmentVariable("PATH", "$RealBin;$shim_dir;\$Env:PATH", "User")
# To make use of $brew_name in this session only use
#   \$Env:PATH = "$RealBin;$shim_dir;\$Env:PATH"
#
# Using the GUI:
# Start -> right click on "Computer" -> Properties -> (Advanced system settings)
# -> Advanced -> Environment Variables... ->  System variables
# -> select PATH -> Edit... -> prepend "$RealBin;$shim_dir;"
#
# WARNING:
# Setting PATH to a string longer than 2048 chars (4096 on newer systems) can cause the
# PATH to be truncated, your PATH being set to the empty string and only become available
# again upon reboot and in the worst case cause your system to not boot anymore.
# See https://web.archive.org/web/20190519191717/https://software.intel.com/en-us/articles/limitation-to-the-length-of-the-system-path-variable
EOT
    }
    else {
        if (@_) {
            no strict 'refs';
            my $shell = $_[0];
            
            eval "require Rakudobrew::ShellHook::$shell";
            
            if ($@) {
                say STDERR "Couldn't find shell hook implementation for shell '$shell'.";
                exit 1;
            }
            my $code = "Rakudobrew::ShellHook::${shell}::get_init_code";
            say $code->();
        }
        else {
            my @available_shell_hooks;
            opendir(my $dh, catdir($prefix, 'lib', 'Rakudobrew', 'ShellHook')) or die "$brew_name: lib dir not found";
            while (my $entry = readdir $dh) {
                if ($entry =~ /(.*)\.pm$/) {
                    push @available_shell_hooks, $1;
                }
            }
            closedir $dh;
            my $available_shell_hooks_text = join('|', @available_shell_hooks);

            say <<EOT;
# Load $brew_name automatically by adding
#   eval "\$($brew_exec init <$available_shell_hooks_text>)"
# to your local profile file.
# (often ~/.bash_profile, ~/.zsh_profile or ~/.profile)
# This can be easily done using:

echo 'eval "\$($brew_exec init <$available_shell_hooks_text>)"' >> ~/.profile

# On Fish:

echo '$brew_exec init Fish | source' >> ~/.config/fish/config.fish

EOT
        }
    }
}

sub do_exec {
    my ($program, $args) = @_;

    my $target = which($program, get_version());
    
    # Run.
    exec { $target } ($target, @$args);
    die "Executing $target failed with: $!";
}