#!/usr/bin/perl -w

# Simple XChat script to filter out unwanted
# messages matching one of the expressions
# given.
#
# David Precious, davidp@preshweb.co.uk
# bigpresh on Freenode and EFNet
# Originally written 20th March 2006

# $Id: xchat-filter-messages.pl 808 2010-01-14 14:22:56Z davidp $

use strict;

my $script = 'xchat-filter-messages.pl';
my $ver    = '0.0.2';


# Filter rules are read from a file named filterrules in your XChat config
# directory.  Rules are just regexes, one per line.
my $confdir      = IRC::get_info(4);
my $rules_file   = $confdir . '/filterrules';
my @rules        = ();  # will be populated by read_rules

&read_rules;    # read in the rules file

IRC::register( $script, $ver, "", "" );
IRC::add_message_handler( 'PRIVMSG', 'parse_line' );
IRC::add_message_handler( 'NOTICE',  'parse_line' );
IRC::add_command_handler( 'filterrules', 'read_rules' );
my $svnid = '$Id: xchat-filter-messages.pl 808 2010-01-14 14:22:56Z davidp $';
IRC::print("*** \0038,2$script v$ver ($svnid) loaded \003");

sub read_rules {
    # read (or re-read) the rules file.
    @rules = ();
    open(my $rulesfh, '<', $rules_file)
        or IRC::print("** Failed to read rules file $rules_file - $!") and return;
    while (my $rule = <$rulesfh>) {
        chomp $rule;
        next unless $rule =~ /^[^#]/;
        push @rules, $rule;
    }
    close $rulesfh;
    IRC::print( "$script loaded " . scalar @rules . " rules from $rules_file" );
    return 1;
}


# test each filter rule against this line.
# returns 1 if line should be dropped or 0 if it didn't match.
sub check_filter {
    my $line = shift;

    for my $rule (@rules) {
        return 1 if ( $line =~ /$rule/ );
    }
    return 0;

}


# Called when a PRIVMSG/NOTICE is received; check whether to filter it out or
# not. Returning true indicates the message should be swallowed.
sub parse_line {
    my $line = shift;

    # replace the funky colour stuff:
    $line =~ s/\cc[0-9]{2}//g;


    if (check_filter($line)) {
        # Matches a filter rule, drop it immediately:
        return 1;
    }

    
    # OK, now see if it's a mass nick-alert muppet:    
    if (my($nick, $user, $host, $msgtype, $to, $msgtxt)
        = $line =~ /:(\S+)!(\S+)@(\S+) \s ([A-Z]+) \s (\S+) \s:(.+)/x ) 
    {
        # If it wasn't to a channel, nothing to do here:
        return unless $to =~ /^#/;

        # OK, get a list of people in this channel:
        my @chan_users_list = IRC::user_list_short($to);
        my %chan_users;
        while (my($nick,$host) = splice @chan_users_list, 0, 2) {
            $chan_users{$nick}++;
        }

        # Now, for each word of the message, see if it's a nick.  If we see many
        # nicks, we'll filter it.
        my $nicks_mentioned;
        for my $word (split /\s+/, $msgtxt) {
            $nicks_mentioned++ if $chan_users{$word};
        }
        if ($nicks_mentioned > 5) {
            IRC::print("*** Blocking nick-spamming from $nick in $to");
            return 1;
        }

        # OK, it didn't match any filters in the filters file, and didn't
        # mention too many nicks - let it through:
        return;
    }

}    # end of sub parse_line