#!/usr/bin/perl -w
# VIM: set ts=4, set sw=4
#
package IRC::XChat::Match;

my $script_name    = "match.pl";
my $script_version = '0.1.1';

IRC::register($script_name,$script_version, "", "");
IRC::print("\cC0\cB$script_name\cB version\cC3 $script_version\cO "
           . "by \cB\cC4V\cC7etinari\cO loading...\n");

my $pkg = __PACKAGE__;

IRC::add_command_handler("MATCH",  "${pkg}::cmd_match");
IRC::add_command_handler("MATCHALL",  "${pkg}::cmd_match_all");
IRC::add_command_handler("CLONES",  "${pkg}::cmd_clones");
IRC::add_message_handler("JOIN",   "${pkg}::handle_join");

sub trim {
    local $_ = shift;
    s/^\s*//;
    s/\s*$//;
    return $_;
}

sub irc2perl {
    local $_ = shift;
    s/\@/\\@/g;
    s/\./\\./g;
    s/\*/.*/g;
    s/\?/./g;
    return $_;
}

sub handle_join {
	my $line = shift;
	$line =~ /:([^!]*)![^@]*@([^ ]*)\s+.*?\s*:(\S+)/;
	my ($nick,$host,$chan,$server) = ($1,lc($2),$3,IRC::get_info(3));
	my %userlist = IRC::user_list_short($chan,$server);

	foreach my $user (keys %userlist) {
		$userlist{$user} =~ s/^.*\@//;
		if ($host eq lc($userlist{$user})) {
			IRC::print("\cB\cC4CLONE\cO on \cB\cC4$chan\cO: "
                       . "$nick, $user: *!*\@$host");
			last;
		}
	}	
	return 0;
}

sub cmd_match_all {
    my $line = trim(shift);
    my $match       = irc2perl($line);
    my $need_header = 1;
    my @matches     = ();
    my @chanlist    = IRC::channel_list();
    my $i = 0;

    for ($i=0; $i < @chanlist; $i+=3) {
        $chan = $chanlist[$i];
        $serv = $chanlist[$i+1];
        my %userlist = IRC::user_list_short($chan,$serv);
        foreach my $nick (keys %userlist) {
            my $host = lc $userlist{$nick};
            next if $host =~ /^FETCHING$/i;
            if ($host =~ /$match/i || $nick =~ /$match/i) {
                push @matches, [$nick, $host, $chan, $serv];
            }
        }
    }
    unless (@matches) {
        IRC::print("MATCHALL: no matches found for $line");
        return 1;
    }
    
	foreach my $found (@matches) {
		if ($need_header) {
			$need_header = 0;
			IRC::print("\cB\cC0\015\cC9-----\cB-\cB-\cB-[ "
					 . "\cC4matching \cC0\cB$line\cB \cC9]--\cC3\cB"
					 . "---\cB-\cB-\cB----\cC14\cB----\cB-----"
					 . "\cB----\cB----\n");
		}
		IRC::print("\cB\cC9|\cO\cC0 ".sprintf("% 9s",$found->[0])." " 
                . $found->[0]."!".$found->[1]."\n");
		IRC::print("\cB\cC9|\cO\cC0     on ".$found->[2]." ".$found->[3]."\n" );
	}
	return 1;

}

sub cmd_match {
    my $line  = trim(shift);
    my $match          = irc2perl($line);
    my ($chan,$server) = (IRC::get_info(2),IRC::get_info(3));
    my %userlist       = IRC::user_list_short($chan,$server);
    my @matches        = ();
	my $need_header    = 1;

    foreach my $nick (keys %userlist) {
        my $host = lc $userlist{$nick};
		next if $host =~ /^FETCHING$/i;
        if ($host =~ /$match/i || $nick =~ /$match/i) {
		    push @matches, [$nick, $host];
        }
    }

    unless (@matches) {
        IRC::print("MATCH: no matches found for $line");
        return 1;
    }
    
	foreach my $found (@matches) {
		if ($need_header) {
			$need_header = 0;
			IRC::print("\cB\cC0\015\cC9-----\cB-\cB-\cB-[ "
					 . "\cC4matching \cC0\cB$line\cB \cC9]--\cC3\cB"
					 . "---\cB-\cB-\cB----\cC14\cB----\cB-----"
					 . "\cB----\cB----\n");
		}
		IRC::print("\cB\cC9|\cO\cC0 " . sprintf("% 9s",$found->[0]) . " " 
                . $found->[0] . "!" . $found->[1] );
	}
	return 1;
}

sub cmd_clones {
    my ($chan,$server) = (IRC::get_info(2),IRC::get_info(3));
    my %userlist       = IRC::user_list_short($chan,$server);
    my %clones         = ();
	my $found_clones   = 0;
	my $need_header    = 1;

    foreach my $nick (keys %userlist) {
        my $host = lc $userlist{$nick};
		next if $host =~ /^FETCHING$/i;
        $host =~ s/^.*\@//;
		push @{$clones{$host}}, $nick;
    }

	foreach my $host (keys %clones) {
		next if (@{$clones{$host}} == 1);
		$found_clones = 1;
		if ($need_header) {
			$need_header = 0;
			IRC::print("\cB\cC0\015\cC9-----\cB-\cB-\cB-[ "
					 . "\cC4clones on \cC0\cB$chan\cB \cC9]--\cC3\cB"
					 . "---\cB-\cB-\cB----\cC14\cB----\cB-----"
					 . "\cB----\cB----\n");
		}
		IRC::print("\cB\cC9|\cC0 " . join(", ", @{$clones{$host}}) 
				 . ": *!*\@$host"); 
	}
	IRC::print("CLONES: no clones found on $chan")
		unless $found_clones;
	return 1;
}

1;
#end