#!/usr/bin/perl -w
#
# null-*.pl - a smart time-oriented ignore "nullification" manager
#
# usage:
#
#   /null NICK
#   /null NICK!IDENT@HOST
#       Finds a good hostmask to target the given nickname,
#       then adds that hostmask to the standard ignore list
#       for the default given time.  When the timespan has
#       elapsed, that hostmask is removed from the ignore
#       list automatically.
#
#   /unnull NICK
#   /unnull NICK!IDENT@HOST
#       Finds the nullified hostmask which represents the
#       given nickname, if any, and expires the nullification
#       immediately.
#
#   /null-time TIMESPAN
#       Sets the default automatic nullification timespan.
#       Give times like "1d", "2 hours" or "3 minutes".
#       Supports w/week, d/day, h/hour, m/minute spans, or
#       the keyword "forever" which means two years.
#
#   /hmsp NICK
#   /hmsp NICK!IDENT@HOST
#       Simple command to find and utter the proper hostmask
#       for the given nickname.  The term "hmsp" stands for
#       the "hostmask sharing protocol."  When the auto-hmsp
#       mode is turned on, any such utterance you receive
#       from other people will be added to your own hostmask
#       nullification for your default period.  Thus, you
#       and anyone else who uses this script can quickly
#       and automatically share your apathy for certain
#       annoying victims.
#
#   /hmsp-mode BOOL
#       Sets the default automatic hostmask sharing protocol
#       receiver mode.  Give bools like 1/y/yes/on/t/true or
#       0/n/no/f/false.  When turned on, any text seen in
#       channel which resembles "hmsp://nick!ident@host" will
#       be automatically registered in your own nullification
#       list.
#
#   PRIVMSG CHANNEL "hmsp://nick!ident@host"
#       If events are seen in a channel which contain an
#       hmsp:// pseudo-uri, and if the auto-hmsp mode is on,
#       then the given hostmask is added as an automatically
#       nullified entry.
#
# Author: Speare <ed@halley.cc>
#
# Changes: 
#     in 0.1.1:
#        - defaults to hmsp-mode OFF
#        - fixed actual use of the hmsp-mode flag
#        - clearer notice on first run about default config
#     in 0.1.0:
#        - initial release
# 
package IRC::XChat::Null;

use Data::Dumper;

### config ### 
my $config_file = "$ENV{'HOME'}/.xchat2/null.conf";
### end config ###

my $script_name    = "null.pl";
my $script_version = '0.1.3';
my $pkg = __PACKAGE__;

IRC::register($script_name, $script_version, "${pkg}::save_config", "");
IRC::print("\nScript $script_name version $script_version loading...\n");

IRC::add_command_handler("NULL",   "${pkg}::cmd_null");
IRC::add_command_handler("UNNULL",   "${pkg}::cmd_unnull");
IRC::add_command_handler("NULL-TIME", "${pkg}::cmd_nulltime");
IRC::add_command_handler("HMSP", "${pkg}::cmd_hmsp");
IRC::add_command_handler("HMSP-MODE", "${pkg}::cmd_hmspmode");

IRC::add_message_handler("PRIVMSG", "${pkg}::on_privmsg");

use vars qw($conf @expirations);
load_config();

#------------------------------------------------------------------

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

#------------------------------------------------------------------

sub get_nih
{
    my $nick = shift;
    return $nick
	if ($nick =~ /.+\!.+\@.+/);

    my $channel = shift || IRC::get_info(2);
    my $server = shift || IRC::get_info(3);
    my @users = IRC::user_list($channel, $server);

    while (@users)
    {
	if ($users[0] eq $nick)
	{
	    return undef if $users[1] !~ '\@';
	    return $nick . '!' . $users[1];
	}
	shift @users;
    }

    return undef;
}

sub get_mask
{
    my $nih = get_nih(shift);
    return undef
	if not defined $nih;
    return $nih
	if ($nih =~ /\*/);

    my ($nick, $ident, $host) = split(/\!|\@/, $nih, 3);

    # add minimal splat to the host
    #
    if (1)
    {
	my @h = split(/\./, $host);
	$h[$#h] = '*'
	    if ($host =~ /^[0-9.]+$/);
	$h[0] = '*'
	    if ($host !~ /^[0-9.]+$/);
	#TODO: splat small range of ipv6 [0-9A-Fa-f:.] hosts
	$host = join('.', @h);
    }

    # splat any leading ^ ~ from ident
    #
    if (1)
    {
	$ident =~ s/^./\*/ if ($ident =~ /^[+^~]/);
    }

    # splat any nickname
    if (1)
    {
	$nick = '*';
    }

    return $nick . '!' . $ident . '@' . $host;
}

sub expire
{
    my $now = shift;

    # try to be quick,
    # we're called often, but find expirations seldom;
    # @expirations is just a cache of (sort values %nullified)

    @expirations = (sort values %{$conf->{nullified}})
	if (not @expirations);

    return if (not @expirations) || ($expirations[0] > $now);

    foreach (keys %{$conf->{nullified}})
    {
	IRC::command("/unnull " . $_)
	    if ($conf->{nullified}->{$_} <= $now);
    }

    shift @expirations
	while ((@expirations) && ($expirations[0] <= $now));
}

sub shownulls
{
    my $now = time();
    my $count = scalar keys %{$conf->{nullified}};
    my $s = ($count == 1)? '' : 's';
    my $status = "Currently nullifying $count hostmask$s";
    if ($count)
    {
	@expirations = (sort values %{$conf->{nullified}});
	# IRC::print('[' . join(', ', @expirations) . ']');
	my $fuse = ($expirations[0] - $now);
	$s = ($fuse == 1)? '' : 's';
	$status .= "; next to expire in $fuse second$s";
    }
    $status .= ".";
    IRC::print($status);
}

sub showspan
{
    IRC::print("Nullification span is currently $conf->{dspan}.");
}

sub showmode
{
    IRC::print("Nullification mode is " .
	       ($conf->{mode}? "ON" : "OFF") . ".\n");
}

sub showhelp
{
    IRC::print("Offers the commands " .
	       "/NULL, /UNNULL, /NULL-TIME, /HMSP, /HMSP-MODE.");
}

#------------------------------------------------------------------

sub cmd_null
{
    my $line = trim(shift);
    my $host = get_mask($line);

    if (not $host)
    {
	shownulls();
	IRC::print("NULL:\tusage: /null <nickname>");
	IRC::print("     \tusage: /null <nick!ident\@host>");
	IRC::print("     \tImmediately registers nullification for the hostmask");
	IRC::print("     \tfor the given nickname, and adds them the ignore list.");
	IRC::print("     \tAfter a timespan has elapsed, nullification is removed.");
	return 1;
    }

    my $then = time() + $conf->{span};
    my $dspan = $conf->{dspan};
    $conf->{nullified}->{$host} = $then;
    @expirations = ();
    IRC::print("Nullifying $host for $dspan.");
    IRC::command("/ignore $host all quiet");
    return 1;
}

sub cmd_unnull
{
    my $line = trim(shift);
    my $host = get_mask($line);
    if (not $host)
    {
	shownulls();
	IRC::print("UNNULL:\tusage: /unnull <nickname>");
	IRC::print("       \tusage: /unnull <nick!ident\@host>");
	IRC::print("       \tImmediately removes any nullification for the hostmask");
	IRC::print("       \tfor the given nickname, and removes them from the ignore list.");
	return 1;
    }

    delete $conf->{nullified}->{$host};
    IRC::print("Un-nullifying $host.");
    IRC::command("/unignore $host quiet");
    shownulls();

    return 1;
}

sub cmd_nulltime
{
    my $line = trim(shift);

    my $dspan = $conf->{dspan};
    my ($num, $key) = ($line =~ /(\d+)\s*(\w+)/);
    if ($num == 0)
    {
	showspan();
	IRC::print("NULL-TIME:\tusage: /null-time <number> <unit>");
	IRC::print("          \tUnit may be 'seconds', 'minutes', 'hours', 'days', or 'weeks'.");
	IRC::print("          \tAny new /null registration will automatically expire after the span.");
	IRC::print("          \tExisting nullifications keep their original expiration times.");
	return 1;
    }

    if ($key =~ /forever/i)
    {
	$num = 104;
	$key = 'week';
    }
    my $s = ($num == 1)? '' : 's';
    $dspan = "$num second$s";
    if ($key =~ /^(w|weeks?)$/i)
    { $dspan = "$num week$s"; $num *= 7*24*60*60; }
    if ($key =~ /^(d|days?)$/i)
    { $dspan = "$num day$s"; $num *= 1*24*60*60; }
    if ($key =~ /^(h|hours?)$/i)
    { $dspan = "$num hour$s"; $num *= 1*60*60; }
    if ($key =~ /^(m|minutes?)$/i)
    { $dspan = "$num minute$s"; $num *= 1*60; }
    $conf->{span} = $num;
    $conf->{dspan} = $dspan;

    showspan();

    return 1;
}

sub cmd_hmsp
{
    my $line = trim(shift);
    my $mask = get_mask($line);

    if ((not $mask) || (not IRC::get_info(2)))
    {
	IRC::print("HMSP:\tusage: /hmsp <nickname>");
	IRC::print("     \tusage: /hmsp <nick!ident\@host>");
	IRC::print("     \tDetermines best wildcard hostmask for a given nickname or fixed host,");
	IRC::print("     \tthen utters that with HMSP:// notation in the current channel.");
	return 1;
    }

    IRC::command("/say hmsp://$mask");

    return 1;
}

sub cmd_hmspmode
{
    my $line = trim(shift);

    my $mode;
    $mode = 0 if ($line =~ /^(0|n|no|none|off|f|false)$/i);
    $mode = 1 if ($line =~ /^(1|y|yes|all|on|t|true)$/i);
# fixed for 0.1.3 to both show the CHANGED mode, and to show usage and CURRENT mode when left blank
    if ((not $line) || (not IRC::get_info(2)))
    {
    $mode = $conf->{mode};
    showmode();
    
    IRC::print("      \tWhen ON, this client will automatically nullify any mask whenever");
    IRC::print("      \tanyone else mentions a proper HMSP:// notation to share.");
    }
    else {
    $conf->{mode} = $mode;
    $mode = $conf->{mode};
    showmode();
    }

    return 1;
}

#------------------------------------------------------------------

sub on_privmsg
{
    my $line = trim(shift);

    expire(time());

    # don't auto-ignore everyone just on someone's say-so - 0.1.2 change.
    IRC::command("/null $1")
	if ($conf->{mode}) 
        && ($line =~ m{\bhmsp://(\S+?\!\S+?\@\S+)})
        && ($line !~ m{\bhmsp://(\*+\!\*+\@\*+)}); 

    return 0; # don't swallow this privmsg
}

#------------------------------------------------------------------

sub save_config
{
    open(F, '>' . $config_file) or do
    {
	IRC::print("$script_name: Couldn't write config file: $!\n");
	return 1;
    };

    do
    {
	print F "# $config_file - config for $script_name\n";

	local $Data::Dump::Purity = 1;
	local $Data::Dump::Indent = 2;
	local $Data::Dump::Terse = 1;
	print F Dumper($conf);
    };

    close F;
    return 1;
}

sub load_config
{
    IRC::print("$script_name: ...loading configuration:\n");

    do
    {
	$conf =
	{
	    mode => 0,
	    span => 1*60*60,
	    dspan => "1 hour",
	    nullified => { },
	};
	@expirations = ();
    };

    open(F, $config_file) or do
    {
	IRC::print("$script_name: Couldn't read config file: $!\n");
	IRC::print("Using default values to make a new config file.");
	shownulls();
	showspan();
	showmode();
	showhelp();
	return 1;
    };

    do
    {
	my @lines = <F>;
	$conf = eval join('', @lines);
	shownulls();
	showspan();
	showmode();
	showhelp();
    };

    close F;
}

1;