package NetHirc::Shell;

use strict;
use warnings;

use POE qw(Kernel);

use NetHirc::Util;

use constant SSFE_TAG => '@ssfe@';

my %parsetable = ();


sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
	'cmdchar'	=>	'/',
	'happyslash'	=>	0,
    };
    return bless $self, $class;
}

sub run_once
{
    my $self = shift;
    my $input = shift;
    if (substr($input, 0, 6) eq SSFE_TAG)
    {
	$poe_kernel->post('nethirc_terminal', 'ssfe', 1);
	return;
    }
    my $line = $self->precmd($input);
    my ($cmd, @args) = $self->parseline($line);
    return unless $cmd;
    debug('s', "cmd: %s", $cmd);
    debug('s', "args: %s", join(' ', @args));
    $poe_kernel->post('nethirc_adventurer', "cmd_$cmd", @args);
}

sub precmd
{
    my $self = shift;
    my $line = shift;
    return $line unless $line;
    my $cmdchar = $self->{'cmdchar'};
    if (substr($line, 0, 1) ne $cmdchar)
    {
	$line = "say $line";
    }
    $line =~ s,^$cmdchar,,;
    return $line;
}

sub emptycommand
{
    debug('s', "emptycommand");
    $poe_kernel->post('nethirc_adventurer', 'complain');
}


sub parseline
{
    my $self = shift;
    my $line = shift;
    debug('s', "parseline: $line");
    unless ($line)
    {
	$self->emptycommand();
	return undef;
    }
    for my $k (keys %parsetable)
    {
	if ($line =~ $k)
	{
	    debug('s', "$k match: $line");
	    return $parsetable{$k}->($line);
	}
    }
    return ('error', split(' ', $line, 2));
}

sub parse_zero
{
    my $line = shift;
    debug('s', "parse_zero: $line");
    return (split(' ', $line, 2))[0];
}

sub parse_zero_splat
{
    my $line = shift;
    debug('s', "parse_zero_splat: $line");
    return split(' ', $line);
}

sub parse_one
{
    my $line = shift;
    debug('s', "parse_one: $line");
    my @pieces = (split(' ', $line, 3))[0,1];
    if (@pieces < 2)
    {
	return ('argcount', @pieces);
    }
    return @pieces;
}

sub parse_one_trailer
{
    my $line = shift;
    debug('s', "parse_one_trailer: $line");
    my @pieces = split(' ', $line, 3);
    if (@pieces < 2)
    {
	return ('argcount', @pieces);
    }
    return @pieces;
}

sub parse_trailer
{
    my $line = shift;
    debug('s', "parse_trailer: $line");
    return split(' ', $line, 2);
}

sub parse_two
{
    my $line = shift;
    debug('s', "parse_two: $line");
    my @pieces = (split(' ', $line, 4))[0..2];
    if (@pieces < 3)
    {
	return ('argcount', @pieces);
    }
    return @pieces;
}

sub parse_two_trailer
{
    my $line = shift;
    debug('s', "parse_two_trailer: $line");
    my @pieces = split(' ', $line, 4);
    if (@pieces < 3)
    {
	return ('argcount', @pieces);
    }
    return @pieces;
}

my %argtable = (
    '0' => [ \&parse_zero, qw( debug empty next ) ],
    '0t' => [ \&parse_trailer, qw( away say echo me my quit quote wallops yoda pigl mirror shuffle pipe system ) ],
    '*' => [ \&parse_zero_splat, qw( cmdchar disconnect info ison join list lusers mode motd names part server time userhost users version who whois whowas inventory help log count bigbrother query ) ],
    '1' => [ \&parse_one, qw( admin nick ping source ) ],
    '1t' => [ \&parse_one_trailer, qw( describe msg notice topic pipemsg ) ],
    '2' => [ \&parse_two, qw( invite ) ],
    '2t' => [ \&parse_two_trailer, qw( ctcp kick ) ],
);


for my $i (keys %argtable)
{ 
    my $v = $argtable{$i};
    my $parser = $v->[0];
    my @cmds = @{$v}[1..$#$v];
    my @sortcmds = sort { (length $b <=> length $a) || ($a cmp $b) } @cmds;
    my $pattern = sprintf('^(?:%s)(\s|$)', join('|', @sortcmds));
    $parsetable{qr/$pattern/} = $parser;
}

1;
__END__