use strict;
use Irssi;
use Festival::Client;
use vars qw($VERSION %IRSSI);

$VERSION = "0.1";
%IRSSI = (
	authors     => "Mick McMillan",
	contact     => "mick\@lowdrag\.org",
	name        => "speak",
	description => "Glues irssi to festival speech synthesis engine",
	license     => "Artistic",
	url         => "http://lowdrag.org/",
	changed     => "Sun Feb 14 13:17:15 CST 2004"
);

my  ($dotfile, $Festival);
our ($host, $port, $always_start_fest, $sleep, $same_secs, $CONFIG_VERSION);
our ($nick_subs, $speech_subs, $all_subs);
my ($oldtime, $oldnick);

$host = 'localhost';
$port = '1314';

###############################################################################
#   config	###############################################################
#
sub read_config	{
    $dotfile = $ENV{HOME} . '/.irssi/.speakrc';
    my $dotfile_warn = <<HERE;
%r#-----------------------------------------------------%n
%r#%n No config file found. That's no problem, but I can
%r#%n write a skeleton config file for you if you like.
%r#%n Use /writeconfig and edit the resulting3
%r#%n $dotfile
%r#-----------------------------------------------------%n
HERE
    my $dotfile_msg = <<'HERE';
$CONFIG_VERSION = '0.1';
###########################################################
#   Put your substitutions in here, follow the ensamples
#   below.
#   
#   Where's the festival server running?
$host = 'localhost';
$port = '1314';

#   If $host =~ localhost and this is true then this script will
#   always just start festival without the whining.
$always_start_fest = '0';

#   Time in seconds that the script should give festival to start
#   when starting festival from within the script. two seconds
#   works for me. Look for an error from Festival::Client about
#   not being able to call method say without an object reference. 
#   Increase this number as needed.
$sleep = '2';

#   When someone inputs a multiline message there might be several
#   instances of "someone says ...". To make this less annoying
#   this variable is a number in seconds that we'll assume we remember
#   who's speaking.
$same_secs = '20';

#   regular perl regular expressions.
#   nick and speech stuff done before "all-subs" subs, but
#   there's no real telling which will be done first within
#   one of the anonymous hashes. Sorry.
$nick_subs = {	    #   only substituted in nicks
    '\bcb\b'	    =>	'ceeb',
    '(?i)bumperII\b'=>	'bumper 2',
    '\[Cadet\]'	    =>	'tough guy',
    };
$speech_subs = {    #	only substituted in speech
    '(?i)wtf'	    =>	'what the fumble',
    '(?i)RTFM'	    =>	'reed the fine manual',	#   sic
    };
$all_subs = {	    #   substituted everywhere
    '\x03\d?\d?(,\d?\d?)?|\x02|\x1f|\x16|\x06|\x07' =>	'',
    '^[^\w|\d]+$'   =>	'',
    '\{'	    =>	' left curly ',
    '\}'	    =>	' right curly ',
    '\|\|'	    =>	' or ',
    '\|'	    =>	' pipe ',
    '\>{2,}'	    =>	' much greater than ',
    '\>'	    =>	' greater than ',
    '\<{2,}'	    =>	' much less than ',
    '\<'	    =>	' less than ',
    '\\+'	    =>	' unslash ',
    '\/+'	    =>	' slash ',
    '\@'	    =>	' at ',
    '\#'	    =>	' hash ',
    '[\"\[\]\_\-]'  =>	' ',
    '[!|1]+'	    =>	'!',
    '(?i)r00l'	    =>	'rule'
    };
1;
HERE

    unless(-e $dotfile)	{
	print $dotfile_warn;
	eval $dotfile_msg;
	Irssi::command_bind('writeconfig', '_writeconfig');
	sub _writeconfig    {
	    open DOTFILE, '>', $dotfile or die "Can't open $dotfile: $!";
	    print DOTFILE $dotfile_msg;
	    close DOTFILE;
	}
    }
    else    {
	do $dotfile;
    }
}
#
#   end config	###############################################################
###############################################################################

###############################################################################
#   starting	###############################################################
#
sub starterup	{
    undef my $fest;
    $fest = `ps aux|grep festival|grep -v grep`;
    &read_config;
    if ($fest)	{
		_really_start();
	}
	else	{
	    my $no_fest_warn = <<HERE;
%r#-----------------------------------------------------%n
%r#%n festival doesn\'t seem to be running on this box.
%r#%n Unless you know something I don't, you should 
%r#%n probably start festival in server mode and start
%r#%n this script again.
%r#%n I can try to start it for you using "/startfest",
%r#%n but you may need to reload this script anyway.
%r#%n If you\'re using a non-localhost festival you
%r#%n should edit $dotfile
%r#%n to reflect that configuration.
%r#-----------------------------------------------------%n
HERE
	if($host =~ /localhost/)    {
	    if($always_start_fest)  {
		_startfest();
	    }
	    else    {
	    print $no_fest_warn;
	    Irssi::command_bind('startfest', '_startfest');
	    }
	}
	else	{
	    _really_start();
	}
    }
}

sub _startfest	{
    undef my $fest;
    $fest = `ps aux|grep festival|grep -v grep`;
    if($fest)    {
	my $fest_warn = <<HERE;
%r#-----------------------------------------------------%n
%r#%n festival seems to be running here. *shrug*
%r#%n Use /really and I\'ll give it a shot anyway.
%r#-----------------------------------------------------%n
HERE
	print $fest_warn;
	Irssi::command_bind('really', '_startfest_really');
    }	else	{
	_startfest_really();
    }	
}

sub _startfest_really	{
    system 'killall festival &>/dev/null; festival --server &>/dev/null &';
    sleep $sleep;   #   Give festival a chance to start, increase on slow system
    starterup();
}

#
#   end starting    ###########################################################
###############################################################################

###############################################################################
#   cleanup	###############################################################
#

sub _launder	{
    $_ = shift;
    while ( my($key, $value) = each %$all_subs) {
	s/$key/$value/g;
    }
    /([\w\d\ \.\:\;\,\!\$\%\&\*\^\'\=]*)/;	#   probably the problem.
    return $1;
}

sub _nick_launder   {
    $_ = shift;
    while ( my($key, $value) = each %$nick_subs) {
	s/$key/$value/g;
    }
    undef $oldnick;
    _launder($_);
}
 
sub _nick_launder_plus   {
    $_ = shift;
    while ( my($key, $value) = each %$nick_subs) {
	s/$key/$value/g;
    }
    my $newnick = $_;
    my $newtime = time();
    if(($newnick =~ /^$oldnick$/) && (($newtime - $oldtime) < $same_secs))	{
	undef $_;
    }
    $oldnick = $newnick;
    $oldtime = $newtime;
    _launder($_);
}

sub _speech_launder   {
    $_ = shift;
    while ( my($key, $value) = each %$speech_subs) {
	s/$key/$value/g;
    }
    _launder($_);
}

#
#   end cleanup	###############################################################
###############################################################################

###############################################################################
#   main subs	###############################################################
#

sub _own_public	{
    my ($server, $data, $target) = @_;
    my $clean_data = _speech_launder($data);
    $Festival->say($clean_data);
}
    
sub _public {
    my ($server, $data, $nick, $mask, $target) = @_;
    my $clean_data = _speech_launder($data);
    my $clean_nick = _nick_launder_plus($nick);
    if($clean_nick) {$clean_nick .= ' says: ';}
    $Festival->say($clean_nick . $clean_data);
}

sub _own_private    {
    my ($server, $data, $target) = @_;
    my $clean_data = _speech_launder($data);
    my $clean_target = _nick_launder($target);
    $Festival->say("private to $clean_target : $clean_data");
}

sub _private    {
    my ($server, $data, $nick, $mask) = @_;
    my $clean_data = _speech_launder($data);
    my $clean_nick = _nick_launder_plus($nick);
    if($clean_nick) {$clean_nick = 'private from ' . $clean_nick;}
    $Festival->say("$clean_nick : $clean_data");
}

sub _join   {
    my ($server, $channel, $nick, $address) = @_;
    $channel =~ s/#//;
    my $clean_channel = _launder($channel);
    my $clean_nick = _nick_launder($nick);
    $Festival->say("$clean_nick has joined $clean_channel.");
}

sub _part   {
    my ($server, $channel, $nick, $address, $reason) = @_;
    $channel =~ s/#//;
    my $clean_channel = _launder($channel);
    my $clean_reason = _launder($reason);
    my $clean_nick = _nick_launder($nick);
    $Festival->say("$clean_nick has left $clean_channel : $clean_reason");
}

sub _quit   {
    my ($server, $nick, $address, $reason) = @_;
    my $clean_reason = _launder($reason);
    my $clean_nick = _nick_launder($nick);
    $Festival->say("$clean_nick has quit : $clean_reason");
}
 
sub _kick   {
    my ($server, $channel, $nick, $kicker, $address, $reason) = @_;
    $channel =~ s/#//;
    my $clean_channel = _launder($channel);
    my $clean_kicker = _launder($kicker);
    my $clean_reason = _launder($reason);
    my $clean_nick = _nick_launder($nick);
    $Festival->say("$clean_kicker has kicked $clean_nick from \
	    $clean_channel : $clean_reason");
}   
   
sub _nick   {
    my ($server, $newnick, $oldnick, $address) = @_;
    my $clean_newnick = _nick_launder($newnick);
    my $clean_oldnick = _nick_launder($oldnick);
    $Festival->say("$clean_oldnick is now known as $clean_newnick");
}    

sub _own_nick   {
    my ($server, $newnick, $oldnick, $address) = @_;
    my $clean_newnick = _nick_launder($newnick);
    $Festival->say("You are now known as $clean_newnick");
}   
  
sub _invite   {
    my ($server, $channel, $nick, $address) = @_;
    $channel =~ s/#//;
    my $clean_nick = _nick_launder($nick);
    my $clean_channel = _launder($channel);
    $Festival->say("$clean_nick invites you to $clean_channel");
}
  
sub _topic   {
    my ($server, $channel, $topic, $nick, $address) = @_;
    $channel =~ s/#//;
    my $clean_nick = _nick_launder($nick);
    my $clean_channel = _launder($channel);
    my $clean_topic = _launder($topic);
    $Festival->say("The topic for $clean_channel was changed by \
	    $clean_nick to $clean_topic");
}

starterup();
sub _really_start   {
    $Festival = Festival::Client->new($host . ':' . $port);
    Irssi::settings_add_str('speak', 'quiet_channels', '');  #FIXME
    Irssi::signal_add('message public', '_public');
    Irssi::signal_add('message own_public', '_own_public');
    Irssi::signal_add('message private', '_private');
    Irssi::signal_add('message own_private', '_own_private');
    Irssi::signal_add('message join', '_join');
    Irssi::signal_add('message part', '_part');
    Irssi::signal_add('message quit', '_quit');
    Irssi::signal_add('message kick', '_kick');
    Irssi::signal_add('message nick', '_nick');
    Irssi::signal_add('message own_nick', '_own_nick');
    Irssi::signal_add('message invite', '_invite');
    Irssi::signal_add('message topic', '_topic');
}

#
#   end main subs   ###########################################################
###############################################################################
