#  fortune
#
#  Created by Tamara Temple on 2011-06-14.
#  Copyright (c) 2011 Tamara Temple Development. All rights reserved.
#

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

$VERSION = "2.0";

%IRSSI = (
    authors     => 'Tamara Temple',
    contact     => 'tamara@tamaratemple.com',
    name        => 'fortune',
    description => 'emit a fortune at random from the fortune(1) database',
    license     => 'GPLv3',
);

# ===========
# = GLOBALS =
# ===========

use vars qw($debug $datfiles $empty_re $server $target $nick $address $fortunecmd $fortuneopts $fortunefiles
	$fortuneofffiles $offensive_re $tella $telltome $tellme);

$debug=0;

$datfiles = qr{\.dat$};
$empty_re = qr{^\s*$};					# regular expression to check if a string is empty
$offensive_re = qr{(baudy|vulgar|dirty|offensive|naughty|norty)}; # keywords to tell if a naughty fortune is wanted
$tella = qr{^\s*an?\s+(|\S+)\s*(|\S+?)\s*fortune}; # matches "a[n] [offensive] [typeof] fortune"; this match must come last
$telltome = qr{^\s*an?\s+(|\S+?)\s*(|\S+?)\s*fortune to (\S+)}; # should match "a[n] [offensive] [typeof] fortune to someone"
$tellme = qr{^\s*(\S+)\s+an?\s+(|\S+?)\s*(|\S+?)\s*fortune}; # should match "me a[n] [offensive] [typeof] fortune"

$fortunecmd = qx/which fortune/; chomp($fortunecmd);
die("No fortune program could be found on path") if !$fortunecmd || $fortunecmd =~ $empty_re;
 
$fortuneopts = '-e'; 					# make fortunes of equal weight
getfortunefiles();						# sets both $fortunefiles and $fortuneofffiles
irssi_print("Fortune files: $fortunefiles");
irssi_print("Offensive fortune files: $fortuneofffiles");

sub dbg ($) {
	my $msg = shift;
     return if (!$debug);
     irssi_print("%RDEBUG%n ".$msg);
}

sub irssi_safe($) {
	my $s = shift;
	$s =~ s/%/%%/g;
	return $s;
}

sub irssi_print {
	my $s = shift;
	Irssi::active_win()->print("%Y[IRSSI{name}]%n $s");
}

sub cmd_setdebug {
	my ($data, $server, $witem) = @_;
	my @words = split(/\s+/, $data); # get first bit off $data

	$_ = $data;
	SWITCH: {
		/^on$/i  && do { $debug = 1; last SWITCH;};  
		/^off$/i  && do { $debug = 0; last SWITCH;};
		# don't bother if it's anything else
	}
	irssi_print("debug is ".($debug?'ON':'OFF'));
}
Irssi::command_bind($IRSSI{'name'}.'debug', 'cmd_setdebug');


sub say {
	my $msg = shift;
	$msg = irssi_safe($msg);
	dbg("(say) \$target=$target \$msg=$msg");
	$server->command("msg $target $msg");
}

sub getfortunefiles {
	my @searchpath = qw(
		/sw/share/fortunes
		/sw/local/share/fortunes
		/usr/share/fortunes
		/usr/local/share/fortunes
		/opt/local/share
		);
	my $fortunedir;
	FINDDIR: foreach my $dir (@searchpath) {
		if (-d $dir) {
			$fortunedir = $dir;
			last FINDDIR;
		}
	}
	die("No fortunes directory could be found") if !$fortunedir;
	
	my @filelist;
	opendir(DH,$fortunedir) or die("Could not open fortune dir $fortunedir");
	while (my $file = readdir(DH)) {
		next if $file =~ /^\..*$/; 						# don't include hidden files and directories
		if ($file =~ $datfiles) {
			$file =~ s/${datfiles}//;
			$filelist[$#filelist++] = $file; 					# add this file to list
		}
	}
	closedir(DH);
	$fortunefiles = join(" ",@filelist);
	
	my @offfilelist;
	my $offdir = $fortunedir.'/off';
	return if (! -d $offdir); # no offensive files in this installation
	opendir(DH,$offdir) or die("Could not open offensive fortune dir $offdir: $!");
	while (my $file = readdir(DH)) {
		next if $file =~ /^\..*$/;
		if ($file =~ $datfiles) {
			$file =~ s/${datfiles}//;
			$offfilelist[$#offfilelist++] = $file;
		}
	}
	closedir(DH);
	$fortuneofffiles = join(" ",@offfilelist);
	
	
}

sub dispatch {
	my $msg = shift;
	dbg("(dispatch) \$msg=$msg");
	return if $msg =~ $empty_re;
	my @words = split(/\s+/,$msg);
	dbg("(dispatch) \$#words=$#words. \@words=[".join("|",@words)."]");
	my %actions = (
		'fortune' => \&do_fortune,
		'tell' => \&tellaction,
		'give' => \&tellaction,
		'advise' => \&tellaction,
		'announce' => \&tellaction,
		'apprise' => \&tellaction,
		'confess' => \&tellaction,
		'declare' => \&tellaction,
		'disclose' => \&tellaction,
		'divulge' => \&tellaction,
		'express' => \&tellaction,
		'impart' => \&tellaction,
		'inform' => \&tellaction,
		'leak' => \&tellaction,
		'mention' => \&tellaction,
		'notify' => \&tellaction,
		'proclaim' => \&tellaction,
		'recite' => \&tellaction,
		'report' => \&tellaction,
		'reveal' => \&tellaction,
		'say' => \&tellaction,
		'speak' => \&tellaction,
		'state' => \&tellaction,
		'utter'  => \&tellaction,

# TODO 2011-06-27 - figure out a way to process multi-word synonyms for "tell":
#break the news
#call upon
#clue in
#spit it out
#put before
#reel off

		'fortunes' => \&showfortunes,
		
		'what' => \&whataction,
		);
	my $action_word = shift @words;
	dbg("(dispatch) \$action_word=$action_word");
	
	my $func = $actions{$action_word}?$actions{$action_word}:undef;
	if ($func) {
		dbg("(dispatch) calling function in [$func] \$action_word=$action_word \@words=[".join("|",@words)."]");
		
		&$func($action_word, join(" ",@words));	 
	}
}


sub tellaction {
	my $action = shift;
	my $msg = shift;
	$msg = lc($msg);
	dbg("(tellaction) \$action=[$action] \$msg=[$msg]");
	my $who;
	my $type;
	my $subtype;
	if ($msg =~ $tellme) {
		$who = $1;
		$subtype = $2;
		$type = $3;
		dbg("(tellaction) \$msg matched \$tellme: \$who=[$who] \$type=[$type] \$subtype=[$subtype]");
		
	} elsif ($msg =~ $telltome) {
		$who = $3;
		$type = $2;
		$subtype = $1;
		dbg("(tellaction) \$msg matched \$telltome: \$who=[$who] \$type=[$type] \$subtype=[$subtype]");
		
	} elsif ($msg =~ $tella) {
		$type = $2;
		$subtype = $1;
		$who = $nick;
		dbg("(tellaction) \$msg matched \$tella: \$who=[$who] \$type=[$type] \$subtype=[$subtype]");
		
	} else {
		dbg("(tellaction) nothing matched, giving up");
		
		return; # nothing matched, giving up
	}
	
	if ($type =~ $offensive_re) {
		$subtype = $type;
		$type = undef;
	}

	my $useoffensive;
	
	if ($subtype =~ $offensive_re) {
		$useoffensive = 1;
	} else {
		$useoffensive = 0;
	}
	
	if ($type !~ $empty_re) {
		if (!($fortunefiles =~ m/${type}/ || $fortuneofffiles =~ m/${type}/ || $type =~ m/(baudy|offensive|dirty|vulgar)/)) {
			say("I don't know fortunes of that type. Here are the fortune types I know:");
			say("Regular fortunes: $fortunefiles");
			say("To select a specific fortune file say \"tell me a [typeof] fortune\"");
			say("Offensive fortunes: (use at own risk): $fortuneofffiles");
			say("To select an offensive fortune say \"tell me an offensive fortune\" or \"tell me an offensive [typeof] fortune\" to choose from a specific fortune file");
			return;
		}
	}
	
	dbg("(tellaction) about to munge \$who=[$who]");
	
	$_ = $who;
	SWITCH:  {
		/^me$/ && do {$who = "you"; dbg("(tellaction) \$_=$_ matched me"); last SWITCH;};
		/^us$/ && do {$who = "the channel"; dbg("(tellaction) \$_=$_ matched us"); last SWITCH;};
		m/${empty_re}/ && do {$who = "someone"; dbg("(tellaction) \$_=$_ matched empty string"); last SWITCH;};
		dbg("(tellaction) \$who matched nothing (\$who? = [$who]) calling fuzzy_nick_match on \$who");
		$who = fuzzy_nick_match($who);
		return undef if (!$who);
		$who = "me" if ($who eq lc($server->{nick})); # recognize own nick
		$who = "you" if ($who eq lc($nick)); # recognize asker, no bob doles
	};
	dbg("(tellaction) now \$who is [$who]. Who Knew?");
	
	my $preamble = $action."s a";
	if ($type !~ $empty_re) {
		$preamble .= $type =~ /aeiouh/?"n":"";
		$preamble .= " $type";
	}
	$preamble .= " fortune to $who:";
	say($preamble);
	my $params = " -o " if $useoffensive;
	$params .= $type;
	my @fortune = get_fortune($params);
	for (my $i = 0; $i <= $#fortune; $i++) {
		say($fortune[$i]);
	}
}

sub whataction {
	# body...
	my $action = shift;
	my $msg = shift;
	dbg("(whataction) \$action=[$action] \$msg=[$msg]");
	say("I don't know what....");
}

sub showfortunes {
	# body...
	my $action = shift;
	my $msg = shift;
	dbg("(showfortunes) \$action=[$action] \$msg=[$msg]");
	say("Fortunes I know about:");
	say($fortunefiles);
	say("Offensive fortunes:");
	say($fortuneofffiles);
}

sub fuzzy_nick_match {
	my $n = shift;
	my $channel = $server->channel_find($target);
	return $n if (!$channel) ;
	my @nicklist = $channel->nicks();
	my $thisnick;
	for (my $i = 0; $i <= $#nicklist; $i++) {
		$thisnick = lc($nicklist[$i]->{nick});
		return $thisnick if $thisnick =~ m/${n}/;
	}
	say("$n not a recognized nick, try again");
	return undef;
}

sub do_fortune {
	shift; # don't need the action word
	my $msg = shift;
	dbg("(do_fortune) \$msg=[$msg]");
	my @words = split(/\s+/,$msg);
	dbg("(do_fortune) \$#words=[$#words] \@words=[".join("|",@words)."]");
	
	my $parms = "";
	for (my $i = 0; $i <= $#words; $i++) {
		# look through the message and pick out paramters to send to fortune
		dbg("\$words[$i]=$words[$i]");
		next if $words[$i] =~ /(^-[^o]|[^[:alnum:]-_]+)/; #discard anything that looks like an option except -o, or invalid fortune file base
		$parms .= " ".$words[$i];
	}
	dbg("\$parms=$parms");
	
	my @fortune = get_fortune($parms);
	for (my $i = 0; $i <= $#fortune; $i++) {
		dbg("(do_fortune) [$i] $fortune[$i]");
		say($fortune[$i]);			
	}
}

sub get_fortune {
	my $parms = shift;
	my $cmd = "$fortunecmd $fortuneopts $parms 2>&1| tr -s '\n\t' ' ' | fmt -200";
	dbg("(get_fortune) \$cmd=$cmd");
	my @fortune = `$fortunecmd $fortuneopts $parms 2>&1| tr -s '\n\t' ' ' | fmt -200`;
	chomp(@fortune);
	return @fortune;
}


sub cmd_fortune {
	my $data;
	my $witem;
	($data, $server, $witem) = @_;
	$target = $witem->{name};
	dbg("%Y(cmd_fortune)%n data=".irssi_safe($data));
	do_fortune('',$data);
}

Irssi::command_bind('fortune', 'cmd_fortune');

sub sig_fortune {
	my $msg;
	($server, $msg, $nick, $address, $target) = @_;
	unless ($server && $server->{connected}) {
		irssi_print("(sig_fortune) %RERROR: not connected to server");
	}
	
	$target = $nick if $target =~ $empty_re;
	my $trigger_re = qr{^(!|gem,\s+)};
	if ($msg =~ m/${trigger_re}/) {
		$msg =~ s/${trigger_re}//;
		$msg = lc($msg);
		dbg("(sig_fortune) \$msg=$msg. calling dispatch(\$msg)");
		
		dispatch($msg);
	}
}

sub sig_test {
	my ($server, $msg, $nick, $address, $target)  = @_;
	Irssi::print("%Y[$IRSSI{name}] (sig_test) %n msg=$msg, nick=$nick, target=$target, address=$address, connected? $server->{connected}, chatnet=$server->{chatnet}");
}

Irssi::signal_add_last("message public", "sig_fortune");
Irssi::signal_add_last("message own_public", "sig_fortune");
Irssi::signal_add_last("message own_public", "sig_test");




Irssi::active_win()->print($IRSSI{name} . ' ' . $VERSION . ' loaded.');