use strict;
use warnings;
use Xchat qw( :all ); sub prnt { Xchat::print( \@_ ) }
use Data::Dumper qw( Dumper );

# This is the default kb time
use constant TIME_DEFAULT => 80;

register
	my $NAME    = 'KBTemp',
	my $VERSION = '012',
	"Kickban with timed unban";

my %conf = (
	bantime   => TIME_DEFAULT, # in seconds
	kickfirst => 1,
);

my %CMDS = (
	kbtemp => {
		usage    => "Usage: kbtemp [nick] [-time <seconds>] [reason]\n".
		            "       (default time: $conf{bantime} seconds)",
		callback => \&kbtemp,
	},
	kbtemp_set => {
		usage    => "Usage: kbtemp_set bantime <seconds>\n".
		            "       kbtemp_set kickfirst <0|1>, default 1",
		callback => \&kbtemp_set,
	}
);

hook_command($_, $CMDS{$_}{callback}, {help_text=>$CMDS{$_}{usage}})
	for keys %CMDS;
prnt("\02$NAME $VERSION\02 by b0at (use /".(join(", /", map(uc,keys%CMDS))).")");
my $PREFIX  = "\cB$NAME\cB\t ";

sub kbtemp_set {
	my (undef, $type, $value) = @{ $_[0] };
	if( defined $value and 
	    $value !~ /\D/ and 
	    exists $conf{$type=lc$type} ) 
	{
		$conf{$type} = $value;
		prnt("$PREFIX '$type' set to '$value'.");
	}
	else { prnt( $CMDS{kbtemp_set}{usage} ) }
	return EAT_XCHAT;
}

sub kbtemp {
	my (undef, $nick, @args) = @{ $_[0] };

	if( not $nick ) {
	# If nick isn't specified, prompt for it.
	# On cancel, nothing's done.
	# On okay, GETSTR will send 'kbtemp ! [args]'
	# '!' can't be in a nick, so it's a good flag
		command(
			'GETSTR '.
			'"" '.                               # default value
			'"kbtemp !" '.                       # command to run
			'"Temporarily kick/ban which nick?"' # prompt
		);
		return EAT_XCHAT; # leave it to GETSTR to continue
	}
	elsif( $nick eq '!' ) { # from GETSTR
		$nick = shift @args;
		return EAT_XCHAT unless $nick;   # nothing entered
	}

	my $time;
	if( scalar @args > 0 ) {
		if( $args[0] =~ /^-(?:ban)?time$/i ) { # /kbtemp nick -time foo
			shift @args;
			$time = shift @args;
		}
		elsif( $args[$#args-1] =~ /^-(?:ban)?time$/i ) {
			$time = pop @args;
		}
	}

	# if -time not give OR if -time WAS given, but no number followed
	$time = $conf{bantime} if( not defined $time); 

	if( $time =~ /\D/ ) { 
		prnt("$PREFIX Argument to -time must be an integer.");
		return EAT_XCHAT;
	}

	# grab user data to get their host and ident
	my $info = Xchat::user_info($nick);
	if( not defined $info   or 
	    ref $info ne 'HASH' or 
	    not exists $info->{host}) 
	{
prnt(Dumper $info);
		prnt("$PREFIX Can't find ${nick}'s user info!");
		return EAT_XCHAT;
	}

	my ($user, $host) = split("\@", $info->{host});
	my $bantype = get_prefs('irc_ban_type');
	my $mask;

	   if( $bantype == 0 ) { $mask = "*!*\@*"     .($host=~/((?:\.\w+)+)$/)[0]; }
	elsif( $bantype == 1 ) { $mask = "*!*\@$host";                              }
	elsif( $bantype == 2 ) { $mask = "*!*$user\@*".($host=~/((?:\.\w+)+)$/)[0]; }
	elsif( $bantype == 3 ) { $mask = "*!*$user\@$host";                         }
	else { # don't think this should happen
		prnt("Unknown irc_ban_type '$bantype', reverting to type 1 (*!*\@host).");
		$mask = "*!*\@$host"
	}

	# kick first or ban first? 
	# kick first seems to work well without letting the victim see the ban mask
	# if something goes wrong, you might want to switch the kick and ban command lines

	command($_) for
		($conf{kickfirst} ? () : "ban $mask" ),
		"kick $nick ".join(' ', @args),
		($conf{kickfirst} ? "ban $mask" : () ),
		"timer $time unban $mask"; # will occur in the right context

	return EAT_XCHAT;
}




__END__

by: b0at
license: public domain


Version History:

0.0.1, 14 April 2004
  - initial release
0.0.2, 28 April 2004 
  - added the neglected $reason arg for kick
0.0.3, 15 May   2004
  - added '-time' argument
  - added irc_ban_type check
0.1.0, 06 June  2004
  - use strict;, I can't believe I forgot!
  - added getstr prompt when no nick specified
  - /^\D$/ wouldn't have worked: I needed /\D/
  - added $PREFIX to output for clarity
  - cleaned it up a bit
011, 11 June 2004
  - added package back
012, 6 Aug 2005
  - package no longer needed
  - import, ho!