# knowledge script for support-style channels
# see comments scattered across the file for documentation

# el-cheapo documentation of the data files for this script:
#
# - Lines starting with ';' are ignored.
#
# - All 'normal' lines have this format:
#      <node name> <description of the node>
#   If a node name contains colons (:), the script interprets them as path
#   separators, just like UNIX does with slashes. Example:
#      testnode This is a testing node
#      testnode:sub This is a sub-node of testnode
#   Here, testnode:sub is a sub-node of testnode.
#
# - Hidden nodes are the same with a ':' before the node name. These nodes are
#   excluded from the table of contents. Example:
#      :foo This is a hidden node for foostuff
#
# - There are special command nodes starting with '::'. Example:
#      ::foo MSG %target% %nick%: you said %1:the thing to be echoed%
#   Result (when trigger is set to '?!?' and public mode is disabled):
#      /query bot
#      <me> ?!? foo
#      <bot> me: required parameters: <the thing to be echoed>
#      <me> ?!? foo whatever
#      <bot> me: you said whatever
#   I advise you to play around with this a little to get the hang of it.
#   Of course, command nodes accept an arbitrary number of parameters.
#   However, only one-word parameters are supported and there can be no
#   optional parameters.

use vars qw($VERSION %IRSSI);

$VERSION = "0.0.1";
%IRSSI = (
    authors     => 'Jan \'jast\' Krueger',
    contact     => 'jast@heapsort.de',
    name        => 'chtools',
    description => 'Provide information on things in a tree structure',
    license     => 'GNU GPLv2 or later',
    url         => 'http://jast.heapsort.de/dev/irssi.html'
);


##### [ SETTINGS ] #########################################

# public trigger enabled
Irssi::settings_add_bool("ircsupport", "ircsupport_trigger_enable", 1);
# prefix for trigger (ex: "<someuser> ?!? whatever")
Irssi::settings_add_str("ircsupport", "ircsupport_trigger_prefix", "?!? ");
# channels to enable the trigger in (all if empty). Set to '*' to enable
# everywhere.
Irssi::settings_add_str("ircsupport", "ircsupport_trigger_channels", "#help #support #perl");
# send replies publicly (in channel) -- otherwise, use notices
Irssi::settings_add_bool("ircsupport", "ircsupport_trigger_reply_public", 1);
# changes the default "," in "somenick, <here's your reply>"
Irssi::settings_add_str("ircsupport", "ircsupport_nickname_separator", ",");
# the directory to pull information from
Irssi::settings_add_str("ircsupport", "ircsupport_info_files", "~/.irssi/ircsupport/");


##### [ INTERNALS ] ########################################

my %knowledge;
my @root_nodes;

# load knowledge db
sub ircsupp_load_db
{
	undef %knowledge;
	undef @root_nodes;
	my $kdir = Irssi::settings_get_str("ircsupport_info_files");
	my $kfiles = 0;
	my $klinks = 0;
	my $kwords = 0;
	$kdir .= '/' if($kdir !~ /\/$/);
	if(!opendir(KDIR, $kdir)) {
		Irssi::print("ircsupport: can't read knowledge db ($kdir): $!");
		return;
	}
	my @files = readdir(KDIR);
	closedir KDIR;
	foreach(@files) {
		next if(!/\.db$/);
		if(!open(KFILE, $kdir . $_)) {
			Irssi::print("can't open knowledge file $kdir$_: $!");
			return;
		}
		while (my $aline = <KFILE>) {
			chomp $aline;
			next if (!$aline || $aline =~ /^;/);
			my $hidden = ($aline =~ /^:(?!:)/);
			my $command = ($aline =~ /^::/);
			$aline =~ s/^:+//;
			$kwords++;
			my @line = split(/ /, $aline, 2);
			$knowledge{$line[0]} = {'desc' => $line[1], 'children' => []};
			$knowledge{$line[0]}{'command'} = 1 if($command);
			my $parent = substr($line[0],0,rindex($line[0], ':'));
			if($knowledge{$parent}) {
				push @{$knowledge{$parent}{'children'}}, $line[0];
				$klinks++;
			}
			push @root_nodes, $line[0] if(!$hidden && !$command && $line[0] !~ /:/);
		}
		close KFILE;
		$kfiles++;
	}
	Irssi::print("ircsupport: loaded $kfiles files, added $klinks links and $kwords items");
}

sub send_children_via_notice
{
	my ($server, $target, $node, $list) = @_;
	my @list = @$list;

	if($node) {
		$server->command("NOTICE $target Keywords related to \002$node\002: ".join(", ", @list));
	} else {
		$server->command("NOTICE $target Available topics: ".join(", ", @list));
	}
}

# expands command nodes
sub expand_command
{
	my $desc = shift;
	my $node = shift;
	my $target = shift;
	my $nick = shift;
	my @cmds = @_;
	my @expls;

	$desc =~ s/\%target\%/$target/;
	$desc =~ s/\%nick\%/$nick/;
	my $err = 0;
	for(my $i = 1;;$i++) {
		last if($desc !~ /\%$i[%q:]/);
		$desc =~ /\%$i:([^%]+)\%/;
		$expls[$i-1] = ("<$1>");
		$err = 1 if(!$cmds[$i-1]);
		my $qcmd = quotemeta($cmds[$i-1]);
		$desc =~ s/\%$i(\%|:[^%]+\%)/$cmds[$i-1]/g;
		$desc =~ s/\%$iq\%/$qmcd/g;
	}
	if($err) {
		$desc = "MSG $target \002$node\002: required parameters: ".join(" ", @expls);
	}
	
	return $desc;
}

sub event_privmsg
{
	my ($server, $data, $nick, $address) = @_;
	my ($target, $text) = split(/ :/, $data, 2);
	my @cmds = split(/ /, $text);
	my $prefix = Irssi::settings_get_str("ircsupport_trigger_prefix");
	my $sepa = Irssi::settings_get_str("ircsupport_nickname_separator");
	return if(!Irssi::settings_get_bool("ircsupport_trigger_enable"));
	return if($cmds[0] ne $prefix);
	return if($target[0] != '#');
	my @chans = split(/ /, Irssi::settings_get_str("ircsupport_trigger_channels"));
	my $found = 0;
	$found = 1 if($chans[0] =~ /^\*/);
	foreach (@chans) {
		if ($target eq $_) {
			$found = 1;
			last;
		}
	}
	return if(!$found);
	shift @cmds;
	my $node = shift @cmds;

	# TOC
	if (!$node) {
		send_children_via_notice($server, $nick, $node, \@root_nodes);
		return;
	}

	my $desc = $knowledge{$node}{'desc'} if($knowledge{$node});

	if ($address eq "public" || Irssi::settings_get_bool("ircsupport_trigger_reply_public")) {
		# privmsg to chan

		# 404?
		if (!$knowledge{$node}) {
			$server->command("MSG $target \002$nick\002$sepa No match found");
			return;
		}

		if($knowledge{$node}{'command'}) {
			$desc = expand_command($desc, $node, $target, $nick, @cmds);
			$server->command($desc);
		} else {
			# explain now
			if (@{$knowledge{$node}{'children'}} > 0 && !$cmds[0]) {
				$server->command("MSG $target \002$nick\002$sepa $desc (more details following via NOTICE)");
				send_children_via_notice($server, $nick, $node, \@{$knowledge{$node}{'children'}});
				return;
			} else {
				$tnick = ($cmds[0] ? $cmds[0] : $nick);
				$server->command("MSG $target \002$tnick\002$sepa $desc");
			}
		}
	} else {
		# notice to guy who asked

		# 404?
		if (!$knowledge{$node}) {
			$server->command("NOTICE $nick \002$node\002: No match found");
			return;
		}

		# explain now
		if (@{$knowledge{$node}{'children'}} > 0) {
			$server->command("NOTICE $nick \002$node\002: $desc");
			send_children_via_notice($server, $nick, $node, \@{$knowledge{$node}{children}});
		} else {
			$server->command("NOTICE $nick \002$node\002: $desc");
		}
	}
}


##### [ COMMANDS ] #########################################

# /IRCS: provide support on some keyword
# syntax: /ircs <keyword node> <<nick>|?>
# (nodes are defined by the data files)
#
# If the second parameter is '?', will display the response locally instead
# of sending it to someone.
sub cmd_ircs
{
	my ($data, $server, $witem) = @_;
	my ($node, $nick) = split / /, $data;
	if(!$node || !$knowledge{$node}) {
		$witem->print("ircsupport: unknown node ($node)");
		$witem->print("ircsupport: known nodes: ".join(', ', @root_nodes));
		return;
	}
	my $prefix;
	$prefix = "\002$nick\002" . Irssi::settings_get_str("ircsupport_nickname_separator") . " " if($nick);
	if($nick eq "?") {
		my $desc = ${knowledge{$node}{'desc'}};
		$desc =~ s/%/%%/g;
		Irssi::print("ircsupport: $node == $desc");
		Irssi::print("ircsupport: child nodes: ".join(', ', @{$knowledge{$node}{'children'}}))
			if(@{$knowledge{$node}{'children'}} > 0);
	} else {
		if ($witem->{'type'} ne 'CHANNEL' &&
				$witem->{'type'} ne 'QUERY') {
			Irssi::print(
				"ircsupport: must be in channel or query");
			return;
		}
		$witem->command("SAY $prefix${knowledge{$node}{desc}}");
	}
}


# /IRCK: kicks someone using a message from the kicks: node
# syntax: /irck <sub node of kicks:> nick [!]
#
# If the '!' is used, perform /KNOCKOUT instead of /KICK.
sub cmd_irck
{
	my ($data, $server, $witem) = @_;
	my ($node, $nick, $type) = split / /, $data;
	$node = "kicks:$node";
	if(!$node || !$knowledge{$node}) {
		$witem->print("ircsupport: unknown node ($node)");
		$witem->print("ircsupport: known nodes: ".join(', ', \@{$knowledge{"kicks"}{children}}));
		return;
	}
	if(!$nick) {
		$witem->print("ircsupport: for kicking people, you obviously have to tell me their nickname.");
		return;
	}
	my $method = ($type eq "!" ? "KNOCKOUT" : "KICK");
	$witem->command("$method $nick ${knowledge{$node}{desc}}");
}

# /IRCS_REHASH: reloads knowledge db
# syntax: /ircs_rehash
sub cmd_ircs_rehash
{
	ircsupp_load_db();
}

# load config initially
ircsupp_load_db();

# finally: bind handler and command
Irssi::command_bind("irck", "cmd_irck");
Irssi::command_bind("ircs", "cmd_ircs");
Irssi::command_bind("ircs_rehash", "cmd_ircs_rehash");
Irssi::signal_add_last("event privmsg", "event_privmsg");