#!/usr/local/bin/perl -w
# vi:set wm=0 ai sm:

use strict;
use IO::Socket::INET;

#=======================================================================
# this program, in its current form, joins a channel on a server, and
# maintains its connection.  it will listen for lines that mention it by
# name, and respond publically, or privately if the command was /msg'd.
# it has a few housekeeping functions built in (help, status, etc.).
# it will attempt to re-join its channel if it goes too long without a
# PING, and will adapt itself to whatever the PING interval is on your
# server.  unmodified, this program will join a channel and respond
# when spoken to, but all it really does is say hello back.  the status
# function gives information on the pingtime learning data.
# 
# search for the keyword CHANGE (all caps) to find places you need to
# change.
#
# in addition to creating a neat program, you'll want to update the
# following functions:
#
# print_status()
# print_usage()
#
# ...and the variables contained in the first section of the program.
# keeping variable information in %state simplifies tracking and passing
# information.
#
# information kept in %state that's not entirely obvious:
#
# $state{'to'}: recipient of the incoming message
# $state{'recip'}: recipient of the outgoing message
# $state{'nick'}: sender of the incoming message
# $state{'alarm'}: set to 1 if the timeout alarm has been tripped, 0
#   otherwise (set to 1 to force the bot to reconnect)
# $state{'alarm_data_count'}: number of PINGs heard
# $state{'ping_time_accum'}: summation of ping times so far
# $state{'socket'}: the socket being used for comms with the irc server
#
# note that most or all of this information is available by the time 
# sample_action() runs, so if you put your function there, you'll have
# access to this information.
#
# if you base a bot off this code, please send me a copy, i'd like to
# see how it's being used.
#
# Ian Johnston <reaper@obairlann.net>, January 2004
# based on original code by dikai <mgjohn@u.washington.edu>
#=======================================================================
#-----------------------------------------------------------------------

#=======================================================================
# global variables
#=======================================================================

my %state;

#-----------------------------------------------------------------------
# CHANGE server variables 
$state{'server'} = "irc.foo.com";
$state{'channel'} = "#test";

# nick to use (displayed on the channel, and the name to which we respond)
$state{'prog_nick'} = "genericbot";

#-----------------------------------------------------------------------
# CHANGE: add your program-specific variables here
# using %state simplifies passing arguments


#-----------------------------------------------------------------------
# more useful vars

# regex list of chars separating "my name" from "cmd" text (ie
# "genericbot: foo" or "genericbot, foo")
$state{'separator_chars'} = "[:,]";

# regex list of commands that will make us die off, case insensitive
$state{'term_cmds'} = "(quit|die|terminate|piss off)";

# how long to go without a PING before assuming we've been disconnected,
# and attempt a reconnection.  set to zero to disable PING timeout
# checking.  in seconds
$state{'timeout'} = (5 * 60);

# set this to "yes" to let the bot learn how often pings normally
# happen, and adapt its timeout time accordingly
# set this to "no" if you don't want the program to guess at pingtimes,
# or if your computer system doesn't include SIGALRM functionality (ie,
# if you're not using a POSIX system of some kind)
$state{'learn_pingtime'} = "yes";

#=======================================================================
# main program
#=======================================================================

$SIG{ALRM} = sub { $state{'alarm'} = 1; print STDERR "handler caught alarm\n" };
alarm($state{'timeout'});

$state{'socket'} = join_channel(\%state);
my $socket = $state{'socket'};

main_loop(\%state);

while (1)
{
	if ($state{'alarm'} && $state{'alarm'} == 1)
	{
		reset_alarm(\%state);
		reconnect(\%state);
		main_loop(\%state);
	}
	else
	{
		main_loop(\%state);
	}
}

close($socket);

#=======================================================================
# subroutines you'll want to CHANGE
#=======================================================================

#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
sub main_loop
{
	my $state_ref = shift;

	my $socket = $state_ref -> {'socket'};
	while(<$socket>)
	{
		$state_ref -> {'line'} = $_;
		my $line = $state_ref -> {'line'};

		# figure out who the message is to, if it's a communication,
		# otherwise deal with pings to stay alive.
		if ($line =~ /PRIVMSG/)
		{
			get_recip_info($state_ref);
		}
		elsif ($line =~ /^PING :(.*)$/)
		{
			reset_alarm($state_ref);
			irc_send($state_ref, "PONG :$1");
			next;
		}
		else
		{
			next;
		}

		# clean up the line for later use
		$state_ref -> {'msg'} =~ s/\s/+/g;
		$state_ref -> {'msg'} =~ s/['"]/'/g;
		$state_ref -> {'msg'} =~ s/[\&`*#]//g;

		my $prog_nick = $state_ref -> {'prog_nick'};
		my $seps = $state_ref -> {'separator_chars'};

		# if the line is a message to someone...
		if ($state_ref -> {'msg'} =~ /^$prog_nick$seps/i || 
			$state_ref -> {'to'} =~ /$prog_nick/i)
		{
			$state_ref -> {'msg'} =~ s/^$prog_nick[:,]\+*//;

			# deal with housekeeping requests
			next if (do_generic_action($state_ref));

			# CHANGE: add your program actions here
			sample_action($state_ref);
		}
		else
		{
			# CHANGE
			# the irc line isn't addressed directly to us
			# do non-addressed actions here (eg, search for URLs)
		}
	}
}

#-----------------------------------------------------------------------
# print out a status message. this function is called from
# do_generic_action() CHANGE
#-----------------------------------------------------------------------
sub print_status
{
	my $state_ref = shift;

	my $alarm_count = $state_ref -> {'alarm_data_count'} || "0";
	my $timeout = $state_ref -> {'timeout'};

	my $time_left = alarm(0);
	alarm($time_left);
	irc_say($state_ref, "$time_left seconds left until timeout");

	if ($state_ref -> {'learn_pingtime'} && 
		$state_ref -> {'learn_pingtime'} eq "yes")
	{
		irc_say($state_ref, "PING timeout learning enabled");
		irc_say($state_ref, "$alarm_count datapoints collected");
		irc_say($state_ref, "timeout alarm is set to $timeout seconds");
	}
	else
	{
		irc_say($state_ref, "PING timeout learning disabled");
	}
}

#-----------------------------------------------------------------------
# CHANGE: this is just a little sample function that "does something"
#-----------------------------------------------------------------------
sub sample_action
{
	my $state_ref = shift;

	my $in_nick = $state_ref -> {'nick'};
	my $recip = $state_ref -> {'recip'};
	my $nick = $state_ref -> {'prog_nick'} || "--no nick specified--";

	irc_say($state_ref, "hello $in_nick, i am $nick, talking to $recip");
}

#-----------------------------------------------------------------------
# print out a usage message explaining how to use the bot.  you will
# probably want to modify this function. CHANGE
#-----------------------------------------------------------------------
sub print_usage
{
	my $state_ref = shift;

	my $prog_nick = $state_ref -> {'prog_nick'};
	warn "No program nick specified in print_usage(); please add to \$state{'prog_nick'}\n" if (!$prog_nick);

	my $term_cmds = $state{'term_cmds'};
	irc_say($state_ref, "$prog_nick takes the following commands:");
	irc_say($state_ref, "\"$prog_nick: [any text]\" - get a generic response");
	irc_say($state_ref, "\"$prog_nick: status\" - print current status");
	irc_say($state_ref, "\"$prog_nick: $term_cmds\" - kill program");
	irc_say($state_ref, "\"$prog_nick: help\" - this message");
}


#=======================================================================
# you can probably leave the following subroutines alone
#=======================================================================

#-----------------------------------------------------------------------
# how to print information to the irc server
#-----------------------------------------------------------------------
sub irc_send
{
	my $state_ref = shift;
	my $msg = shift;

	my $socket = $state_ref -> {'socket'};
	die "No socket specified in irc_send(), quitting\n" if (!$socket);
	die "No message specified in irc_send(), quitting\n" if (!$msg);

	print $socket "$msg\n\r";
}

#-----------------------------------------------------------------------
# how to say something to someone on the irc server (either a channel or
# an individual)
#-----------------------------------------------------------------------
sub irc_say
{
	my $state_ref = shift;
	my $msg = shift;

	my $socket = $state_ref -> {'socket'};
	my $recip = $state_ref -> {'recip'};

	die "No socket specified in irc_say(), quitting\n" if (!$socket);
	die "No message specified in irc_say(), quitting\n" if (!$msg);
	die "No recipient specified in irc_say(), quitting\n" if (!$recip);

	irc_send($state_ref, "PRIVMSG $recip :$msg")
}


#-----------------------------------------------------------------------
# this function joins the channel of your choice.  make sure 'server',
# 'proc_nick' and 'channel' are set.
#-----------------------------------------------------------------------
sub join_channel
{
	my $state_ref = shift;

	my $server = $state_ref -> {'server'};
	die "No server specified in join_channel(), quitting\n" if (!$server);
	my $nick = $state_ref -> {'prog_nick'};
	die "No program nick specified in join_channel(), quitting\n"
		if (!$nick);
	my $channel = $state_ref -> {'channel'};
	die "No channel specified in join_channel(), quitting\n" 
		if (!$channel);

	my $socket = IO::Socket::INET->new("$server:6667") or 
		die "Can't establish connection to $server:6667: $!\n";

	$state_ref -> {'socket'} = $socket;

	irc_send($state_ref, "USER $nick $nick $nick $nick $nick");
	irc_send($state_ref, "NICK $nick");

	while (<$socket>)
	{
		last if (/^:$nick MODE $nick :.*/);
	}

	irc_send($state_ref, "JOIN $channel");

	print STDERR "successfully joined channel $channel\n";

	return($socket);
}

#-----------------------------------------------------------------------
# a function to figure out who's communicating with whom.  should only 
# need to be called once per irc line.
#-----------------------------------------------------------------------
sub get_recip_info
{
	my $state_ref = shift;
	my $line = $state_ref -> {'line'};

	my @bits = split(/\s/, $line);

	$state_ref -> {'nick'} = $bits[0];
	$state_ref -> {'nick'} =~ s/:(.*)!.*/$1/;

	$state_ref -> {'to'} = $bits[2];

	$state_ref -> {'msg'} = join(" ", @bits[3..$#bits]);
	$state_ref -> {'msg'} =~ s/^://;

	if ($state_ref -> {'to'} eq $state_ref -> {'channel'})
	{
		$state_ref -> {'recip'} = $state_ref -> {'channel'};
	}
	elsif ($state_ref -> {'to'} eq $state_ref -> {'prog_nick'})
	{
		$state_ref -> {'recip'} = $state_ref -> {'nick'};
	}
}


#-----------------------------------------------------------------------
# figure out whether to send the response back to a channel or an
# individual
#-----------------------------------------------------------------------
sub get_recip
{
	my $state_ref = shift;

	if ($state_ref -> {'to'} eq $state_ref -> {'channel'})
	{
		$state_ref -> {'recip'} = $state_ref -> {'channel'};
	}
	elsif ($state_ref -> {'to'} eq $state_ref -> {'prog_nick'})
	{
		$state_ref -> {'recip'} = $state_ref -> {'nick'};
	}
}


#-----------------------------------------------------------------------
# this function handles all the non-specific stuff, like killing the
# bot, printing out a status message, etc.  returns with a 1 if it did
# something, and a 0 if it didn't.
#-----------------------------------------------------------------------
sub do_generic_action
{
	my $state_ref = shift;

	my $msg = $state_ref -> {'msg'};

	my $return = 0;

	my $term_cmds = $state{'term_cmds'};
	$term_cmds =~ s/\s/\\+/g;

	if ($msg =~ /^help$/i || $msg =~ /^\?$/)
	{
		print_usage($state_ref);
		$return = 1;
	}
	elsif ($msg =~ /^status$/i)
	{
		print_status($state_ref);
		$return = 1;
	}
	elsif ($msg =~ /^$term_cmds/i)
	{
		irc_say($state_ref, "ok, shutting down");
		exit(0);
	}

	return($return);
}

#-----------------------------------------------------------------------
# this function is called when it appears that we've been disconnected
# from the server.  it closes the connection and attempts to re-
# establish it.
#-----------------------------------------------------------------------
sub reconnect
{
	my $state_ref = shift;

	$state_ref -> {'alarm'} = 0;
	print STDERR "looks like we timed out, trying to close the connection\n";

	my $socket = $state_ref -> {'socket'};
	if($socket) { close($socket) or die "Can't close socket: $!\n"; }

	print STDERR "success closing the connection, rejoining the channel\n";

	return(join_channel($state_ref));
}

#-----------------------------------------------------------------------
# a function to reset the timeout alarm.  this function also "learns"
# what the correct timeout should be by averaging ping times so far and
# multiplying that number by 2.1, so it will miss two PINGs before
# resettting the connection.
#-----------------------------------------------------------------------
sub reset_alarm
{
	my $state_ref = shift;

	my $learn = $state_ref -> {'learn_pingtime'};
	my $timeout = $state_ref -> {'timeout'};
	
	my $time_left = alarm(0);

	if ($learn && $learn eq "yes" && $timeout && $timeout != 0)
	{
		$state_ref -> {'alarm_data_count'}++;
		$state_ref -> {'ping_time_accum'} += 
			($state_ref -> {'timeout'} - $time_left);
		$state_ref -> {'timeout'} = int(($state_ref -> 
			{'ping_time_accum'} / $state_ref -> 
			{'alarm_data_count'}) * 2.1);
	}

	alarm($state_ref -> {'timeout'});

	return($time_left);
}