### NOTE: Bot is optomised for Quakenet, using their AUTH system.
### It may in fact fail to work on other networks

use strict;
use IO::Socket;
use Switch;
use LWP::UserAgent;

# Pointless info hash, wooo!
my %info = (
	Version => "0.2b",
	Author => "Erasmus, with much help from Al",
	Description => "A basic IRC bot with a few functions"
);

# Variables to control some parts of the script. Most of these are pretty obvious.
my $channel_rejoin	= 1;
my $kick_retaliate	= 1; # This one doesn't work, and I'm not sure why.
my $invite_respond	= 1;
my $quoting		= 1; # Sets the logging of new quotes, !quote will be available even if this is set to 0

# The server to connect to and various connect details.
my $server = "irc.quakenet.org";
my $mynick = "eeeee";
my $login = "eeeee";

# A message commands hash. A hash of commands that can be contained in messages, as you may guess.
my %msgcommands = (
	qr/^!tea$/ =>		'unprotected_command("tea",$who{Nick},$target)',
	qr/^!tea (.+$)/ =>	'unprotected_command("teafoo",$who{Nick},$target,$params)',
	qr/^!grue$/ =>		'unprotected_command("grue",$who{Nick},$target)',
	qr/^!grue (.+$)/ =>	'unprotected_command("gruefoo",$who{Nick},$target,$params)',
	qr/(\W|^)life(\W|$)/ =>	'unprotected_command("life",$who{Nick},$target)',
	qr/^!g (.+$)/ =>	'unprotected_command("google",$who{Nick},$target,$params)',
	qr/^die$/ =>		'protected_command("die",$who{Nick},$target)',
	qr/^!insult (.+$)/ =>	'unprotected_command("insult",$who{nick},$target,$params)',
	qr/^hai2u, $mynick/ =>	'unprotected_command("hai", $who{nick},$target)',
	qr/^!topic (\S+$)/ =>	'unprotected_command("get_topic",$who{nick},$target,$params)'
);

# A part commands hash. Similar to %msgcommands but with PART not PRIVMSG
my %partcommands = (
	qr/^aaaarrrrghh\!\!\! \*crunch\*$/ =>	'unprotected_command("crunch",$who{Nick},$target)'
);

# The channel(s) which the bot will join.
my @channels = qw(#rtere);

# Channel hash with one example channel. The channel hash is as yet unimplemented in any meaningful way.
my %channels = (

	'#falsechannel' => (
		users => 3,
		nicklist => qw(foo bar baz),
		modes => qw(t m n),
		status => 'operator',
		topic => 'Yaaah'
	)

);

# Individuals hash that tracks users
my %individuals = (
	
	'false!user@somewhere.lol' => (
		channels => qw(#falsechannel),
		auth => 'bleh',
		nick => 'foobarface'
	)
);
		

# List of trusted auths
my @trusted = qw(
	Erasmu1
	Shiyiya
);

# Connect to the IRC server.
my $sock = new IO::Socket::INET(PeerAddr => $server, PeerPort => 6667, Proto => 'tcp') or die "Can't connect!\n";

# Log on to the server.
print $sock "NICK $mynick\r\n";
print $sock "USER $login 8 * :eeeee, the once and future bot!\r\n";

# Keep reading lines from the server.
while (my $input = <$sock>) {
	
	
	# Parsing (such as it is)
	$input =~ s/\r\n//g;
	my @stream = split(' ',$input,4);
	
	# Print input to console
	print "$input\n";
	
	###
	### @stream[0] contains info on who sent the data (*!*@* format) and PING if it's a ping.
	### @stream[1] contains number code [001 is just connected code] or message type (such as PRIVMSG)
	### @stream[2] holds the target of the message, so generally either a channel name or the bot's nick.
	### @stream[3] contains any other things, such as messages and whatnot.
	###
	
	# Deal with PINGs
	if (@stream[0] eq "PING") {
		print $sock "PONG @stream[1]\r\n";
		print "PING answered.\n";
	}
  
  	# Change my nick if some cunt has stolen it.
  	if (@stream[1] eq "433") {
  		$mynick = $mynick."e";
  		print $sock "NICK $mynick\r\n";
 	}
 	
  	# Join channels and other just-connected-things
  	if (@stream[1] eq "001") {
  		print "Connected!\n";
  		
  		# Join the channels
  		map { print $sock "JOIN $_\r\n" } @channels;
  		
  		# Quakenet AUTH /msg Q@CServe.quakenet.org AUTH I-R-A-RBOT A3kFmuoN7P, and add Qnet hostmask
  		action ("message","Q\@CServe.quakenet.org","AUTH I-R-A-RBOT A3kFmuoN7P");
  		action ("selfmode", "+x");
  	}
  	
  	# Grab channel data and basic user data:
  	# First, get the topic for all channels
  	if (@stream[1] eq "332") {
  		my @t = split(' :',@stream[3],2);
  		$channels{$t[0]}{topic} = $t[1];
  	}
  	# Then, get the userlists
  	if (@stream[1] eq "353") {
  		my @t = split(' ',@stream[3]);
  		my $chan_list = $t[1];
  		splice (@t, 0, 3);
  		foreach my $r (@t) {
  		
  			#push ($channels{$chan_list}{nicklist}, $r);
  			$individuals{known} = 1;
  			#push ($individuals{$r}{channels}, $chan_list);
  		}
  	}
  		
  	
  	# A little bit of parsing...
  	@stream[0] =~ s/://;
  	my %who = host_parse(@stream[0]);
  	my $target = @stream[2];
  	@stream[3] =~ s/://;  	
  	
  	# Message commands
  	if (@stream[1] eq "PRIVMSG") {
  	
  		my @catches = grep { @stream[3] =~ $_ } keys %msgcommands;
  		my $params = (@stream[3] =~ @catches[0])[0];
		## print "\n\n\nP: $params\n\n\n";
		
		if(scalar @catches) {
			my $eval = $msgcommands{$catches[0]};
			eval $eval;
		}
  	}
  	
  	if (@stream[1] eq "PART") {
  	
  		my @catches = grep { @stream[3] =~ $_ } keys %partcommands;
		my $params = (@stream[3] =~ @catches[0])[0];
  		
  		if(scalar @catches) {
			my $eval = $partcommands{$catches[0]};
			eval $eval;
		}
	}
		
		
  	
  	# I have been kicked, ohno!
  	if (@stream[1] eq "KICK" && @stream[3] =~ /^$mynick/) {
  	
  		# If we're allowed, rejoin.
  		if ($channel_rejoin) {
  			action("join",@stream[2]);
  		}
  		
  		# If we're allowed, kick the fucker.
  		if ($kick_retaliate) {
  			sleep 2;
  			action("kick",@stream[2],"$who{Nick} :NO U!");
  		}
  	}
  	
  	# I have been invited, YAY!
  	if (@stream[1] eq "INVITE") {
  		
  		# If we're allowed, join and say hi.
  		if ($invite_respond) {
  			action("join",@stream[3]);
  			action("action",@stream[3],"sits on ".$who{Nick});
  		}
  	}
  }
  
  # Unprotected commands
  sub unprotected_command {
  	
  	my ($command, $nick, $target, $param) = @_;
  	
  	if ($command eq "tea") { action ("action",$target,"pours tea on $nick"); }
  	
  	if ($command eq "teafoo") { action ("action",$target,"pours tea on $param"); }
  	
  	if ($command eq "grue") { 
  		my @nicklist = nick_list($target);
  		action ("message",$target,@nicklist[int(rand()*scalar(@nicklist))]." was eaten by a grue!"); 
  	}
  	
  	if ($command eq "gruefoo") { action ("message",$target,"$param was eaten by a grue!"); }
  	
  	if ($command eq "life") { action ("message",$target,"Life. Don't talk to me about life."); }
  	
  	if ($command eq "google") {
		my @results = google($param);
  		map { action ("message",$target,$_) } @results ;
  	}
  	
  	if ($command eq "insult") {
  		my $insult = make_insult();
  		action ("message",$target,$param.", ".$insult."!");
  	}
  	
  	if ($command eq "crunch" && lc($nick) eq "vurl") {
  		action ("message",$target,"Oh no! Vurl, come back!");
  		sleep 2;
  		action ("invite","vurl",$target);
  	}
  	
  	if ($command eq "hai" && lc($nick) eq "vurl") {
  		print "\n\n\n\n\n\n\n\n\n\n\n\n";
  		action ("message",$target,"hai2u, vurl! ^_^");
  	}
  	
  	if ($command eq "get_topic") {
  		action ("message",$target,"topic is ".$channels{$target}{topic});
  	}
  }
  
  # Protected commands
  sub protected_command {
  	
  	my ($command, $nick, $target, $param) = @_;
  	
  	
  	my $auth = auth($nick);
  	
  	my $access = scalar grep {$_ eq $auth} @trusted;
  	
  	if (!$access) { return 0; }
  	
  	if ($command eq "die") { action ("message",$target,"Ouch!"); exit "im ded"; }
  	
  }
  
  
  # Retrieves a list of people on a channel.
  sub nick_list {
  
  	my $channel = shift;
  	
  	# Send a request to the server and retrieve the reply.
  	print $sock "NAMES $channel\r\n";
  	my $names = <$sock>;
  	
  	# Oh good, more parsing.
  	$names =~ s/\r\n//g;
  	$names =~ s/(.*):(.*):(.*)/\3/;
  	$names =~ s/@//g;
  	
  	# Print names to console for good measure.
  	print $names."\n";
  	
  	# Split and return
  	my @list = split (" ",$names);
  	return @list;
  }
  
  
  # Parses a host of format foo!bar@baz into a hash.
  sub host_parse {
  
  	
  	# Parse, parse, parse...
  	my $host = shift;
  	$host =~ /(.+)\!(.+)\@(.+)/;
  	
  	
  	# Stick the result in a hash, for ease of access
  	my %parsed_host = (
  		Nick => $1,
  		Ident => $2,
  		Host => $3
  	);
  	
  	# Return the hash
  	return %parsed_host;
  	
  }
  
  # Gets some whois info on a nickname and parses it to something vaguely readable.
  sub whois {
  
  	my $nick = shift;
  	print "\n\nwhois invoked\n\n";
  	
  	# Send a request to the server and retrieve the reply.
  	print $sock "WHOIS $nick\r\n";
	my $whois = <$sock>;
  	
  	#Print to console
  	print "\n".$whois."\n\n";
  	
  	# DJ... parse dat shit!
  	$whois =~ s/\r\n//g;
  	$whois =~ s/://g;
  	
  	# If nickname does no exist return 0
  	if ($whois =~ /401.*No such nick/) {
  		return 0;
  	}
  	
  	# Extract me some variables
  	my ($ident, $vhost) = ( $whois =~ /311 .* .* (.*) (.*) \*/ );
  	my $host = $nick."!".$ident."@".$vhost;
  	
  	return $host;
  }
  
  # Streamlines sending messages to the server
  sub action {
  
  	my ($action_type, $location, $parameters) = @_;

	my $action;
  	
  	# Work out exactly what we need to send to the server
  	switch (lc($action_type)) {
  		case "message"		{ $action = "PRIVMSG $location :$parameters\r\n" }
  		case "action"		{ $action = "PRIVMSG $location :\001ACTION $parameters \001\r\n" }
  		case "join"		{ $action = "JOIN $location\r\n" }
  		case "part"		{ $action = "PART $location\r\n" }
  		case "invite"		{ $action = "INVITE $location $parameters\r\n" }
  		case "kick"		{ $action = "KICK $location $parameters\r\n" }
  		case "selfmode"		{ $action = "MODE $mynick $location\r\n" }
  		else			{ return 0; }
  	}
  	
  	# Send it and return. No additional parsing required.
  	print $sock $action;
  	return 1;
  }
  		
  # Queries google and parses the result
  sub google {
  	
  	my $search = shift;
  	$search =~ s/\s/+/g;
  	  	
  	# Get the page (I really, really don't understand this chunk o' code)			
	my $ua = new LWP::UserAgent;
	$ua->agent("AgentName/0.1 " . $ua->agent);
  	my $req = new HTTP::Request GET => "http://www.google.com/search?hl=en&q=$search";	
	my $res = $ua->request($req);
     	my $content = $res->content;
     	
     	# Some horrific parsing
     	$content =~ s/\"http:\/\/.*?(google\.com).*?\"//g;
     	my @s = ($content =~ /\"(http:\/\/.*?)\"/g);
     	
     	my @results;
     	
     	# Remove google cache urls in a rather clumsy manner.
     	foreach my $url (@s) {
     		if ($url !~ /cache/) {
     			push @results, $url;
     		}
     	}     	
     	
     	# splice to three results
     	splice (@results,3);
     	
     	#Return
     	return @results
     
   }
     
   # Finds out if someone is auth'd
   sub auth {
     	my $nick = shift;
	print "\n\nwhois invoked on $nick\n\n";
	  	
	# Send a request to the server and retrieve the reply.
	print $sock "WHOIS $nick\r\n";
	  	
	my $whois;
	while (<$sock>) {
			
		$whois = <$sock>;
		
		#Print to console
	  	#print "\n".$whois."\n\n";
	  		
	  	# Some parsing that I don't think is needed, but can't be bothered to test
	  	$whois =~ s/\r\n//g;
	  	print "\n".$whois."\n";
	  	
	  	# If nickname does no exist return 0
	  	if ($whois =~ /401.*No such nick|End of \/WHOIS/) {
	  		return 0;
	  	}
	  	
	  	# Find the auth and return it
	  	if ($whois =~ /330 .* (.+?) :is/) {
	  		my $auth = $1;
	  		print "found:: $auth\n\n";
	  		return $auth;
	  	}
	}
	
	# Return 0 if not auth'd
  	return 0;
  }
  
  # Sub for the insult command
  sub make_insult {
  	my @one = qw(
  	
  		artless bawdy beslubbering bootless churlish cockered clouted craven currish dankish dissembling droning errant fawning
		fobbing froward frothy gleeking goatish gorbellied impertinent infectious jarring loggerheaded lumpish mammering mangled
		mewling paunchy pribbling puking puny qualling rank reeky roguish ruttish saucy spleeny spongy surly tottering unmuzzled
		vain venomed villainous warped wayward weedy yeasty
		
	);
	
	my @two = qw(
	
		base-court bat-fowling beef-witted beetle-headed boil-brained clapper-clawed clay-brained common-kissing crook-pated
		dismal-dreaming dizzy-eyed doghearted dread-bolted earth-vexing elf-skinned fat-kidneyed fen-sucked flap-mouthed fly-bitten
		folly-fallen fool-born full-gorged guts-griping half-faced hasty-witted hedge-born hell-hated idle-headed ill-breeding
		ill-nurtured knotty-pated milk-livered motley-minded onion-eyed plume-plucked pottle-deep pox-marked reeling-ripe
		rough-hewn rude-growing rump-fed shard-borne sheep-biting spur-galled swag-bellied tardy-gaited tickle-brained toad-spotted 
		unchin-snouted weather-bitten
		
	);
	
	my @three = qw(
	
		apple-john baggage barnacle bladder boar-pig bugbear bum-bailey canker-blossom clack-dish clotpole coxcomb codpiece death-token 
		dewberry flap-dragon flax-wench flirt-gill foot-licker fustilarian giglet gudgeon haggard harpy hedge-pig horn-beast
		hugger-mugger joithead lewdster lout maggot-pie malt-worm mammet measle minnow miscreant moldwarp mumble-news nut-hook
		pigeon-egg pignut puttock pumpion ratsbane scut skainsmate strumpet varlot vassal whey-face wagtail
	);
	
	my $partone = @one[int(rand()*scalar(@one))];
	my $parttwo = @two[int(rand()*scalar(@two))];
	my $partthree = @three[int(rand()*scalar(@three))];
	
	return "thou ".$partone." ".$parttwo." ".$partthree;
}