#!/usr/bin/perl

# xchat-presh.pl
#
# A custom script for xchat to add useful features
# that I want.
#
# David Precious (bigpresh) May 2006
#
#
# TODO: make beeping work
#
# TODO: enable auto-whois on/off per chan setting
#
# TODO: tracking last seen / last message
#
# TODO: convert all calls to the new-style Xchat:: interface


# changed 24/06/2006 to avoid doing auto-whois on
# our own nick


# use Storable;
# store \%table, 'file';
# $hashref = retrieve('file');


my $script = 'xchat-presh.pl';
my $ver = '0.0.1';
$confdir = IRC::get_info(4);

my $mynick = Xchat::get_info('nick');


# the channels we should beep when our
# nick is uttered:
%beep_on = (
	'#irish-buzzerz'   => 1,
	'#hertslug'        => 1,
	'#xxxchat'         => 1,
	'#burn'            => 1,
	'#thezone'         => 1,
	'#chat'            => 1,
	'#triviafun'       => 0
	);

# the channels we should do the auto-whois for:
%auto_whois_on = (
	'#irish-buzzerz'   => 1,
	'#hertslug'        => 1,
	'#sharosmadhouse'  => 1,
	'#teenworld'       => 1
	);

$max_whois_queue = 5;

$beeping = 0;

%whois_data = (); # to store whois data
%whois_queue = (); # whois results we've asked for

IRC::register ($script, $ver, "", "");

# handling IRC events
IRC::add_message_handler('PRIVMSG', 'parse_line');
IRC::add_message_handler('NOTICE', 'parse_line');
IRC::add_message_handler('join', 'on_join');

# for handling whois responses and grabbing ones
# we asked for
IRC::add_message_handler("311", "whoisuser_handler");
IRC::add_message_handler("318", "endofwhois_handler");
# extra messages generated by a whois
IRC::add_message_handler("319", "whoisextra_handler");
IRC::add_message_handler("312", "whoisextra_handler");
IRC::add_message_handler("317", "whoisextra_handler");
IRC::add_message_handler("320", "whoisextra_handler");
IRC::add_message_handler("335", "whoisextra_handler");
IRC::add_message_handler("307", "whoisextra_handler");

# handling our special commands
IRC::add_command_handler ('slap','slap');
IRC::add_command_handler ('beep','beep');


IRC::print("*** \0038,2$script v$ver loaded \003");
IRC::print("** Hello $mynick :) **");


sub beep {
# get/set beeping settings

@bits = split /\s/, $_[0];

if ($bits[0] eq 'status')
	{
	IRC::print('* Global beeping is; ' .
		(($beeping)? 'on' : 'off'));
	foreach $chan (keys %beep_on)
		{
		IRC::print("* Beep for [$chan] is ".
			(($beep_on{$chan})? 'on' : 'off'));
		}
	} elsif ($bits[0] =~ /^#/) {
	# setting for a chan, or checking
	$chan = $bits[0];
	if ($bits[1] ne '')
		{
		$beep_on{$chan} = $bits[1];
		IRC::print("*Beep for [$chan] is now " .
			(($beep_on{$chan})? 'on' : 'off'));
		} else {
		# no setting, so just reviewing setting:
		IRC::print("*Beep for [$chan] is " .
			(($beep_on{$chan})? 'on' : 'off'));
		}
	} elsif ($bits[0] ne '') {
	# must be single param, global beep on/off
	$beeping = $bits[0];
	IRC::print('* Global beeping is now; ' .
		(($beeping)? 'on' : 'off'));
	} elsif ($bits[0] eq '') {
	# no params, so default to just showing global beep status
	IRC::print('* Global beeping is; ' .
		(($beeping)? 'on' : 'off'));
	}

} # end of sub beep




sub parse_line {
# received a PRIVMSG or a NOTICE

my ( $sender, $type, $channel, $message ) = split( ' ', $_[0], 4 );
my ( $nick, $user ) = parse_sender( $sender );

# clean up the message
$message =~ s/^://;
$message =~ s/\cc[0-9]{2}//g;

#IRC::print("parse_line: nick:$nick chan:$channel  message:$message");

if ($beeping && $message =~ /$mynick/ && $beep_on{$channel} )
	{
	IRC::print("BEEP");
	}

} # end of sub parse_line



sub on_join {

my ( $sender, $type, $channel, $message ) = split( ' ', $_[0], 4 );
my ( $nick, $user ) = parse_sender( $sender );
$channel =~ s/^://;

# remember that we're expecting a whois response
# for this nick, so we can intercept it when it comes back:
if ((scalar %queue < $max_whois_queue) && $auto_whois_on{$channel}
	&& $nick ne $mynick)
	{
	$whois_queue{$nick} = $channel;
	# and request it:
	IRC::command("/whois $nick");
	}
return Xchat::EAT_NONE;
} # end of sub on_join




sub whoisuser_handler {
# handles the first part of the whois info
my ($server, $code, $to, $handle, $name, $host, $star, $realname) = split(/ +/, $_[0], 8);
$realname =~ s/^://;

if ($whois_queue{$handle})
	{
	# we're waiting for this response,so:
	$whois_data{$handle}{'name'} = $name;
	$whois_data{$handle}{'realname'} = $realname;
	$whois_data{$handle}{'host'} = $host;

    return Xchat::EAT_ALL; # swallows the response to stop it going in server tab
	}


}

sub whoisextra_handler {
# handles extra whois info lines (generally will contain
# the list of channels etc)
my ($server, $code, $to, $handle, $msg) = split(/ +/, $_[0], 5);

if ($whois_queue{$handle})
	{
	# we're expecting this data (we asked for it, so:
	if ($msg =~ /^:(#.+\s)+/)
		{
		# it looks like we're getting the list of chans they're in:
		$msg =~ s/^://;
		$whois_data{$handle}{'chans'} = $msg;
		}
    return Xchat::EAT_ALL; # swallows the response to stop it going in server tab
  }


} # end of sub whoisextra_handler

sub endofwhois_handler {
# this is the end of the whois info, so let's
# display it.
my ($server, $code, $to, $handle, $msg) = split(/ +/, $_[0], 5);


if (exists $whois_queue{$handle})
	{
	# this is the end of a whois response we were expecting

	$t_txt = sprintf('nick:%s host:%s name:%s',
		$handle,
		$whois_data{$handle}{'host'},
		$whois_data{$handle}{'realname'}
		);

	Xchat::print("-\cC10-\cC15- $t_txt\n",
		$whois_queue{$handle})
		|| Xchat::print("FAILED TO PRINT to:" . $whois_queue{$handle});

	Xchat::print("-\cC10-\cC15- $handle is in:" .
		$whois_data{$handle}{'chans'},
			$whois_queue{$handle})
			|| Xchat::print("FAILED TO PRINT to:" . $whois_queue{$handle});


	delete $whois_queue{$handle};
	return Xchat::EAT_ALL; # swallows the response to stop it going in server tab
	}

} # end of sub endofwhois_handler




# random slapper
sub slap {
# part of this code robbed^Wborred from another script :)
 @objects = (
	'a moistened badger',
	'a wily terrapin',
	'a pair of curiously-fragranced underpants',
	'a club hammer',
	'a cheese and ham sandwich',
	'a crocodile',
	'a nun',
	'a wet trout',
	'a wet haddock',
	'a large mackerel',
	'a dead goldfish',
	'a piece of fresh roadkill',
	'a large red tractor',
	'a fresh skunk',
	'an angry chicken',
	'a used tampax',
	'a used condom',
	'a sad-looking armadillo',
	'a confused-looking kangaroo',
	'a frying pan',
	'a diseased chinese whore-pig',
	'the clue stick',
	'what\'s left of a small leper',
	'a big cup of fuck-right-off',
	'a rancid badger',
	'some freshly-procured roadkill',
	'a great white shark',
	'two and a half badgers',
	'an unidentified mushroom',
	'an oak tree',
	'a cheap whore',
	'a shovel',
	'a pick-axe',
	'a bottle of vodka',
	'an angry camel',
	'fifteen nuns in a minibus',
	'his keyboard',
	'a depressed clown',
	'a nuclear power station',
	"a rather large squid",
	"some girl scouts",
	"a bottle",
	"a backhander",
	"a snowplough",
	"a club. With a nail in it.",
	"a small asteroid, rich in iron",
	"a small interstellar spaceship",
	"a tortoise",
	"a horse",
	"a whale",
	"a rubber dildo",
	"a well groomed poodle",
	"a gnarly werewolf",
	"a fat walrus",
	"a catholic priest",
	"a thermonuclear weapon. Yehaw",
	"Nessie, the Loch Ness monster",
	"a tuna. Still in the can! *BONK* That will leave a mark",
	"a bag full with Michael Jacksons droped noses",
	"some grenades, sans-pin (*BOOM*)",
	"the Win2k Buglist",
	'a small yacht'
 );
 my $obj = $objects[int(rand($#objects+1))];
 IRC::command("/me slaps $_[0] with $obj.");
 return 1;
}



sub parse_sender {
# split sender into nick / user@host
my $sender = shift;
$sender =~ m/^:(.*?)!(.*)$/;
}


