#!/bin/perl
use strict;
use warnings;
use POSIX;

use vars qw($VERSION %IRSSI);
$VERSION = "1.0";
%IRSSI = (
	authors => 'Adam Sampson',
	contact => 'ats\@offog.org',
	name => 'axdcc',
	description => 'xdcc search tool',
	license => 'GPLv2',
	url => '',
	changed => '$VERSION',
);

use Irssi;
use vars qw(%servers @files $do_request);
# %servers maps server names to \(type, time-last-listed, server, set,
#     time-last-seen)
# @files lists \(name, server, slot, size)

sub msg($) {
	my ($msg) = @_;
	Irssi::print "\%R<<axdcc>>\%n $msg", MSGLEVEL_CLIENTCRAP;
}

sub ftime($) {
	my ($time) = @_;
	return POSIX::strftime("%H:%M", localtime($time));
}

sub command_axdcc($$$) {
	my ($args, $server, $witem) = @_;
	$args =~ /^([^ ]+)( (.*))?$/;
	my ($command, $arg) = ($1, $3);
	$command = "" unless defined $command;

	if ($command eq "+s") {
		advert_seen("xdcc", $arg, $arg, $server, undef);
	} elsif ($command eq "-s") {
		del_server($arg);
	} elsif ($command eq "s") {
		list_servers();
	} elsif ($command eq "f") {
		find_files($arg);
	} elsif ($command eq "r") {
		request_server($arg);
	} elsif ($command eq "+r") {
		$do_request = 1;
	} elsif ($command eq "-r") {
		$do_request = 0;
	} else {
		msg("unknown command");
	}
}

sub request_server($) {
	my ($name) = @_;
	my $TOO_RECENT = 31*60;

	my $s = $servers{$name};
	my $now = time();
	if (($now - $s->[1]) < $TOO_RECENT) {
		msg("not listing $name - too recent");
		return;
	}
	my $cmd = list_cmd($name);
	if (defined $cmd) {
		msg("listing $name");
		my $server = $s->[2];
		$server->command($cmd);
		$s->[1] = $now;
	} else {
		msg("not listing $name - no known list");
	}
}

sub server_seen($$$$) {
	my ($type, $nick, $server, $set) = @_;
	my $now = time();
	if (defined $servers{$nick}) {
		$servers{$nick}->[0] = $type if defined $type;
		$servers{$nick}->[2] = $server;
		$servers{$nick}->[3] = $set if defined $set;
		$servers{$nick}->[4] = $now;
	} else {
		msg("new server seen: $nick");
		$servers{$nick} = [ $type, 0, $server, $set, $now ];
	}
}

sub remove_old_servers() {
	my $TOO_OLD = 121*60;

	my $now = time();
	foreach my $nick (keys %servers) {
		if (($now - $servers{$nick}->[4]) >= $TOO_OLD) {
			msg("removing $nick");
			del_server($nick);
		}
	}
}

sub advert_seen($$$$$) {
	my ($type, $advert_nick, $nick, $server, $set) = @_;
	$nick = lc $nick;
	$advert_nick = lc $advert_nick;
	if ($advert_nick ne $nick) {
		msg("odd new server: $advert_nick advertising for $nick");
		return;
	}
	remove_old_servers();
	server_seen($type, $nick, $server, $set);
	request_server($nick) if $do_request;
}

sub del_server($) {
	my ($nick) = @_;
	delete $servers{$nick};
	@files = grep { $_->[1] ne $nick } @files;
}

sub list_servers() {
	my $now = time();
	msg("Server listing at " . ftime($now));
	foreach my $name (sort keys %servers) {
		my $s = $servers{$name};
		my $type = $s->[0];
		$type = "unknown" unless defined $type;
		msg("$name -- $type -- L" . ftime($s->[1])
			. " A" . ftime($s->[4]));
	}
}

sub mangle($) {
	my ($l) = @_;
	$l = lc $l;
	$l =~ s/\[[^\]]*\]//g;
	$l =~ s/_/ /g;
	$l =~ s/\s+/ /g;
	$l =~ s/^ //;
	$l =~ s/ $//;
	return $l;
}

sub send_cmd($$) {
	my ($nick, $num) = @_;
	my ($type, $time, $server, $set) = @{$servers{$nick}};
	$type = "unknown" unless defined $type;
	if ($type eq "xdcc") {
		return "/msg $nick xdcc send #$num";
	} elsif ($type eq "xdcc_c") {
		return "/ctcp $nick xdcc send #$num";
	} elsif ($type eq "cdcc") {
		return "/ctcp $nick cdcc send #$num";
	} elsif ($type eq "sysreset") {
		return "/ctcp $nick XDCC GET $set #$num";
	} else {
		return "[unknown: $nick $num]";
	}
}

sub list_cmd($) {
	my ($nick) = @_;
	my ($type, $time, $server, $set) = @{$servers{$nick}};
	$type = "unknown" unless defined $type;
	if ($nick eq "r-b|misuzu") {
		# Specifically no listings for this bot...
		return undef;
	} elsif ($type eq "xdcc") {
		return "/msg $nick xdcc list";
	} elsif ($type eq "xdcc_c") {
		return "/ctcp $nick xdcc list";
	} elsif ($type eq "sysreset") {
		return undef unless defined $set;
		return "/ctcp $nick XDCC LIST $set";
	} else {
		return undef;
	}
}

sub find_files($) {
	my ($search) = @_;
	$search = "" unless defined $search;
	my @searches = split " ", $search;
	my @found = ();
	FILE: foreach my $f (@files) {
		my $name = $f->[0];
		foreach my $s (@searches) {
			next FILE if (index(lc $name, lc $s) == -1);
		}
		my $s = send_cmd($f->[1], $f->[2]);
		push @found, "$name -- $f->[3] -- $s";
	}
	msg("Found " . ($#found + 1) . " matches:");
	foreach my $f (sort { mangle($a) cmp mangle($b) }  @found) {
		msg($f);
	}
}

sub new_file($$$$$) {
	my ($server, $nick, $num, $file, $size) = @_;
	$nick = lc $nick;
	@files = grep { not ($_->[1] eq $nick and $_->[2] eq $num) } @files;
	server_seen(undef, $nick, $server, undef);
	push @files, [ $file, $nick, $num, $size ];
} 

sub handle_msg($$$) {
	my ($server, $nick, $text) = @_;
	$_ = $text;

	# Remove colours.
	s/\cB//g;
	s/\cC[^\d,]//g;
	s/\cC\d\d?//g;
	s/\cC,\d\d?//g;
	s/\cD[abcdeghi]//g;
	s/\cDf[^,]*,//g;
	s/\cD..//g;
	s/\cF//g;
	s/\cO//g;
	s/\c_//g;

	# Trim whitespace.
	s/^\s+//;
	s/\s+$//;
	s/\s+/ /g;

	$text = $_;

#  ** For a listing type: "/msg sadisticroot xdcc list" **
	if ($text =~ /^\*\* For a listing type: .*\/msg ([^ ]+) xdcc list/) {
		advert_seen("xdcc", $1, $nick, $server, undef);
# - syntax: /ctcp I||uSion xdcc send #<pack number>
	} elsif ($text =~ /^- syntax: \/ctcp ([^ ]+) xdcc send \#/) {
		advert_seen("xdcc_c", $1, $nick, $server, undef);
# [cdcc] 1 file offered- /ctcp peniX cdcc send #x for pack #x
	} elsif ($text =~ /^\[cdcc\] .* \/ctcp ([^ ]+) cdcc send \#/) {
		advert_seen("cdcc", $1, $nick, $server, undef);
# [XDCC Active] - Sends:[2/10] - Queues:[0/50] - Record CPS:[466.5kB/s by Mahtai] - Upload Speed:[15.8kB/s] - List Trigger:[/ctcp Strat|boredAtWork XDCC LIST kodocha] - Description:[Kodocha DVD Rips eps 1-6] - SysReset 2.50
	} elsif ($text =~ /^\[XDCC Active\].*Trigger:\[\/ctcp ([^ ]+) XDCC LIST (.+?)\] -.*SysReset/) {
		advert_seen("sysreset", $1, $nick, $server, $2);
# [XDCC Active] - Sends:[2/2] - Queues:[2/30] - Record CPS:[47.4kB/s by Larry475] - Bytes Sent:[15.91GB] - Files Sent:[104] - Total Bandwidth:[64.7kB/s] - Description:[AonE Latest Releases] - SysReset 2.50
	} elsif ($text =~ /^\[XDCC Active\].*SysReset/) {
		advert_seen("sysreset", $nick, $nick, $server, undef);
# Usage: /ctcp AonE|Kazuya XDCC GET AonE #<pack number>
	} elsif ($text =~ /^Usage: \/ctcp ([^ ]+) XDCC GET (.*) \#/) {
		advert_seen("sysreset", $1, $nick, $server, $2);
# ** 6 packs **  4 of 10 slots open, Record: 202.7KB/s
	} elsif ($text =~ /^\*\* (\d+) packs? \*\* (\d+) of (\d+) slots open/) {
		advert_seen("xdcc", $nick, $nick, $server, undef);
# #1  27x [167M] Adventures of the Airship Patapata 1 [M-A&AH]
	} elsif ($text =~ /^\#(\d+) (\d+)x \[(.+?)\] (.*)$/) {
		new_file($server, $nick, $1, $4, $3);
# [#01] [ 94 Gets] [199M] - [Ishin]_Whistle_-_01.avi
	} elsif ($text =~ /^\[\#(\d+)\] \[\s*(\d+) Gets\] \[([^\]]+)\] - (.*)$/) {
		new_file($server, $nick, $1, $4, $3);
# [#1] (4x|197.7Mb) - Hunter X Hunter 57
	} elsif ($text =~ /^\[\#(\d+)\] \((\d+)x\|([^\)]+)\) - (.*)$/) {
		new_file($server, $nick, $1, $4, $3);
# % #1  ( 10.07mb:  25 gets) Mahoromatic chapter 5
	} elsif ($text =~ /^\% \#(\d+) \( ?([^ ]+): \d+ gets\) (.*)$/) {
		new_file($server, $nick, $1, $3, $2);
# [#1] [202.2MB] - Tokyo Mew Mew 07 [173 Gets]
	} elsif ($text =~ /^\[\#(\d+)\] \[([^\]]+)\] - (.*) \[(\d+) Gets\]$/) {
		new_file($server, $nick, $1, $3, $2);
	} else {
#		msg("other message: '$text'");
#		my $i;
#		for ($i = 0; $i < length $text; $i++) {
#			my $c = substr($text, $i, 1);
#			msg("char $i = $c (" . (ord $c) . ")");
#		}
	}
}

sub event_private_message {
	my ($server, $text, $nick, $address) = @_;
	handle_msg($server, $nick, $text);
}

sub event_message_irc_notice {
	my ($server, $text, $nick, $address, $target) = @_;
	handle_msg($server, $nick, $text);
}

sub event_public_message {
	my ($server, $text, $nick, $address, $target) = @_;
	handle_msg($server, $nick, $text);
}

sub event_nick {
	my ($server, $newnick, $nick, $address) = @_;
	# do nothing, for now
}

$do_request = 0;
Irssi::signal_add('message irc notice', 'event_message_irc_notice');
Irssi::signal_add('message private', 'event_private_message');
Irssi::signal_add('message public', 'event_public_message');
Irssi::signal_add('event nick', 'event_nick');
Irssi::command_bind('axdcc', 'command_axdcc');
msg("loaded");