The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/pugs
use v6;

# A simple shell written in Perl6

# TODO
# BACKPSACE, history, editing ?


my $prompt = '<p6shell>$ ';
my $VERSION = '0.01';

# we should have this list from some internal command
# probably along with the signature of these functions
my @available_commands = <exit print say>;
@available_commands.push( <mkdir rmdir chdir unlink chmod chown> );
@available_commands.push( <pop push> );


# Enable reading character as they ar typed, see Perl5: perldoc -f getc  
# It would be better to use Term::ReadKey but it has to be implemented for Perl6
my $BSD_STYLE = 1;

if ($BSD_STYLE) {
    system "stty cbreak </dev/tty >/dev/tty 2>&1";
}
else {
    system "stty", '-icanon', 'eol', "\001";
}

my $_loop_ = get_loop();
eval $_loop_;

if ($BSD_STYLE) {
    system "stty -cbreak </dev/tty >/dev/tty 2>&1";
}
else {
    system "stty", 'icanon', 'eol', '^@'; # ASCII null
}
exit;

#################################################333

sub get_loop {
return '
    while(1) {
        my $command = "";
        print "\n", $prompt;
        while (1) {
            my $char = $*IN.getc;
            if ($char eq "\n") {
                # TODO: maybe check if _loop_ shows up in the input and disallow that code ?
                if (eval "$command;" ~ $_loop_ ) {
                    exit;
                } 
                else {
                    print $!;
                    last;
                }
            }
            if ($char eq "\t") {
                # clean the TAB but keep what we had so far
                refresh_commandline($command);

                my $tail = tab_completition($command);

                if (defined $tail) {
                    $command ~= $tail;
                    refresh_commandline($command);
                }
                next;
            }
            $command ~= $char;
        }
    }
';
}

# TODO: this should understand the command line typed in so far....
sub tab_completition {
    my ($command) = @_;

    my @possible_commands = grep { not index($_, $command)}, @available_commands;
    # TODO: might really get more than one... and we should let the user step through them using TAB
    # or display all possible values, or the user should be able to configure the behivaior
    return if not @possible_commands;
    return substr(@possible_commands[0], $command.bytes) if 1 == @possible_commands;

    # TODO: if there are too many (> $LIMIT) ask if the user really wants to display all
    my $WIDTH = 80;
    my $out = '';
    my $line = '';
    for @possible_commands -> $com {
        if ($line.bytes + 1 + $com.bytes <= $WIDTH) {
            $line ~= " $com";
        } else {
            $out ~= "$line\n";
            $line = $com;
        }
    }
    $out ~= "$line\n";
    print "\n$out";
    return "";
}

sub refresh_commandline {
    my ($command) = @_;
    print "\r", $prompt;
    print " " x $command.bytes + 1;
    print "\r", $prompt;
    print $command;
}