package NetHirc::Terminal;

use strict;
use warnings;

use POE qw(Kernel Session Wheel::ReadWrite);

use POSIX ();
use String::Format;

use NetHirc::Shell;
use NetHirc::Util;

use constant AWAY => "(Away)";
use constant DEFAULT_STATUS => "[%d] NetHirc: %v%o%O%n(%p) on %c(%m) {%s} %a %q";
use constant NO_NICK => "Amnesiac";
use constant NO_CHANNEL => "no channel";
use constant NO_QUERIES => "";
use constant NO_SERVER => "no server";
use constant NOT_AWAY => "";
use constant SSFE_STATUSLINE_FORMAT => "`#ssfe#s%s";

my @events = qw(
_start
_stop
spit
format
error
confirm
ssfe
);

my @ssfe_events = qw(
again
update
);

sub new 
{
    shift;
    POE::Session->create(
	'package_states' => [ 
	    'NetHirc::Terminal' => [ 
		@events,
		$ENV{'SSFE'} ? @ssfe_events : (),
	    ] 
	],
	'args' => [ @_ ],
    );
}

sub _start
{
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($db, $rc, $shellargs) = @_[ARG0..ARG2];

    $kernel->alias_set('nethirc_terminal');

    my $wheel = POE::Wheel::ReadWrite->new(
	InputHandle => \*STDIN,
	OutputHandle => \*STDOUT,
	InputEvent => 'spit',
	ErrorEvent => 'error',
	InputFilter => POE::Filter::Line->new(),
	OutputFilter => POE::Filter::Stream->new(),
    );
    $heap->{'wheel'} = $wheel;
    $heap->{'db'} = $db;
    $heap->{'rc'} = $rc;

    my $shell = NetHirc::Shell->new($shellargs);
    $heap->{'shell'} = $shell;

    if ($ENV{'SSFE'})
    {
	$kernel->post($session, 'ssfe', 1);
    }
}

sub _stop
{
    my ($kernel, $heap) = @_[KERNEL, HEAP];
    delete $heap->{'wheel'};
    $kernel->alarm_remove_all();
}

sub confirm
{
    debug('t', "confirm");
    my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
    my ($confirm, $refuse) = @_[ARG0, ARG1];
    $heap->{'confirm'} = $sender->postback($confirm);
    $heap->{'refuse'} = $sender->postback($refuse);
}

sub spit 
{
    debug('t', 'spit');
    my ($heap, $input) = @_[HEAP, ARG0];
    my $shell = $heap->{'shell'};
    unless (exists $heap->{'confirm'})
    {
	$shell->run_once($input);
	return;
    }
    if (lc(substr($input, 0, 1)) eq 'y')
    {
	$heap->{'confirm'}->();
    }
    else
    {
	$heap->{'refuse'}->();
    }
    delete $heap->{'confirm'};
    delete $heap->{'refuse'}
}

sub ssfe
{
    debug('t', "ssfe");
    my ($kernel, $heap, $session, $arg) = @_[KERNEL, HEAP, SESSION, ARG0];
    return unless $arg;
    my $inventory = $heap->{'rc'};
    $heap->{'formatter'} = String::Format->stringfactory(
	'a' => sub { isaway($inventory) },
	'c' => sub { channel($inventory) },
	'd' => \&datestamp,
	'm' => sub { chanmode($inventory) },
	'n' => sub { nick($inventory) },
	'o' => sub { chops($inventory) },
	'O' => sub { serverops($inventory) },
	'p' => sub { yourmode($inventory) },
	'q' => sub { query($inventory) },
	's' => sub { server($inventory) },
	'v' => sub { voice($inventory) },
    );
    $kernel->post($session, 'update');
    my ($sec) = localtime(time());
    $kernel->delay_set('again', 60 - $sec);
}


sub update
{
    debug('t', "update");
    my $heap = $_[HEAP];
    my $formatter = $heap->{'formatter'};
    my $wheel = $heap->{'wheel'};
    my $format = $heap->{'db'}->{'formats'}->{'status'} || DEFAULT_STATUS;
    my $cooked = $formatter->($format);
    my $status = sprintf(SSFE_STATUSLINE_FORMAT, $cooked);
    $wheel->put($status);
    $wheel->put("\n");
}

sub again
{
    debug('t', "again");
    my ($kernel, $session) = @_[KERNEL, SESSION];
    $kernel->post($session, 'update');
    $kernel->delay_set('again', 60);
}

sub format
{
    no warnings;	# Yes, @args can be empty.
    debug('t', 'format');
    my ($kernel, $heap, $type, @args) = @_[KERNEL, HEAP, ARG0, ARG1..$#_];
    my $wheel = $heap->{'wheel'};
    my $db = $heap->{'db'};
    my $format = $db->{'formats'}->{$type};
    return unless $format;
    my $message = sprintf($format, @args);
    $wheel->put($message, "\n");
    $kernel->post('nethirc_log', 'log', $message);
}

sub error
{
    debug('t', 'error');
    my ($heap, @args) = @_[HEAP, ARG0..ARG3];
    my $wheel = $heap->{'wheel'};
    $wheel->shutdown_input();
    $wheel->shutdown_output();
    delete $heap->{'wheel'};
}

sub datestamp
{
    debug('t', "datestamp");
    my $format = $_[0] || "%H:%M";
    return POSIX::strftime($format, localtime(time));
}   

sub nick
{
    debug('t', "nick");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return NO_NICK unless $server;
    return $server->nick();
}

sub chops
{
    debug('t', "chops");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return "" unless $server;
    my $channel = $server->current_channel();
    return "" unless $channel;
    if ($server->has_chops($channel))
    {
	return "@";
    }
    return "";
}

sub serverops
{
    debug('t', "serverops");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return "" unless $server;
    if ($server->oper())
    {
	return "*";
    }
    return "";
}

sub voice
{
    debug('t', "voice");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return "" unless $server;
    my $channel = $server->current_channel();
    return "" unless $channel;
    if ($server->has_chops($channel))
    {
	return "";	# +@ is redundant
    }
    if ($server->has_voice($channel))
    {
	return "+";
    }
    return "";
}

sub chanmode
{
    debug('t', "chanmode");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return "" unless $server;
    my $channel = $server->current_channel();
    return "" unless $channel;
    return $server->channel_mode($channel);
}

sub yourmode
{
    debug('t', "yourmode");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return "" unless $server;
    return $server->mymode();
}

sub channel
{
    debug('t', "channel");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return NO_CHANNEL unless $server;
    my $channel = $server->current_channel();
    return NO_CHANNEL unless $channel;
    if ($server->is_query($channel))
    {
	return "querying $channel";
    }
    return "on $channel";
}

sub server
{
    debug('t', "server");
    my $inventory = shift;
    my $server = $inventory->current_server();
    return NO_SERVER unless $server;
    return $server->name();
}

sub isaway
{
    debug('t', "away"),
    my $inventory = shift;
    my $server = $inventory->current_server();
    return NOT_AWAY unless $server;
    my $away = $server->away();
    return NOT_AWAY unless $away;
    return AWAY;
}



1;
__END__
SSFE quick reference:

`#ssfe#i	set irc mode, confirmed with @ssfe@i
`#ssfe#c	set cooked mode, confirmed with @ssfe@c
`#ssfe#s<text>	set status line to <text>
`#ssfe#T<text>	set text sent with ^T (newline added)
`#ssfe#t<text>	add alternative to tab list
`#ssfe#l	clear screen
`#ssfe#P	prompt something, noecho
`#ssfe#p	prompt something, echo
`#ssfe#n<text>	insert text on input line
`#ssfe#o<text>	store text to be recalled to input line via ^O