#!/usr/local/bin/perl
# irpg bot v3.1.2 by jotun, jotun@idlerpg.net, et al. See http://idlerpg.net/
#
# Some code within this file was written by authors other than myself. As such,
# distributing this code or distributing modified versions of this code is
# strictly prohibited without written authorization from the authors. Contact
# jotun@idlerpg.net. Please note that this may change (at any time, no less) if
# authorization for distribution is given by patch submitters.
#
# As a side note, patches submitted for this project are automatically taken to
# be freely distributable and modifiable for any use, public or private, though
# I make no claim to ownership; original copyrights will be retained.. except as
# I've just stated.
#
# Please mail bugs, etc. to me. Patches are welcome to fix bugs or clean up
# the code, but please do not use a radically different coding style. Thanks
# to everyone that's contributed!
#
# NOTE: This code should NOT be run as root. You deserve anything that happens
#       to you if you run this code as a superuser. Also, note that giving a
#       user admin access to the bot effectively gives them full access to the
#       user under which your bot runs, as they can use the PEVAL command to
#       execute any command, or possibly even change your password. I sincerely
#       suggest that you exercise extreme caution when giving someone admin
#       access to your bot, or that you disable the PEVAL command for non-owner
#       accounts in your config file, .irpg.conf

use strict;
use warnings;
use IO::Socket;
use IO::Socket::INET6;
use IO::Select;
use Data::Dumper;
use Getopt::Long;
use Locale::gettext;
use POSIX;

my %opts;

readconfig();

my $version = "3.1.2+johm+chschu+gettext";

# command line overrides .irpg.conf
GetOptions(\%opts,
    "help|h",
    "verbose|v",
    "ipv6",
    "lang",
    "debug",
    "debugfile=s",
    "server|s=s",
    "botnick|n=s",
    "botuser|u=s",
    "botrlnm|r=s",
    "botchan|c=s",
    "botident|p=s",
    "botmodes|m=s",
    "botopcmd|o=s",
    "localaddr=s",
    "botghostcmd|g=s",
    "helpurl=s",
    "admincommurl=s",
    "doban",
    "silentmode=i",
    "writequestfile",
    "questfilename=s",
    "voiceonlogin",
    "noccodes",
    "nononp",
    "mapurl=s",
    "statuscmd",
    "pidfile=s",
    "reconnect",
    "reconnect_wait=i",
    "self_clock=i",
    "modsfile=s",
    "casematters",
    "detectsplits",
    "autologin",
    "splitwait=i",
    "allowuserinfo",
    "noscale",
    "phonehome",
    "owner=s",
    "owneraddonly",
    "ownerdelonly",
    "ownerpevalonly",
    "checkupdates",
    "senduserlist",
    "limitpen=i",
    "mapx=i",
    "mapy=i",
    "modesperline=i",
    "okurl|k=s@",
    "eventsfile=s",
    "rpstep=f",
    "rpbase=i",
    "rppenstep=f",
    "dbfile|irpgdb|db|d=s",
) or debug("Error: Could not parse command line. Try $0 --help\n",1);

$opts{help} and do { help(); exit 0; };

debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);

setlocale(LC_MESSAGES, $opts{lang});
bindtextdomain("irpg","lang");
textdomain("irpg");

my $outbytes = 0; # sent bytes
my $primnick = $opts{botnick}; # for regain or register checks
my $inbytes = 0; # received bytes
my %onchan; # users on game channel
my %rps; # role-players
my %quest = (
    questers => [],
    p1 => [], # point 1 for q2
    p2 => [], # point 2 for q2
    qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
    text => "",
    type => 1,
    stage => 1); # quest info
my %mapitems = (); # items lying around

my $rpreport = 0; # constant for reporting top players
my $oldrpreport = 0; # constant for reporting top players (last value)
my %prev_online; # user@hosts online on restart, die
my %auto_login; # users to automatically log back on
my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
my $pausemode = 0; # pausemode on/off flag
my $silentmode = 0; # silent mode 0/1/2/3, see head of file
my @queue; # outgoing message queue
my $lastreg = 0; # holds the time of the last reg. cleared every second.
                 # prevents more than one account being registered / second
my $registrations = 0; # count of registrations this period
my $sel; # IO::Select object
my $lasttime = 1; # last time that rpcheck() was run
my $buffer; # buffer for socket stuff
my $conn_tries = 0; # number of connection tries. gives up after trying each
                    # server twice
my $sock; # IO::Socket::INET object
my %split; # holds nick!user@hosts for clients that have been netsplit
my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages

sub daemonize(); # prototype to avoid warnings

if (! -e $opts{dbfile}) {
    $|=1;
    %rps = ();
    printf gettext("%s does not appear to exist. I'm guessing this is your ".
          "first time using IRPG. Please give an account name that you would ".
          "like to have admin access [%s]: "), $opts{dbfile}, $opts{owner};
    chomp(my $uname = <STDIN>);
    $uname =~ s/\s.*//g;
    $uname = length($uname)?$uname:$opts{owner};
    print gettext("Enter a character class for this account: ");
    chomp(my $uclass = <STDIN>);
    $rps{$uname}{class} = substr($uclass,0,30);
    print gettext("Enter a password for this account: ");
    if ($^O ne "MSWin32") {
        system("stty -echo");
    }
    chomp(my $upass = <STDIN>);
    if ($^O ne "MSWin32") {
        system("stty echo");
    }
    $rps{$uname}{pass} = crypt($upass,mksalt());
    $rps{$uname}{next} = $opts{rpbase};
    $rps{$uname}{nick} = "";
    $rps{$uname}{userhost} = "";
    $rps{$uname}{level} = 0;
    $rps{$uname}{online} = 0;
    $rps{$uname}{idled} = 0;
    $rps{$uname}{created} = time();
    $rps{$uname}{lastlogin} = time();
    $rps{$uname}{x} = int(rand($opts{mapx}));
    $rps{$uname}{y} = int(rand($opts{mapy}));
    $rps{$uname}{alignment}="n";
    $rps{$uname}{isadmin} = 1;
    for my $item ("ring","amulet","charm","weapon","helm",
                  "tunic","pair of gloves","shield",
                  "set of leggings","pair of boots") {
        $rps{$uname}{item}{$item} = 0;
    }
    for my $pen ("pen_mesg","pen_nick","pen_part",
                 "pen_kick","pen_quit","pen_quest",
                 "pen_logout","pen_logout") {
        $rps{$uname}{$pen} = 0;
    }
    writedb();
    printf gettext("OK, wrote you into %s \n"),$opts{dbfile};
}

# this is almost silly...
if ($opts{checkupdates}) {
    print gettext("Checking for updates...\n\n");
    my $tempsock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80",
                                         Timeout => 15);
    if ($tempsock) {
        print $tempsock "GET /g7/version.php?version=$version HTTP/1.1\r\n".
                        "Host: jotun.ultrazone.org:80\r\n\r\n";
        my($line,$newversion);
        while ($line=<$tempsock>) {
            chomp($line);
            next() unless $line;
            if ($line =~ /^Current version : (\S+)/) {
                if ($version ne $1) {
                    print gettext("There is an update available! Changes include:\n");
                    $newversion=1;
                }
                else {
                    printf gettext("You are running the latest version (v%s).".
				   "\n"), $1;
                    close($tempsock);
                    last();
                }
            }
            elsif ($newversion && $line =~ /^(  -? .+)/) { print "$1\n"; }
            elsif ($newversion && $line =~ /^URL: (.+)/) {
                printf gettext("\nGet the newest version from %s!\n"), $1;
                close($tempsock);
                last();
            }
        }
    }
    else { print gettext(debug("Could not connect to update server."))."\n"; }
}

print "\n".gettext(debug("Becoming a daemon..."))."\n";
daemonize();

$SIG{HUP} = "readconfig"; # sighup = reread config file

CONNECT: # cheese.

loaddb();

while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
    debug("Connecting to $opts{servers}->[0]...");
    my %sockinfo = (PeerAddr => $opts{servers}->[0]);
    if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }

    if ($opts{ipv6}) {
        $sock = IO::Socket::INET6->new(%sockinfo) or
            debug("Error: failed to connect: $!\n");
    }
    else {
        $sock = IO::Socket::INET->new(%sockinfo) or
            debug("Error: failed to connect: $!\n");
    }

    ++$conn_tries;
    if (!$sock) {
        # cycle front server to back if connection failed
        push(@{$opts{servers}},shift(@{$opts{servers}}));
    }
    else { debug("Connected."); }
}

if (!$sock) {
    debug("Error: Too many connection failures, exhausted server list.\n",1);
}

$conn_tries=0;

$sel = IO::Select->new($sock);

sts("NICK $opts{botnick}");
sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");

while (1) {
    my($readable) = IO::Select->select($sel,undef,undef,0.5);
    if (defined($readable)) {
        my $fh = $readable->[0];
        my $buffer2;
        $fh->recv($buffer2,512,0);
        if (length($buffer2)) {
            $buffer .= $buffer2;
            while (index($buffer,"\n") != -1) {
                my $line = substr($buffer,0,index($buffer,"\n")+1);
                $buffer = substr($buffer,length($line));
                parse($line);
            }
        }
        else {
            # uh oh, we've been disconnected from the server, possibly before
            # we've logged in the users in %auto_login. so, we'll set those
            # users' online flags to 1, rewrite db, and attempt to reconnect
            # (if that's wanted of us)
            $rps{$_}{online}=1 for keys(%auto_login);
            writedb();

            close($fh);
            $sel->remove($fh);

            if ($opts{reconnect}) {
                undef(@queue);
                undef($sock);
                debug("Socket closed; disconnected. Cleared outgoing message ".
                      "queue. Waiting $opts{reconnect_wait}s before next ".
                      "connection attempt...");
                sleep($opts{reconnect_wait});
                goto CONNECT;
            }
            else { debug("Socket closed; disconnected.",1); }
        }
    }
    else { select(undef,undef,undef,1); }
    if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
}


sub parse {
    my($in) = shift;
    $inbytes += length($in); # increase parsed byte count
    $in =~ s/[\r\n]//g; # strip all \r and \n
    debug("<- $in");
    my @arg = split(/\s/,$in); # split into "words"
    my $usernick = substr((split(/!/,$arg[0]))[0],1);
    # logged in char name of nickname, or undef if nickname is not online
    my $username = finduser($usernick);
    if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
    elsif (lc($arg[0]) eq 'error') {
        # uh oh, we've been disconnected from the server, possibly before we've
        # logged in the users in %auto_login. so, we'll set those users' online
        # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
        # us)
        $rps{$_}{online}=1 for keys(%auto_login);
        writedb();
        return;
    }
    $arg[1] = lc($arg[1]); # original case no longer matters
    if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
        $opts{botnick} .= 0;
        sts("NICK $opts{botnick}");
    }
    elsif ($arg[1] eq 'join') {
        # %onchan holds time user joined channel. used for the advertisement ban
        $onchan{$usernick}=time();
        if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
            delete($split{substr($arg[0],1)});
        }
        elsif ($opts{botnick} eq $usernick) {
            sts("WHO $opts{botchan}");
            (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
            sts($opcmd);
            $lasttime = time(); # start rpcheck()
        }
        elsif ($opts{autologin}) {
            for my $k (keys %rps) {
                if (":".$rps{$k}{userhost} eq $arg[0]) {
                    if ($opts{voiceonlogin}) {          
                        sts("MODE $opts{botchan} +v :$usernick");
                    }
                    $rps{$k}{online} = 1;
                    $rps{$k}{nick} = $usernick;
                    $rps{$k}{lastlogin} = time();
                    chanmsg(sprintf(gettext("%s, the level %u ".
                                            "%s, is now online from ".
                                            "nickname %s. Next level in %s."),
				    $k,$rps{$k}{level},$rps{$k}{class},
				    $usernick,duration($rps{$k}{next})));       
                    notice(sprintf(gettext("Logon successful. Next level in ".
					   "%s."),duration($rps{$k}{next})),
			   $usernick);
                }
            }
        }
    }
    elsif ($arg[1] eq 'quit') {
        # if we see our nick come open, grab it (skipping queue)
        if ($usernick eq $primnick) { sts("NICK $primnick",1); }
        elsif ($opts{'detectsplits'} &&
               "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
            if (defined($username)) { # user was online
                $split{substr($arg[0],1)}{time}=time();
                $split{substr($arg[0],1)}{account}=$username;
            }
        }
        else {
            penalize($username,"quit");
        }
        delete($onchan{$usernick});
    }
    elsif ($arg[1] eq 'nick') {
        # if someone (nickserv) changes our nick for us, update $opts{botnick}
        if ($usernick eq $opts{botnick}) {
            $opts{botnick} = substr($arg[2],1);
        }
        # if we see our nick come open, grab it (skipping queue), unless it was
        # us who just lost it
        elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
        else {
            penalize($username,"nick",$arg[2]);
            $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
        }
    }
    elsif ($arg[1] eq 'part') {
        penalize($username,"part");
        delete($onchan{$usernick});
    }
    elsif ($arg[1] eq 'kick') {
        $usernick = $arg[3];
        penalize(finduser($usernick),"kick");
        delete($onchan{$usernick});
    }
    # don't penalize /notices to the bot
    elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
        penalize($username,"notice",length("@arg[3..$#arg]")-1);
    }
    elsif ($arg[1] eq '001') {
        # send our identify command, set our usermode, join channel
        sts($opts{botident});
        sts("MODE $opts{botnick} :$opts{botmodes}");
        sts("JOIN $opts{botchan}");
        $opts{botchan} =~ s/ .*//; # strip channel key if present
    }
    elsif ($arg[1] eq '315') {
        # 315 is /WHO end. report who we automagically signed online iff it will
        # print < 1k of text
        if (keys(%auto_login)) {
            # not a true measure of size, but easy
            if (length("%auto_login") < 1024 && $opts{senduserlist}) {
                chanmsg(sprintf(gettext("%u users matching %u hosts ".
					"automatically logged in; accounts: "),
				scalar(keys(%auto_login)),
				scalar(keys(%prev_online))).
			join(", ",keys(%auto_login)));
            }
            else {
                chanmsg(sprintf(gettext("%u users matching %u hosts ".
					"automatically logged in."),
				scalar(keys(%auto_login)),
				scalar(keys(%prev_online))));
            }
            if ($opts{voiceonlogin}) {
                my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
                while (scalar @vnicks >= $opts{modesperline}) {
                    sts("MODE $opts{botchan} +".
                        ('v' x $opts{modesperline})." ".
                        join(" ",@vnicks[0..$opts{modesperline}-1]));
                    splice(@vnicks,0,$opts{modesperline});
                }
                sts("MODE $opts{botchan} +".
                    ('v' x (scalar @vnicks))." ".
                    join(" ",@vnicks));
            }
        }
        else { chanmsg(gettext("0 users qualified for auto login.")); }
        undef(%prev_online);
        undef(%auto_login);
        loadquestfile();
    }
    elsif ($arg[1] eq '005') {
        if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
    }
    elsif ($arg[1] eq '352') {
        my $user;
        # 352 is one line of /WHO. check that the nick!user@host exists as a key
        # in %prev_online, the list generated in loaddb(). the value is the user
        # to login
        $onchan{$arg[7]}=time();
        if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
            $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
            $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
        }
    }
    elsif ($arg[1] eq 'privmsg') {
        $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
        if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
            $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
            if ($arg[3] eq "\1version\1") {
                notice("\1VERSION IRPG bot v$version by jotun; ".
                       "http://idlerpg.net/\1",$usernick);
            }
            elsif ($arg[3] eq "peval") {
                if (!ha($username) || ($opts{ownerpevalonly} &&
                    $opts{owner} ne $username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
				    "PEVAL"), $usernick);
                }
                else {
                    my @peval = eval "@arg[4..$#arg]";
                    if (@peval >= 4 || length("@peval") > 1024) {
                        privmsg("Command produced too much output to send ".
                                "outright; queueing ".length("@peval").
                                " bytes in ".scalar(@peval)." items. Use ".
                                "CLEARQ to clear queue if needed.",$usernick,1);
                        privmsg($_,$usernick) for @peval;
                    }
                    else { privmsg($_,$usernick, 1) for @peval; }
                    privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
                }
            }
            elsif ($arg[3] eq "register") {
                if (defined $username) {
                    privmsg(sprintf(gettext("Sorry, you are already online as ".
					    "%s."), $username), $usernick);
                }
                else {
                    if ($#arg < 6 || $arg[6] eq "") {
                        privmsg(gettext("Try: REGISTER <char name> <password> ".
					"<class>"), $usernick);
                        privmsg(gettext("IE : REGISTER Poseidon MyPassword God ".
					"of the Sea"), $usernick);
                    }
                    elsif ($pausemode) {
                        privmsg(gettext("Sorry, new accounts may not be ".
					"registered while the bot is in pause ".
					"mode; please wait a few minutes and ".
					"try again."),$usernick);
                    }
                    elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
                           scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
                        privmsg(gettext("Sorry, that character name is already ".
					"in use."), $usernick);
                    }
                    elsif (lc($arg[4]) eq lc($opts{botnick}) ||
                           lc($arg[4]) eq lc($primnick)) {
                        privmsg(gettext("Sorry, that character name cannot be ".
					"registered."), $usernick);
                    }
                    elsif (!exists($onchan{$usernick})) {
                        privmsg(sprintf(gettext("Sorry, you're not in %s."),
					$opts{botchan}), $usernick);
                    }
                    elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
                        privmsg(gettext("Sorry, character names must be < 17 ".
					"and > 0 chars long."), $usernick);
                    }
                    elsif ($arg[4] =~ /^#/) {
                        privmsg(gettext("Sorry, character names may not begin ".
					"with #."), $usernick);
                    }
                    elsif ($arg[4] =~ /\001/) {
                        privmsg(gettext("Sorry, character names may not include".
                                " character \\001."),$usernick);
                    }
                    elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
                           "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
                        privmsg(gettext("Sorry, neither character names nor ".
					"classes may include control codes."),
				$usernick);
                    }
                    elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
                           "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
                        privmsg(gettext("Sorry, neither character names nor ".
					"classes may include non-printable ".
					"chars."), $usernick);
                    }
                    elsif (length("@arg[6..$#arg]") > 30) {
                        privmsg(gettext("Sorry, character classes must be < 31".
					" chars long."), $usernick);
                    }
                    elsif (time() == $lastreg) {
                        privmsg(gettext("Wait 1 second and try again."),
				$usernick);                
                    }
                    else {
                        if ($opts{voiceonlogin}) {
                            sts("MODE $opts{botchan} +v :$usernick");
                        }
                        ++$registrations;
                        $lastreg = time();
                        $rps{$arg[4]}{next} = $opts{rpbase};
                        $rps{$arg[4]}{class} = "@arg[6..$#arg]";
                        $rps{$arg[4]}{level} = 0;
                        $rps{$arg[4]}{online} = 1;
                        $rps{$arg[4]}{nick} = $usernick;
                        $rps{$arg[4]}{userhost} = $arg[0];
                        $rps{$arg[4]}{created} = time();
                        $rps{$arg[4]}{lastlogin} = time();
                        $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
                        $rps{$arg[4]}{x} = int(rand($opts{mapx}));
                        $rps{$arg[4]}{y} = int(rand($opts{mapy}));
                        $rps{$arg[4]}{alignment}="n";
                        $rps{$arg[4]}{isadmin} = 0;
                        for my $item ("ring","amulet","charm","weapon","helm",
                                      "tunic","pair of gloves","shield",
                                      "set of leggings","pair of boots") {
                            $rps{$arg[4]}{item}{$item} = 0;
                        }
                        for my $pen ("pen_mesg","pen_nick","pen_part",
                                     "pen_kick","pen_quit","pen_quest",
                                     "pen_logout","pen_logout") {
                            $rps{$arg[4]}{$pen} = 0;
                        }
                        chanmsg(sprintf(gettext("Welcome %s\'s new player %s, ".
						"the %s! Next level in %s."),
					$usernick,$arg[4],(@arg[6..$#arg]),
					duration($opts{rpbase})));
                        privmsg(sprintf(gettext("Success! Account %s created. ".
						"You have %u seconds idleness ".
						"until you reach level 1."),
					$arg[4],$opts{rpbase}), $usernick);
                        privmsg(gettext("NOTE: The point of the game is to see ".
					"who can idle the longest. As such, ".
					"talking in the channel, parting, ".
					"quitting, and changing nicks all ".
					"penalize you."),$usernick);
                        if ($opts{phonehome}) {
                            my $tempsock = IO::Socket::INET->new(PeerAddr=>
                                "jotun.ultrazone.org:80");
                            if ($tempsock) {
                                print $tempsock
                                    "GET /g7/count.php?new=1 HTTP/1.1\r\n".
                                    "Host: jotun.ultrazone.org:80\r\n\r\n";
                                sleep(1);
                                close($tempsock);
                            }
                        }
                    }
                }
            }
            elsif ($arg[3] eq "delold") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
				    "DELOLD"), $usernick);
                }
                # insure it is a number
                elsif ($arg[4] !~ /^[\d\.]+$/) {
                    privmsg(gettext("Try: DELOLD <# of days>"), $usernick, 1);
                }
                else {
                    my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
                                             ($arg[4] * 86400) &&
                                             !$rps{$_}{online} } keys(%rps);
                    delete(@rps{@oldaccounts});
                    chanmsg(sprintf(gettext("%u accounts not accessed in ".
					    "the last %u days removed by %s."),
				    scalar(@oldaccounts),$arg[4],$arg[0]));
                }
            }
            elsif ($arg[3] eq "del") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
				    "DEL"), $usernick);
                }
                elsif (!defined($arg[4])) {
                   privmsg(gettext("Try: DEL <char name>"), $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
			    $usernick, 1);
                }
                else {
                    delete($rps{$arg[4]});
                    chanmsg(sprintf(gettext("Account %s removed by %s."),
				    $arg[4],$arg[0]));
                }
            }
            elsif ($arg[3] eq "mkadmin") {
                if (!ha($username) || ($opts{owneraddonly} &&
                    $opts{owner} ne $username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
				    "MKADMIN"), $usernick);
                }
                elsif (!defined($arg[4])) {
                    privmsg(gettext("Try: MKADMIN <char name>"), $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
			    $usernick, 1);
                }
                else {
                    $rps{$arg[4]}{isadmin}=1;
                    privmsg(sprintf(gettext("Account %s is now a bot admin."),
				    $arg[4]),$usernick, 1);
                }
            }
            elsif ($arg[3] eq "deladmin") {
                if (!ha($username) || ($opts{ownerdelonly} &&
                    $opts{owner} ne $username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "DELADMIN"), $usernick);
                }
                elsif (!defined($arg[4])) {
                    privmsg(gettext("Try: DELADMIN <char name>"), $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
			    $usernick, 1);
                }
                elsif ($arg[4] eq $opts{owner}) {
                    privmsg(gettext("Cannot DELADMIN owner account."),
			    $usernick, 1);
                }
                else {
                    $rps{$arg[4]}{isadmin}=0;
                    privmsg(sprintf(gettext("Account %s is no longer a bot ".
					    "admin."),$arg[4]), $usernick, 1);
                }
            }
            elsif ($arg[3] eq "hog") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
				    "HOG"), $usernick);
                }
                else {
                    chanmsg(sprintf(gettext("%s has summoned the Hand of God."),
				    $usernick));
                    hog();
                }
            }
            elsif ($arg[3] eq "rehash") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "REHASH"), $usernick);
                }
                else {
                    readconfig();
                    privmsg(gettext("Reread config file."),$usernick,1);
                    $opts{botchan} =~ s/ .*//; # strip channel key if present
                }
            }
            elsif ($arg[3] eq "chpass") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "CHPASS"), $usernick);
                }
                elsif (!defined($arg[5])) {
                    privmsg(gettext("Try: CHPASS <char name> <new pass>"),
			    $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
			    $usernick, 1);
                }
                else {
                    $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
                    privmsg(sprintf(gettext("Password for %s changed."),
				    $arg[4]), $usernick, 1);
                }
            }
            elsif ($arg[3] eq "chuser") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "CHUSER"), $usernick);
                }
                elsif (!defined($arg[5])) {
                    privmsg(gettext("Try: CHUSER <char name> <new char name>"),
                            $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
			    $usernick, 1);
                }
                elsif (exists($rps{$arg[5]})) {
                    privmsg(sprintf(gettext("Username %s is already taken."),
				    $arg[5]), $usernick,1);
                }
                else {
                    $rps{$arg[5]} = delete($rps{$arg[4]});
                    privmsg(sprintf(gettext("Username for %s changed to %s."),
					    $arg[4],$arg[5]), $usernick, 1);
                }
            }
            elsif ($arg[3] eq "chclass") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "CHCLASS"), $usernick);
                }
                elsif (!defined($arg[5])) {
                    privmsg(gettext("Try: CHCLASS <char name> <new char class>"),
                            $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
			    $usernick, 1);
                }
                else {
                    $rps{$arg[4]}{class} = "@arg[5..$#arg]";
                    privmsg(sprintf(gettext("Class for %s changed to %s."),
				    $arg[4],(@arg[5..$#arg])), $usernick, 1);
                }
            }
            elsif ($arg[3] eq "push") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You don't have access to %s."),
			    "PUSH"), $usernick);
                }
                # insure it's a positive or negative, integral number of seconds
                elsif ($arg[5] !~ /^\-?\d+$/) {
                    privmsg(gettext("Try: PUSH <char name> <seconds>"),
			    $usernick, 1);
                }
                elsif (!exists($rps{$arg[4]})) {
                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
			    $usernick, 1);
                }
                elsif ($arg[5] > $rps{$arg[4]}{next}) {
                    privmsg(sprintf(gettext("Time to level for %s (%u s) is ".
					    "lower than %d; setting TTL to 0."),
				    $arg[4],$rps{$arg[4]}{next},$arg[5]),
                            $usernick, 1);
                    chanmsg(sprintf(gettext("%s has pushed %s %d seconds ".
					    "toward level %u"),
				    $usernick,$arg[4],$rps{$arg[4]}{next},
				    ($rps{$arg[4]}{level}+1)));
                    $rps{$arg[4]}{next}=0;
                }
                else {
                    $rps{$arg[4]}{next} -= $arg[5];
                     chanmsg(sprintf(gettext("%s has pushed %s %d seconds ".
					     "toward level %u. %2\$s reaches ".
					     "next level in %5\$s."),
				     $usernick,$arg[4],$arg[5],
				     ($rps{$arg[4]}{level}+1),
				     duration($rps{$arg[4]}{next})));
                }
            }   
            elsif ($arg[3] eq "logout") {
                if (defined($username)) {
                    penalize($username,"logout");
                }
                else {
                    privmsg(gettext("You are not logged in."), $usernick);
                }
            }
            elsif ($arg[3] eq "quest") {
                if (!@{$quest{questers}}) {
                    privmsg(gettext("There is no active quest."),$usernick);
                }
                elsif ($quest{type} == 1) {
                    privmsg(sprintf(gettext("%s, and %s are on a quest to %s".
					    ". Quest to complete in %s."),
				    join(", ",(@{$quest{questers}})[0..2]),
				    $quest{questers}->[3],$quest{text},
				    duration($quest{qtime}-time()))
                            ,$usernick);
                }
                elsif ($quest{type} == 2) {
                    privmsg(sprintf(gettext("%s, and %s are on a quest to ".
					    "%s. Participants must first reach ".
					    "[%u,%u], then [%u,%u]."),
				    join(", ",(@{$quest{questers}})[0..2]),
				    $quest{questers}->[3],$quest{text},
				    $quest{p1}->[0],$quest{p1}->[1],
				    $quest{p2}->[0],$quest{p2}->[1]).
                            ($opts{mapurl}?sprintf(gettext(" See %s to monitor ".
							   "their journey's ".
							   "progress."),
						   $opts{mapurl}):""),$usernick);
                }
            }
            elsif ($arg[3] eq "status" && $opts{statuscmd}) {
                if (!defined($username)) {
                    privmsg(gettext("You are not logged in."), $usernick);
                }
                # argument is optional
                elsif ($arg[4] && !exists($rps{$arg[4]})) {
                    privmsg(gettext("No such user."),$usernick);
                }
                elsif ($arg[4]) { # optional 'user' argument
                    privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
                            "$rps{$arg[4]}{class}; Status: O".
                            ($rps{$arg[4]}{online}?"n":"ff")."line; ".
                            "TTL: ".duration($rps{$arg[4]}{next})."; ".
                            "Idled: ".duration($rps{$arg[4]}{idled}).
                            "; Item sum: ".itemsum($arg[4]),$usernick);
                }
                else { # no argument, look up this user
                    privmsg("$username: Level $rps{$username}{level} ".
                            "$rps{$username}{class}; Status: O".
                            ($rps{$username}{online}?"n":"ff")."line; ".
                            "TTL: ".duration($rps{$username}{next})."; ".
                            "Idled: ".duration($rps{$username}{idled})."; ".
                            "Item sum: ".itemsum($username),$usernick);
                }
            }
            elsif ($arg[3] eq "whoami") {
                if (!defined($username)) {
                    privmsg(gettext("You are not logged in."), $usernick);
                }
                else {
                    privmsg(sprintf(gettext("You are %s, the level %u %s. ".
					    "Next level in %s"),
				    $username,$rps{$username}{level},
				    $rps{$username}{class},
				    duration($rps{$username}{next})), $usernick);
                }
            }
            elsif ($arg[3] eq "newpass") {
                if (!defined($username)) {
                    privmsg(gettext("You are not logged in."), $usernick)
                }
                elsif (!defined($arg[4])) {
                    privmsg(gettext("Try: NEWPASS <new password>"), $usernick);
                }
                else {
                    $rps{$username}{pass} = crypt($arg[4],mksalt());
                    privmsg(gettext("Your password was changed."),$usernick);
                }
            }
            elsif ($arg[3] eq "align") {
                if (!defined($username)) {
                    privmsg(gettext("You are not logged in."), $usernick)
                }
                elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" && 
                       lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
                    privmsg(gettext("Try: ALIGN <good|neutral|evil>"),
			    $usernick);
                }
                else {
                    $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
                    chanmsg(sprintf(gettext("%s has changed alignment to: "),
				    $username).gettext(lc($arg[4])).".");
                    privmsg(gettext("Your alignment was changed to ").
			    gettext(lc($arg[4])).".", $usernick);
                }
            }
            elsif ($arg[3] eq "removeme") {
                if (!defined($username)) {
                    privmsg(gettext("You are not logged in."), $usernick)
                }
                else {
                    privmsg(sprintf(gettext("Account %s removed."),$username),
			    $usernick);
                    chanmsg(sprintf(gettext("%s removed his account, %s, the %s".
					    "."),
				    $arg[0],$username,$rps{$username}{class}));
                    delete($rps{$username});
                }
            }
            elsif ($arg[3] eq "help") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("For information on IRPG bot ".
					    "commands, see %s"), $opts{helpurl}),
			    $usernick);
                }
                else {
                    privmsg(sprintf(gettext("Help URL is %s"),$opts{helpurl}),
			    $usernick, 1);
                    privmsg(sprintf(gettext("Admin commands URL is %s"),
				    $opts{admincommurl}), $usernick, 1);
                }
            }
            elsif ($arg[3] eq "die") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "DIE"), $usernick);
                }
                else {
                    $opts{reconnect} = 0;
                    writedb();
                    sts(sprintf(gettext("QUIT :DIE from %s"),$arg[0]),1);
                }
            }
            elsif ($arg[3] eq "reloaddb") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "RELOADDB"), $usernick);
                }
                elsif (!$pausemode) {
                    privmsg(gettext("ERROR: Can only use LOADDB while in ".
				    "PAUSE mode."), $usernick, 1);
                }
                else {
                    loaddb();
                    privmsg(sprintf(gettext("Reread player database file; %u ".
					    "accounts loaded."),
				    scalar(keys(%rps))), $usernick,1);
                }
            }
            elsif ($arg[3] eq "backup") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "BACKUP"), $usernick);
                }
                else {
                    backup();
                    privmsg(sprintf(gettext("%s copied to .dbbackup/%s"),
				    $opts{dbfile},$opts{dbfile}.time()),
			    $usernick,1);
                }
            }
            elsif ($arg[3] eq "pause") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "PAUSE"), $usernick);
                }
                else {
                    $pausemode = $pausemode ? 0 : 1;
                    privmsg(sprintf(gettext("PAUSE_MODE set to %s."),$pausemode),
			    $usernick,1);
                }
            }
            elsif ($arg[3] eq "silent") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "SILENT"), $usernick);
                }
                elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
                    privmsg(gettext("Try: SILENT <mode>"), $usernick,1);
                }
                else {
                    $silentmode = $arg[4];
                    privmsg(sprintf(gettext("SILENT_MODE set to %s."),
				    $silentmode), $usernick,1);
                }
            }
            elsif ($arg[3] eq "jump") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "JUMP"), $usernick);
                }
                elsif (!defined($arg[4])) {
                    privmsg(gettext("Try: JUMP <server[:port]>"), $usernick, 1);
                }
                else {
                    writedb();
                    sts(sprintf(gettext("QUIT :JUMP to %s from %s"),
				$arg[4],$arg[0]));
                    unshift(@{$opts{servers}},$arg[4]);
                    close($sock);
                    sleep(3);
                    goto CONNECT;
                }
            }
            elsif ($arg[3] eq "restart") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "RESTART"), $usernick);
                }
                else {
                    writedb();
                    sts(sprintf(gettext("QUIT :RESTART from %s"),$arg[0]),1);
                    close($sock);
                    exec("perl $0");
                }
            }
            elsif ($arg[3] eq "clearq") {
                if (!ha($username)) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "CLEARQ"), $usernick);
                }
                else {
                    undef(@queue);
                    chanmsg(sprintf(gettext("Outgoing message queue cleared by ".
					    "%s."),$arg[0]));
                    privmsg(gettext("Outgoing message queue cleared."),
			    $usernick,1);
                }
            }
            elsif ($arg[3] eq "info") {
                my $info;
                if (!ha($username) && $opts{allowuserinfo}) {
                    $info = sprintf(gettext("IRPG bot v%s by jotun, ".
					    "http://idlerpg.net/. On via ".
					    "server: %s. Admins online: %s."),
				    $version,$opts{servers}->[0],
				    join(", ", map { $rps{$_}{nick} }
					 grep { $rps{$_}{isadmin} &&
						$rps{$_}{online} } keys(%rps)));
                    privmsg($info, $usernick);
                }
                elsif (!ha($username) && !$opts{allowuserinfo}) {
                    privmsg(sprintf(gettext("You do not have access to %s."),
				    "INFO"), $usernick);
                }
                else {
                    my $queuedbytes = 0;
                    $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
                    $info = sprintf(gettext(
                        "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
                        "online of %d total users. %d accounts created since ".
                        "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
                        "Outgoing queue is %d bytes in %d items. On via: %s. ".
                        "Admins online: %s."),
                        $outbytes/1024,
                        $inbytes/1024,
                        duration(time()-$^T),
                        scalar(grep { $rps{$_}{online} } keys(%rps)),
                        scalar(keys(%rps)),
                        $registrations,
                        $pausemode,
                        $silentmode,
                        $queuedbytes,
                        scalar(@queue),
                        $opts{servers}->[0],
                        join(", ",map { $rps{$_}{nick} }
                                  grep { $rps{$_}{isadmin} && $rps{$_}{online} }
                                  keys(%rps)));
                    privmsg($info, $usernick, 1);
                }
            }
            elsif ($arg[3] eq "login") {
                if (defined($username)) {
                    notice(sprintf(gettext("Sorry, you are already online as ".
					   "%s."),$username), $usernick);
                }
                else {
                    if ($#arg < 5 || $arg[5] eq "") {
                        notice(gettext("Try: LOGIN <username> <password>"),
			       $usernick);
                    }
                    elsif (!exists $rps{$arg[4]}) {
                        notice(gettext("Sorry, no such account name. Note that ".
				       "account names are case sensitive."),
			       $usernick);
                    }
                    elsif (!exists $onchan{$usernick}) {
                        notice(sprintf(gettext("Sorry, you're not in %s."),
				       $opts{botchan}), $usernick);
                    }
                    elsif ($rps{$arg[4]}{pass} ne
                           crypt($arg[5],$rps{$arg[4]}{pass})) {
                        notice(gettext("Wrong password."), $usernick);
                    }
                    else {
                        if ($opts{voiceonlogin}) {
                            sts("MODE $opts{botchan} +v :$usernick");
                        }
                        $rps{$arg[4]}{online} = 1;
                        $rps{$arg[4]}{nick} = $usernick;
                        $rps{$arg[4]}{userhost} = $arg[0];
                        $rps{$arg[4]}{lastlogin} = time();
                        chanmsg(sprintf(gettext("%s, the level %u %s, is now ".
						"online from nickname %s. Next ".
						"level in %s."),
					$arg[4],$rps{$arg[4]}{level},
					$rps{$arg[4]}{class},$usernick,
					duration($rps{$arg[4]}{next})));
                        notice(gettext("Logon successful. Next level in ").
                               duration($rps{$arg[4]}{next}).".", $usernick);
                    }
                }
            }
        }
        # penalize returns true if user was online and successfully penalized.
        # if the user is not logged in, then penalize() fails. so, if user is
        # offline, and they say something including "http:", and they've been on
        # the channel less than 90 seconds, and the http:-style ban is on, then
        # check to see if their url is in @{$opts{okurl}}. if not, kickban them
        elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
               index(lc("@arg[3..$#arg]"),"http:") != -1 &&
               (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
            my $isokurl = 0;
            for (@{$opts{okurl}}) {
                if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
            }
            if (!$isokurl) {
                sts("MODE $opts{botchan} +b $arg[0]");
                sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
                    "be lifted within the hour.");
                push(@bans,$arg[0]) if @bans < 12;
            }
        }
    }
}

sub sts { # send to server
    my($text,$skipq) = @_;
    if ($skipq) {
        if ($sock) {
            print $sock "$text\r\n";
            $outbytes += length($text) + 2;
            debug("-> $text");
        }
        else {
            # something is wrong. the socket is closed. clear the queue
            undef(@queue);
            debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
            return;
        }
    }
    else {
        push(@queue,$text);
        debug(sprintf("(q%03d) = %s\n",$#queue,$text));
    }
}

sub fq { # deliver message(s) from queue
    if (!@queue) {
        ++$freemessages if $freemessages < 4;
        return undef;
    }
    my $sentbytes = 0;
    for (0..$freemessages) {
        last() if !@queue; # no messages left to send
        # lower number of "free" messages we have left
        my $line=shift(@queue);
        # if we have already sent one message, and the next message to be sent
        # plus the previous messages we have sent this call to fq() > 768 bytes,
        # then requeue this message and return. we don't want to flood off,
        # after all
        if ($_ != 0 && (length($line)+$sentbytes) > 768) {
            unshift(@queue,$line);
            last();
        }
        if ($sock) {
            debug("(fm$freemessages) -> $line");
            --$freemessages if $freemessages > 0;
            print $sock "$line\r\n";
            $sentbytes += length($line) + 2;
        }
        else {
            undef(@queue);
            debug("Disconnected: cleared outgoing message queue.");
            last();
        }
        $outbytes += length($line) + 2;
    }
}

sub ttl { # return ttl
    my $lvl = shift;
    return ($opts{rpbase} * ($opts{rpstep}**$lvl)) if $lvl <= 60;
    return (($opts{rpbase} * ($opts{rpstep}**60))
             + (86400*($lvl - 60)));
}

sub penttl { # return ttl with $opts{rppenstep}
    my $lvl = shift;
    return ($opts{rpbase} * ($opts{rppenstep}**$lvl)) if $lvl <= 60;
    return (($opts{rpbase} * ($opts{rppenstep}**60))
             + (86400*($lvl - 60)));
}

sub duration { # return human duration of seconds
    my $s = shift;
    return "NA ($s)" if $s !~ /^\d+$/;
    return sprintf(ngettext("%d day, %02d:%02d:%02d",
			    "%d days, %02d:%02d:%02d",int($s/86400)),
		   $s/86400,($s%86400)/3600,($s%3600)/60,($s%60));
}

sub ts { # timestamp
    my @ts = localtime(time());
    return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
                   $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
}

sub hog { # summon the hand of god
    my @players = grep { $rps{$_}{online} } keys(%rps);
    my $player = $players[rand(@players)];
    my $win = int(rand(5));
    my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
    if ($win) {
        chanmsg(clog(sprintf(gettext("Verily I say unto thee, the Heavens have ".
				     "burst forth, and the blessed hand of God ".
				     "carried %s %s toward level %u."),
			     $player,duration($time),($rps{$player}{level}+1))));
        $rps{$player}{next} -= $time;
    }
    else {
        chanmsg(clog(sprintf(gettext("Thereupon He stretched out His little ".
				     "finger among them and consumed %s with ".
				     "fire, slowing the heathen %s from level ".
				     "%u."),
			     $player,duration($time),($rps{$player}{level}+1))));
        $rps{$player}{next} += $time;
    }
    chanmsg(sprintf(gettext("%s reaches next level in %s."),
		    $player,duration($rps{$player}{next})));
}

sub rpcheck { # check levels, update database
    # check splits hash to see if any split users have expired
    checksplits() if $opts{detectsplits};
    # send out $freemessages lines of text from the outgoing message queue
    fq();
    # clear registration limiting
    $lastreg = 0;
    my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
    # there's really nothing to do here if there are no online users
    return unless $online;
    my $onlineevil = scalar(grep { $rps{$_}{online} &&
                                   $rps{$_}{alignment} eq "e" } keys(%rps));
    my $onlinegood = scalar(grep { $rps{$_}{online} &&
                                   $rps{$_}{alignment} eq "g" } keys(%rps));
    if (!$opts{noscale}) {
        if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
        if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
        if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
        if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
    }
    else {
        hog() if rand(4000) < 1;
        team_battle() if rand(4000) < 1;
        calamity() if rand(4000) < 1;
        godsend() if rand(2000) < 1;
    }
    if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
    if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
    if (rand((10*86400)/$opts{self_clock}) < 1) { war(); }

    moveplayers();
    process_items();
    
    # statements using $rpreport do not bother with scaling by the clock because
    # $rpreport is adjusted by the number of seconds since last rpcheck()
    if (($rpreport%120 < $oldrpreport%120) && $opts{writequestfile}) { writequestfile(); }
    if (time() > $quest{qtime}) {
        if (!@{$quest{questers}}) { quest(); }
        elsif ($quest{type} == 1) {
            chanmsg(clog(sprintf(gettext("%s, and %s have blessed the realm by ".
					 "completing their quest! 25%% of their ".
					 "burden is eliminated."),
				 join(", ",(@{$quest{questers}})[0..2]),
				 $quest{questers}->[3])));
            for (@{$quest{questers}}) {
                $rps{$_}{next} = int($rps{$_}{next} * .75);
            }
            undef(@{$quest{questers}});
            $quest{qtime} = time() + 21600;
            writequestfile();
        }
        # quest type 2 awards are handled in moveplayers()
    }
    if ($rpreport && ($rpreport%36000 < $oldrpreport%36000)) { # 10 hours
        my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
                       $rps{$a}{next}  <=> $rps{$b}{next} } keys(%rps);
        chanmsg(gettext("Idle RPG Top Players:")) if @u;
        for my $i (0..2) {
            $#u >= $i and
            chanmsg(sprintf(gettext("%s, the level %u %s, is #%u! Next level in".
				    " %s."),
			    $u[$i],$rps{$u[$i]}{level},
			    $rps{$u[$i]}{class},($i + 1),
			    (duration($rps{$u[$i]}{next}))));
        }
        backup();
    }
    if (($rpreport%3600 < $oldrpreport%3600) && $rpreport) { # 1 hour
        my @players = grep { $rps{$_}{online} &&
                             $rps{$_}{level} > 44 } keys(%rps);
        # 20% of all players must be level 45+
        if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
            challenge_opp($players[int(rand(@players))]);
        }
        while (@bans) {
            sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
            splice(@bans,0,4);
        }
    }
    if ($rpreport%1800 < $oldrpreport%1800) { # 30 mins
        if ($opts{botnick} ne $primnick) {
            sts($opts{botghostcmd}) if $opts{botghostcmd};
            sts("NICK $primnick");
        }
    }
    if (($rpreport%600 < $oldrpreport%600) && $pausemode) { # warn every 10m
        chanmsg(gettext("WARNING: Cannot write database in PAUSE mode!"));
    }
    # do not write in pause mode, and do not write if not yet connected. (would
    # log everyone out if the bot failed to connect. $lasttime = time() on
    # successful join to $opts{botchan}, initial value is 1). if fails to open
    # $opts{dbfile}, will not update $lasttime and so should have correct values
    # on next rpcheck(). 
    if ($lasttime != 1) {
        my $curtime=time();
        for my $k (keys(%rps)) {
            if ($rps{$k}{online} && exists $rps{$k}{nick} &&
                $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
                $rps{$k}{next} -= ($curtime - $lasttime);
                $rps{$k}{idled} += ($curtime - $lasttime);
                if ($rps{$k}{next} < 1) {
                    my $ttl = int(ttl($rps{$k}{level}));
                    $rps{$k}{level}++;
                    $rps{$k}{next} += $ttl;
                    chanmsg(sprintf(gettext("%s, the %s, has attained level ".
					    "%u! Next level in %s."),
				    $k,$rps{$k}{class},$rps{$k}{level},
				    duration($ttl)));
                    find_item($k);
                    challenge_opp($k);
                }
            }
            # attempt to make sure this is an actual user, and not just an
            # artifact of a bad PEVAL
        }
        if (!$pausemode && ($rpreport%60 < $oldrpreport%60)) { writedb(); }
        $oldrpreport = $rpreport;
        $rpreport += $curtime - $lasttime;
        $lasttime = $curtime;
    }
}

sub war { # let the four quadrants battle
    my @players = grep { $rps{$_}{online} } keys(%rps);
    my @quadrantname = ("Northeast", "Southeast", "Southwest", "Northwest");
    my %quadrant = ();
    my @sum = (0,0,0,0,0);
    # get quadrant for each player and item sum per quadrant
    for my $k (@players) {
        # "quadrant" 4 is for players in the middle
        $quadrant{$k} = 4;
        if (2 * $rps{$k}{y} + 1 < $opts{mapy}) {
            $quadrant{$k} = 3 if (2 * $rps{$k}{x} + 1 < $opts{mapx});
            $quadrant{$k} = 0 if (2 * $rps{$k}{x} + 1 > $opts{mapx});
        }
        elsif (2 * $rps{$k}{y} + 1 > $opts{mapy})
        {
            $quadrant{$k} = 2 if (2 * $rps{$k}{x} + 1 < $opts{mapx});
            $quadrant{$k} = 1 if (2 * $rps{$k}{x} + 1 > $opts{mapx});
        }
        $sum[$quadrant{$k}] += itemsum($k);
    }
    # roll for each quadrant
    my @roll = (0,0,0,0);
    $roll[$_] = int(rand($sum[$_])) foreach (0..3);
    # winner if value >= maximum value of both direct neighbors, "quadrant" 4 never wins
    my @iswinner = map($_ < 4 && $roll[$_] >= $roll[($_ + 1) % 4] &&
                                 $roll[$_] >= $roll[($_ + 3) % 4],(0..4));
    my @winners = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep($iswinner[$_],(0..3)));
    # construct text from winners array
    my $winnertext = "";
    $winnertext = pop(@winners) if (scalar(@winners) > 0);
    $winnertext = pop(@winners)." and $winnertext" if (scalar(@winners) > 0);
    $winnertext = pop(@winners).", $winnertext" while (scalar(@winners) > 0);
    $winnertext = "has shown the power of $winnertext" if ($winnertext ne "");
    # loser if value < minimum value of both direct neighbors, "quadrant" 4 never loses
    my @isloser = map($_ < 4 && $roll[$_] < $roll[($_ + 1) % 4] &&
                                $roll[$_] < $roll[($_ + 3) % 4],(0..4));
    my @losers = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep($isloser[$_],(0..3)));
    # construct text from losers array
    my $losertext = "";
    $losertext = pop(@losers) if (scalar(@losers) > 0);
    $losertext = pop(@losers)." and $losertext" if (scalar(@losers) > 0);
    $losertext = pop(@losers).", $losertext" while (scalar(@losers) > 0);
    $losertext = "led $losertext to perdition" if ($losertext ne "");
    # build array of text for neutrals
    my @neutrals = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep(!$iswinner[$_] && !$isloser[$_],(0..3)));
    # construct text from neutrals array
    my $neutraltext = "";
    $neutraltext = pop(@neutrals) if (scalar(@neutrals) > 0);
    $neutraltext = pop(@neutrals)." and $neutraltext" if (scalar(@neutrals) > 0);
    $neutraltext = pop(@neutrals).", $neutraltext" while (scalar(@neutrals) > 0);
    $neutraltext = " The diplomacy of $neutraltext was admirable." if ($neutraltext ne "");
    if ($winnertext ne "" && $losertext ne "") {
        # there are winners and losers
        chanmsg(clog("The war between the four parts of the realm ".
                     "$winnertext, whereas it $losertext.$neutraltext"));
    }
    elsif ($winnertext eq "" && $losertext eq "") {
        # there are only neutrals
        chanmsg(clog("The war between the four parts of the realm ".
                     "was well-balanced.$neutraltext"));
    }
    else {
        # there are either winners or losers
        chanmsg(clog("The war between the four parts of the realm ".
                     "$winnertext$losertext.$neutraltext"));
    }
    for my $k (@players) {
        # halve ttl of users in winning quadrant
        # users in "quadrant" 4 are not awarded or penalized
        $rps{$k}{next} = int($rps{$k}{next} / 2) if ($iswinner[$quadrant{$k}]);
        # double ttl of users in losing quadrant
        $rps{$k}{next} *= 2 if ($isloser[$quadrant{$k}]);
    }
}

sub challenge_opp { # pit argument player against random player
    my $u = shift;
    if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
    my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
    return unless @opps;
    my $opp = $opps[int(rand(@opps))];
    $opp = $primnick if rand(@opps+1) < 1;
    my $mysum = itemsum($u,1);
    my $oppsum = itemsum($opp,1);
    my $myroll = int(rand($mysum));
    my $opproll = int(rand($oppsum));
    if ($myroll >= $opproll) {
        my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
        $gain = 7 if $gain < 7;
        $gain = int(($gain/100)*$rps{$u}{next});
        chanmsg(clog(sprintf(gettext("%s [%u/%u] has challenged %s [%u/%u] in ".
				     "combat and won! %s is removed from ".
				     "%1\$s\'s clock."),
			     $u,$myroll,$mysum,$opp,$opproll,$oppsum,
			     duration($gain))));
        $rps{$u}{next} -= $gain;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$u,duration($rps{$u}{next})));
        my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
                       $rps{$u}{alignment} eq "e" ? 20 :
                       35;
        if (rand($csfactor) < 1 && $opp ne $primnick) {
            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
            chanmsg(clog(sprintf(gettext("%s has dealt %s a Critical Strike! %s".
					 " is added to %2\$s\'s clock."),
				 $u,$opp,duration($gain))));
            $rps{$opp}{next} += $gain;
            chanmsg(sprintf(gettext("%s reaches next level in %s."),
			    $opp,duration($rps{$opp}{next})));
        }
        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
            my @items = ("ring","amulet","charm","weapon","helm","tunic",
                         "pair of gloves","set of leggings","shield",
                         "pair of boots");
            my $type = $items[rand(@items)];
            if (itemlevel($rps{$opp}{item}{$type}) > itemlevel($rps{$u}{item}{$type})) {
                chanmsg(clog(sprintf(gettext("In the fierce battle, %s dropped ".
					     "his level %u %s! %s picks it up, ".
					     "tossing his old level %u %3\$s to".
					     " %1\$s."),
				     $opp,itemlevel($rps{$opp}{item}{$type}),
				     gettext($type),$u,
				     itemlevel($rps{$u}{item}{$type}))));
                my $tempitem = $rps{$u}{item}{$type};
                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
                $rps{$opp}{item}{$type} = $tempitem;
            }
        }
    }
    else {
        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
        $gain = 7 if $gain < 7;
        $gain = int(($gain/100)*$rps{$u}{next});
        chanmsg(clog(sprintf(gettext("%s [%u/%u] has challenged %s [%u/%u] in ".
				     "combat and lost! %s is added to %1\$s\'s ".
				     "clock."),$u,$myroll,$mysum,$opp,$opproll,
			     $oppsum,duration($gain))));
        $rps{$u}{next} += $gain;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$u,duration($rps{$u}{next})));
    }
}

sub team_battle { # pit three players against three other players
    my @opp = grep { $rps{$_}{online} } keys(%rps);
    return if @opp < 6;
    # choose random point       
    my $x = int(rand($opts{mapx}));
    my $y = int(rand($opts{mapy}));
    my %polar = ();
    for my $player (@opp) {   
        my $dx = $rps{$player}{x}-$x;
        my $dy = $rps{$player}{y}-$y;
        # polar coordinates
        $polar{$player}{r} = sqrt($dx*$dx+$dy*$dy);
        $polar{$player}{phi} = atan2($dy,$dx)      
    }
    # sort by radius 
    my @sorted = sort { $polar{$a}{r} <=> $polar{$b}{r} } keys %polar;
    # get players at least as close as #6
    @sorted = grep { $polar{$_}{r} <= $polar{$sorted[5]}{r} } @sorted;
    # pick 6 random players from these  
    @opp = ();
    for (my $i = 0; $i < 6; $i++) {
        $opp[$i] = splice(@sorted,int(rand(@sorted)),1);  
    }
    # sort by angle
    @opp = sort { $polar{$a}{phi} <=> $polar{$b}{phi} } @opp;
    # shift splitting position
    my $rot = int(rand(6));
    @opp = @opp[$rot..5,0..$rot-1];  
    my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
    my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
    my $gain = $rps{$opp[0]}{next};
    for my $p (1,2) {
        $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
    }
    $gain = int($gain*.20);
    my $myroll = int(rand($mysum));
    my $opproll = int(rand($oppsum));
    if ($myroll >= $opproll) {
        chanmsg(clog(sprintf(gettext("%s, %s and %s [%u/%u] have team battled ".
				     "%s, %s and %s [%u/%u] at [%u,%u] and won!".
				     " %s is removed from their clocks."),
			     $opp[0],$opp[1],$opp[2],$myroll,$mysum,
			     $opp[3],$opp[4],$opp[5],$opproll,$oppsum,
			     $x,$y,duration($gain))));
        $rps{$opp[0]}{next} -= $gain;
        $rps{$opp[1]}{next} -= $gain;
        $rps{$opp[2]}{next} -= $gain;
    }
    else {
        chanmsg(clog(sprintf(gettext("%s, %s and %s [%u/%u] have team battled ".
				     "%s, %s and %s [%u/%u] at [%u,%u] and ".
				     "lost! %s is added to their clocks."),
			     $opp[0],$opp[1],$opp[2],$myroll,$mysum,
			     $opp[3],$opp[4],$opp[5],$opproll,$oppsum,
			     $x,$y,duration($gain))));
        $rps{$opp[0]}{next} += $gain;
        $rps{$opp[1]}{next} += $gain;
        $rps{$opp[2]}{next} += $gain;
    }
}

sub itemlevel {
    my $level = shift;
    $level =~ s/\D$//;
    return $level;
}

sub itemtag {
    my $level = shift;
    $level =~ s/^\d+//;
    return $level;
}

sub process_items { # decrease items lying around
    my $curtime = time();

    for my $xy (keys(%mapitems)) {
        for my $i (0..$#{$mapitems{$xy}}) {
            my $level = $mapitems{$xy}[$i]{level};
            my $ttl = int($opts{rpitembase} * ttl(itemlevel($level)) / 600);
            if ($mapitems{$xy}[$i]{lasttime} + $ttl <= $curtime ) {
               $mapitems{$xy}[$i]{lasttime} += $ttl;
               $mapitems{$xy}[$i]{level} = downgrade_item($level);
               splice(@{$mapitems{$xy}},$i,1) if ($mapitems{$xy}[$i]{level} == 0);
            }
        }
    }
}

sub drop_item { # drop item on the map
    my $u = shift;
    my $type = shift;
    my $level = shift;
    my $ulevel = itemlevel($level);
    my $x = $rps{$u}{x};
    my $y = $rps{$u}{y};

    push(@{$mapitems{"$x:$y"}},{type=>$type,level=>$level,lasttime=>time()}) if ($ulevel > 0);
}

sub downgrade_item { # returns the decreased item level
    my $level = shift;
    my $ulevel = itemlevel($level);
    my $tag = itemtag($level);
    my %minlevel = (''=>0,a=>50,h=>50,b=>75,d=>150,e=>175,f=>250,g=>300);
    $tag = '' if ($ulevel == $minlevel{$tag});
    $ulevel-- if ($ulevel > 0);
    return "$ulevel$tag";
}

sub exchange_item { # take item and drop the current
    my $u = shift;
    my $type = shift;
    my $level = shift;
    my $ulevel = itemlevel($level);
    my $tag = itemtag($level);

    if ($tag eq 'a') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Mattt's ".
			       "Omniscience Grand Crown! Your enemies fall ".
			       "before you as you anticipate their every move."),
		       $ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'b') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Res0's ".
			       "Protectorate Plate Mail! Your enemies cower in".
			       " fear as their attacks have no effect on you."),
		       $ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'c') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Dwyn's Storm Magic ".
			       "Amulet! Your enemies are swept away by an".
			       "elemental fury before the war has even begun"),
		       $ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'd') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Jotun's Fury ".
			       "Colossal Sword! Your enemies' hatred is brought".
			       "to a quick end as you arc your wrist, dealing ".
			       "the crushing blow."),$ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'e') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Drdink's Cane of ".
			       "Blind Rage! Your enemies are tossed aside as ".
			       "you blindly swing your arm around hitting ".
			       "stuff."),$ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'f') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Mrquick's Magical ".
			       "Boots of Swiftness! Your enemies are left ".
			       "choking on your dust as you run from them ".
			       "very, very quickly."),$ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'g') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Jeff's Cluehammer ".
			       "of Doom! Your enemies are left with a sudden ".
			       "and intense clarity of mind... even as you ".
			       "relieve them of it."),$ulevel),$rps{$u}{nick});
    }
    elsif ($tag eq 'h') {
        notice(sprintf(gettext("The light of the gods shines down upon you! ".
			       "You have found the level %u Juliet's Glorious ".
			       "Ring of Sparkliness! You enemies are blinded ".
			       "by both its glory and their greed as you bring ".
			       "desolation upon them."),$ulevel),
               $rps{$u}{nick});
    }
    else {
        notice(sprintf(gettext("You found a level %u %s! Your current %2\$s is ".
			       "only level %u, so it seems Luck is with you!"),
		       $ulevel,gettext($type),itemlevel($rps{$u}{item}{$type})),
	       $rps{$u}{nick});
    }

    drop_item($u,$type,$rps{$u}{item}{$type});
    $rps{$u}{item}{$type} = $level;
}

sub find_item { # find item for argument player
    my $u = shift;
    my @items = ("ring","amulet","charm","weapon","helm","tunic",
                 "pair of gloves","set of leggings","shield","pair of boots");
    my $type = $items[rand(@items)];
    my $level = 1;
    my $ulevel;
    for my $num (1 .. int($rps{$u}{level}*1.5)) {
        if (rand(1.4**($num/4)) < 1) {
            $level = $num;
        }
    }
    if ($rps{$u}{level} >= 25 && rand(40) < 1) {
        $ulevel = 50+int(rand(25));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{helm})) {
            exchange_item($u,"helm",$ulevel."a");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
        $ulevel = 50+int(rand(25));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{ring})) {
            exchange_item($u,"ring",$ulevel."h");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
        $ulevel = 75+int(rand(25));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{tunic})) {
            exchange_item($u,"tunic",$ulevel."b");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
        $ulevel = 100+int(rand(25));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{amulet})) {
            exchange_item($u,"amulet",$ulevel."c");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
        $ulevel = 150+int(rand(25));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
            exchange_item($u,"weapon",$ulevel."d");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
        $ulevel = 175+int(rand(26));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
            exchange_item($u,"weapon",$ulevel."e");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
        $ulevel = 250+int(rand(51));
        if ($ulevel >= $level && $ulevel >
            itemlevel($rps{$u}{item}{"pair of boots"})) {
            exchange_item($u,"pair of boots",$ulevel."f");
            return;
        }
    }
    elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
        $ulevel = 300+int(rand(51));
        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
            exchange_item($u,"weapon",$ulevel."g");
            return;
        }
    }
    if ($level > itemlevel($rps{$u}{item}{$type})) {
        exchange_item($u,$type,$level);
    }
    else {
        notice(sprintf(gettext("You found a level %u %s. Your current %2\$s is ".
			       "level %3\$u, so it seems Luck is against you. ".
			       "You toss the %2\$s."),
		       $level,gettext($type),itemlevel($rps{$u}{item}{$type})),
	       $rps{$u}{nick});
        drop_item($u,$type,$level);
    }
}

sub loaddb { # load the players and items database
    backup();
    my $l;
    %rps = ();
    if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
        sts("QUIT :loaddb() failed: $!");
    }
    while ($l=<RPS>) {
        chomp($l);
        next if $l =~ /^#/; # skip comments
        my @i = split("\t",$l);
        print Dumper(@i) if @i != 32;
        if (@i != 32) {
            sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
                "wrong fields (".scalar(@i).")");
            debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
                "fields (".scalar(@i).")",1);
        }
        if (!$sock) { # if not RELOADDB
            if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
        }
        ($rps{$i[0]}{pass},
        $rps{$i[0]}{isadmin},
        $rps{$i[0]}{level},
        $rps{$i[0]}{class},
        $rps{$i[0]}{next},
        $rps{$i[0]}{nick},
        $rps{$i[0]}{userhost},
        $rps{$i[0]}{online},
        $rps{$i[0]}{idled},
        $rps{$i[0]}{x},
        $rps{$i[0]}{y},
        $rps{$i[0]}{pen_mesg},
        $rps{$i[0]}{pen_nick},
        $rps{$i[0]}{pen_part},
        $rps{$i[0]}{pen_kick},
        $rps{$i[0]}{pen_quit},
        $rps{$i[0]}{pen_quest},
        $rps{$i[0]}{pen_logout},
        $rps{$i[0]}{created},
        $rps{$i[0]}{lastlogin},
        $rps{$i[0]}{item}{amulet},
        $rps{$i[0]}{item}{charm},
        $rps{$i[0]}{item}{helm},
        $rps{$i[0]}{item}{"pair of boots"},
        $rps{$i[0]}{item}{"pair of gloves"},
        $rps{$i[0]}{item}{ring},
        $rps{$i[0]}{item}{"set of leggings"},
        $rps{$i[0]}{item}{shield},
        $rps{$i[0]}{item}{tunic},
        $rps{$i[0]}{item}{weapon},
        $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
    }
    close(RPS);
    debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
          scalar(keys(%prev_online))." previously online.");
    if (!open(ITEMS,$opts{itemdbfile}) && -e $opts{itemdbfile}) {
        sts("QUIT :loaddb() failed: $!");
    }
    my $cnt = 0;
    %mapitems = ();
    while ($l=<ITEMS>) {
        chomp($l);
        next if $l =~ /^#/; # skip comments
        my @i = split("\t",$l);
        print Dumper(@i) if @i != 5;
        if (@i != 5) {
            sts("QUIT: Anomaly in loaddb(); line $. of $opts{itemdbfile} has ".
                "wrong fields (".scalar(@i).")");
            debug("Anomaly in loaddb(); line $. of $opts{itemdbfile} has wrong ".
                "fields (".scalar(@i).")",1);
        }
        my $curtime = time();
        push(@{$mapitems{"$i[0]:$i[1]"}},{type=>$i[2],level=>$i[3],lasttime=>$curtime-$i[4]});
        $cnt++;
    }
    close(ITEMS);
    debug("loaddb(): loaded $cnt items.");
}

sub moveplayers {
    return unless $lasttime > 1;
    my $onlinecount = grep { $rps{$_}{online} } keys %rps;
    return unless $onlinecount;
    for (my $i=0;$i<$opts{self_clock};++$i) {
        # temporary hash to hold player positions, detect collisions
        my %positions = ();
        if ($quest{type} == 2 && @{$quest{questers}}) {
            my $allgo = 1; # have all users reached <p1|p2>?
            for (@{$quest{questers}}) {
                if ($quest{stage}==1) {
                    if ($rps{$_}{x} != $quest{p1}->[0] ||
                        $rps{$_}{y} != $quest{p1}->[1]) {
                        $allgo=0;
                        last();
                    }
                }
                else {
                    if ($rps{$_}{x} != $quest{p2}->[0] ||
                        $rps{$_}{y} != $quest{p2}->[1]) {
                        $allgo=0;
                        last();
                    }
                }
            }
            # all participants have reached point 1, now point 2
            if ($quest{stage}==1 && $allgo) {
                $quest{stage}=2;
                $allgo=0; # have not all reached p2 yet
            }
            elsif ($quest{stage} == 2 && $allgo) {
                chanmsg(clog(sprintf(gettext("%s, and %s have completed their ".
					     "journey! 25%% of their burden is ".
					     "eliminated."),
				     join(", ",(@{$quest{questers}})[0..2]),
				     $quest{questers}->[3])));
                for (@{$quest{questers}}) {
                    $rps{$_}{next} = int($rps{$_}{next} * .75);
                }
                undef(@{$quest{questers}});
                $quest{qtime} = time() + 21600; # next quest starts in 6 hours
                $quest{type} = 1; # probably not needed
                writequestfile();
            }
            else {
                my(%temp,$player);
                # load keys of %temp with online users
                ++@temp{grep { $rps{$_}{online} } keys(%rps)};
                # delete questers from list
                delete(@temp{@{$quest{questers}}});
                while ($player = each(%temp)) {
                    $rps{$player}{x} += int(rand(3))-1;
                    $rps{$player}{y} += int(rand(3))-1;
                    # if player goes over edge, wrap them back around
                    if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
                    if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
                    if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
                    if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
                    
                    if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
                        !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
                        if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
                            !$rps{$player}{isadmin} && rand(100) < 1) {
                            chanmsg(sprintf(gettext("%s encounters %s and bows".
						    " humbly."),
					    $player,
					    $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}));
                        }
                        if (rand($onlinecount) < 1) {
                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
                            collision_fight($player,
                                $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
                        }
                    }
                    else {
                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
                    }
                }
                for (@{$quest{questers}}) {
                    if ($quest{stage} == 1) {
                        if (rand(100) < 1) {
                            if ($rps{$_}{x} != $quest{p1}->[0]) {
                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
                                                1 : -1);
                            }
                            if ($rps{$_}{y} != $quest{p1}->[1]) {
                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
                                                1 : -1);
                            }
                        }
                    }
                    elsif ($quest{stage}==2) {
                        if (rand(100) < 1) {
                            if ($rps{$_}{x} != $quest{p2}->[0]) {
                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
                                                1 : -1);
                            }
                            if ($rps{$_}{y} != $quest{p2}->[1]) {
                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
                                                1 : -1);
                            }
                        }
                    }
                }
            }
        }
        else {
            for my $player (keys(%rps)) {
                next unless $rps{$player}{online};
                $rps{$player}{x} += int(rand(3))-1;
                $rps{$player}{y} += int(rand(3))-1;
                # if player goes over edge, wrap them back around
                if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
                if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
                if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
                if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
                if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
                    !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
                    if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
                        !$rps{$player}{isadmin} && rand(100) < 1) {
                        chanmsg(sprintf(gettext("%s encounters %s and bows ".
						"humbly."),$player,
					$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}));
                    }
                    if (rand($onlinecount) < 1) {
                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
                        collision_fight($player,
                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
                    }
                }
                else {
                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
                }
            }
        }
        # pick up items lying around
        for my $u (keys(%rps)) {
            next unless $rps{$u}{online};
            my $x = $rps{$u}{x};
            my $y = $rps{$u}{y};
            for $i (0..$#{$mapitems{"$x:$y"}}) {
                my $item = $mapitems{"$x:$y"}[$i];
                if (itemlevel($item->{level}) > itemlevel($rps{$u}{item}{$item->{type}})) {
                    exchange_item($u,$item->{type},$item->{level});
                    splice(@{$mapitems{"$x:$y"}},$i,1);
                }
            }
        }
    }
}

sub mksalt { # generate a random salt for passwds
    join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
}

sub chanmsg { # send a message to the channel
    my $msg = shift or return undef;
    if ($silentmode & 1) { return undef; }
    privmsg($msg, $opts{botchan}, shift);
}

sub privmsg { # send a message to an arbitrary entity
    my $msg = shift or return undef;
    my $target = shift or return undef;
    my $force = shift;
    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
        && !$force) {
        return undef;
    }
    while (length($msg)) {
        sts("PRIVMSG $target :".substr($msg,0,450),$force);
        substr($msg,0,450)="";
    }
}

sub notice { # send a notice to an arbitrary entity
    my $msg = shift or return undef;
    my $target = shift or return undef;
    my $force = shift;
    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
        && !$force) {
        return undef;
    }
    while (length($msg)) {
        sts("NOTICE $target :".substr($msg,0,450),$force);
        substr($msg,0,450)="";
    }
}

sub help { # print help message
    (my $prog = $0) =~ s/^.*\///;

    print "
usage: $prog [OPTIONS]
  --help, -h           Print this message
  --verbose, -v        Print verbose messages
  --server, -s         Specify IRC server:port to connect to
  --botnick, -n        Bot's IRC nick
  --botuser, -u        Bot's username
  --botrlnm, -r        Bot's real name
  --botchan, -c        IRC channel to join
  --botident, -p       Specify identify-to-services command
  --botmodes, -m       Specify usermodes for the bot to set upon connect
  --botopcmd, -o       Specify command to send to server on successful connect
  --botghostcmd, -g    Specify command to send to server to regain primary
                       nickname when in use
  --doban              Advertisement ban on/off flag
  --okurl, -k          Bot will not ban for web addresses that contain these
                       strings
  --debug              Debug on/off flag
  --helpurl            URL to refer new users to
  --admincommurl       URL to refer admins to

  Timing parameters:
  --rpbase             Base time to level up
  --rpstep             Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
  --rppenstep          PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))

";
}

sub itemsum {
    my $user = shift;
    # is this for a battle? if so, good users get a 10% boost and evil users get
    # a 10% detriment
    my $battle = shift;
    return -1 unless defined $user;
    my $sum = 0;
    if ($user eq $primnick) {
        for my $u (keys(%rps)) {
            $sum = itemsum($u) if $sum < itemsum($u);
        }
        return $sum+1;
    }
    if (!exists($rps{$user})) { return -1; }
    $sum += itemlevel($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
    if ($battle) {
        return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
               $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
               $sum;
    }
    return $sum;
}

sub daemonize() {
    # win32 doesn't daemonize (this way?)
    if ($^O eq "MSWin32") {
        print debug("Nevermind, this is Win32, no I'm not.")."\n";
        return;
    }
    use POSIX 'setsid';
    $SIG{CHLD} = sub { };
    fork() && exit(0); # kill parent
    POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
    $SIG{CHLD} = sub { };
    fork() && exit(0); # kill the parent as the process group leader
    $SIG{CHLD} = sub { };
    open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
    open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
    open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
    # write our PID to $opts{pidfile}, or return semi-silently on failure
    open(PIDFILE,">$opts{pidfile}") || do {
        debug("Error: failed opening pid file: $!");
        return;
    };
    print PIDFILE $$;
    close(PIDFILE);
}

sub calamity { # suffer a little one
    my @players = grep { $rps{$_}{online} } keys(%rps);
    return unless @players;
    my $player = $players[rand(@players)];
    if (rand(10) < 1) {
        my @items = ("amulet","charm","weapon","tunic","set of leggings",
                     "shield");
        my $type = $items[rand(@items)];
        if ($type eq "amulet") {
            chanmsg(clog(sprintf(gettext("%s fell, chipping the stone in his ".
					 "amulet! %1\$s\'s %s loses 10%% of its".
					 " effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "charm") {
            chanmsg(clog(sprintf(gettext("%s slipped and dropped his charm in a".
					 " dirty bog! %1\$s\'s %s loses 10%% of".
					 " its effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "weapon") {
            chanmsg(clog(sprintf(gettext("%s left his weapon out in the rain to".
					 " rust! %1\$s\'s %s loses 10%% of its ".
					 "effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "tunic") {
            chanmsg(clog(sprintf(gettext("%s spilled a level 7 shrinking potion".
					 " on his tunic! %1\$s\'s %s loses 10%%".
					 " of its effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "shield") {
            chanmsg(clog(sprintf(gettext("%s\'s shield was damaged by a ".
					 "dragon's fiery breath! %1\$s\'s %s ".
					 "loses 10%% of its effectiveness."),
				 $player,gettext($type))));
        }
        else {
            chanmsg(clog(sprintf(gettext("%s burned a hole through his leggings".
					 " while ironing them! %1\$s\'s %s ".
					 "loses 10%% of its effectiveness."),
				$player,gettext($type))));
        }
        my $suffix="";
        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
        $rps{$player}{item}{$type} = int(itemlevel($rps{$player}{item}{$type}) * .9);
        $rps{$player}{item}{$type}.=$suffix;
    }
    else {
        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
        if (!open(Q,$opts{eventsfile})) {
            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
        }
        my($i,$actioned);
        while (my $line = <Q>) {
            chomp($line);
            if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
        }
        chanmsg(clog(sprintf(gettext("%s %s. This terrible calamity has slowed ".
				     "them %s from level %u."),
			     $player,$actioned,duration($time),
			     ($rps{$player}{level}+1))));
        $rps{$player}{next} += $time;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$player,duration($rps{$player}{next})));
    }
}

sub godsend { # bless the unworthy
    my @players = grep { $rps{$_}{online} } keys(%rps);
    return unless @players;
    my $player = $players[rand(@players)];
    if (rand(10) < 1) {
        my @items = ("amulet","charm","weapon","tunic","set of leggings",
                     "shield");
        my $type = $items[rand(@items)];
        if ($type eq "amulet") {
            chanmsg(clog(sprintf(gettext("%s\'s %s was blessed by a passing".
					 " cleric! %1\$s\'s %2\$s gains 10%% ".
					 "effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "charm") {
            chanmsg(clog(sprintf(gettext("%s\'s %s ate a bolt of lightning! ".
					 "%1\$s\'s %2\$s gains 10%% ".
					 "effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "weapon") {
            chanmsg(clog(sprintf(gettext("%s sharpened the edge of his %s! ".
					 "%1\$s\'s %2\$s gains 10%% ".
					 "effectiveness."),
				$player,gettext($type))));
        }
        elsif ($type eq "tunic") {
            chanmsg(clog(sprintf(gettext("A magician cast a spell of Rigidity ".
					 "on %s\'s %s! %1\$s\'s %2\$s gains ".
					 "10%% effectiveness."),
				 $player,gettext($type))));
        }
        elsif ($type eq "shield") {
            chanmsg(clog(sprintf(gettext("%s reinforced his %s with a ".
					 "dragon's scales! %1\$s\'s %2\$s gains".
					 " 10%% effectiveness."),
				$player,gettext($type))));
        }
        else {
            chanmsg(clog(sprintf(gettext("The local wizard imbued %s\'s pants ".
					 "with a Spirit of Fortitude! %1\$s\'s ".
					 "%2\$s gains 10%% effectiveness."),
				$player,gettext($type))));
        }
        my $suffix="";
        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
        $rps{$player}{item}{$type} = int(itemlevel($rps{$player}{item}{$type}) * 1.1);
        $rps{$player}{item}{$type}.=$suffix;
    }
    else {
        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
        my $actioned;
        if (!open(Q,$opts{eventsfile})) {
            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
        }
        my $i;
        while (my $line = <Q>) {
            chomp($line);
            if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
                $actioned = $1;
            }
        }
        chanmsg(clog(sprintf(gettext("%s %s! This wondrous godsend has ".
				     "accelerated them %s towards level %u."),
			     $player,$actioned,duration($time),
			     ($rps{$player}{level}+1))));
        $rps{$player}{next} -= $time;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$player,duration($rps{$player}{next})));
    }
}

sub quest {
    @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
                                 time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
    if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
    while (@{$quest{questers}} > 4) {
        splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
    }
    if (!open(Q,$opts{eventsfile})) {
        return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
    }
    my $i;
    while (my $line = <Q>) {
        chomp($line);
        if ($line =~ /^Q/ && rand(++$i) < 1) {
            if ($line =~ /^Q1 (.*)/) {
                $quest{text} = $1;
                $quest{type} = 1;
                $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
            }
            elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
                $quest{p1} = [$1,$2];
                $quest{p2} = [$3,$4];
                $quest{text} = $5;
                $quest{type} = 2;
                $quest{stage} = 1;
            }
        }
    }
    close(Q);
    if ($quest{type} == 1) {
        chanmsg(sprintf(gettext("%s, and %s have been chosen by the gods to ".
				"%s. Quest to end in %s."),
			join(", ",(@{$quest{questers}})[0..2]),
			$quest{questers}->[3],$quest{text},
			duration($quest{qtime}-time())));    
    }
    elsif ($quest{type} == 2) {
        chanmsg(sprintf(gettext("%s, and %s have been chosen by the gods to ".
				"%s. Participants must first reach [%u,%u], ".
				"then [%u,%u]."),
			join(", ",(@{$quest{questers}})[0..2]),
			$quest{questers}->[3],$quest{text},
			$quest{p1}->[0],$quest{p1}->[1],
			$quest{p2}->[0],$quest{p2}->[1]).
                ($opts{mapurl}?sprintf(gettext(" See %s to monitor their ".
					       "journey's progress."),
				       $opts{mapurl}):""));
    }
    writequestfile();
}

sub questpencheck {
    my $k = shift;
    my ($quester,$player);
    for $quester (@{$quest{questers}}) {
        if ($quester eq $k) {
            chanmsg(clog(sprintf(gettext(
			 "%s\'s prudence and self-regard has brought the ".
                         "wrath of the gods upon the realm. All your great ".
                         "wickedness makes you as it were heavy with lead, ".
                         "and to tend downwards with great weight and ".
                         "pressure towards hell. Therefore have you drawn ".
                         "yourselves 15 steps closer to that gaping maw.")
				 ,$k)));
            for $player (grep { $rps{$_}{online} } keys %rps) {
                my $gain = int(15 * penttl($rps{$player}{level}) / $opts{rpbase});
                $rps{$player}{pen_quest} += $gain;
                $rps{$player}{next} += $gain;
            }
            undef(@{$quest{questers}});
            $quest{qtime} = time() + 43200; # 12 hours
            writequestfile();
            last;
        }
    }
}

sub clog {
    my $mesg = shift;
    open(B,">>$opts{modsfile}") or do {
        debug("Error: Cannot open $opts{modsfile}: $!");
        chanmsg("Error: Cannot open $opts{modsfile}: $!");
        return $mesg;
    };
    print B ts()."$mesg\n";
    close(B);
    return $mesg;
}

sub backup() {
    if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
    if ($^O ne "MSWin32") {
        system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
        system("cp $opts{itemdbfile} .dbbackup/$opts{itemdbfile}".time());
    }
    else {
        system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
        system("copy $opts{itemdbfile} .dbbackup\\$opts{itemdbfile}".time());
    }
}

sub penalize {
    my $username = shift;
    return 0 if !defined($username);
    return 0 if !exists($rps{$username});
    my $type = shift;
    my $pen = 0;
    questpencheck($username);
    if ($type eq "quit") {
        $pen = int(20 * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_quit}+=$pen;
        $rps{$username}{online}=0;
    }
    elsif ($type eq "nick") {
        my $newnick = shift;
        $pen = int(30 * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_nick}+=$pen;
        $rps{$username}{nick} = substr($newnick,1);
        $rps{$username}{userhost} =~ s/^[^!]+/$rps{$username}{nick}/e;
        notice(sprintf(gettext("Penalty of %s added to your timer for ".
               "nick change."),duration($pen)),$rps{$username}{nick});
    }
    elsif ($type eq "privmsg" || $type eq "notice") {
        $pen = int(shift(@_) * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_mesg}+=$pen;
        notice(sprintf(gettext("Penalty of %s added to your timer for %s."),
		       duration($pen),$type),$rps{$username}{nick});
    }
    elsif ($type eq "part") {
        $pen = int(200 * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_part}+=$pen;
        notice(sprintf(gettext("Penalty of %s added to your timer for parting."),
		       duration($pen)),$rps{$username}{nick});
        $rps{$username}{online}=0;
    }
    elsif ($type eq "kick") {
        $pen = int(250 * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_kick}+=$pen;
        notice(sprintf(gettext("Penalty of %s added to your timer for ".
               "being kicked."),duration($pen)),$rps{$username}{nick});
        $rps{$username}{online}=0;
    }
    elsif ($type eq "logout") {
        $pen = int(20 * penttl($rps{$username}{level}) / $opts{rpbase});
        if ($opts{limitpen} && $pen > $opts{limitpen}) {
            $pen = $opts{limitpen};
        }
        $rps{$username}{pen_logout} += $pen;
        notice(sprintf(gettext("Penalty of %s added to your timer for ".
               "LOGOUT command."),duration($pen)),$rps{$username}{nick});
        $rps{$username}{online}=0;
    }
    $rps{$username}{next} += $pen;
    return 1; # successfully penalized a user! woohoo!
}

sub debug {
    (my $text = shift) =~ s/[\r\n]//g;
    my $die = shift;
    if ($opts{debug} || $opts{verbose}) {
        open(DBG,">>$opts{debugfile}") or do {
            chanmsg("Error: Cannot open debug file: $!");
            return;
        };
        print DBG ts()."$text\n";
        close(DBG);
    }
    if ($die) { die("$text\n"); }
    return $text;
}

sub finduser {
    my $nick = shift;
    return undef if !defined($nick);
    for my $user (keys(%rps)) {
        next unless $rps{$user}{online};
        if ($rps{$user}{nick} eq $nick) { return $user; }
    }
    return undef;
}

sub ha { # return 0/1 if username has access
    my $user = shift;
    if (!defined($user)) {
        debug("Error: Attempted ha() for undefined username");
        return 0;
    }
    if (!exists($rps{$user})) {
        debug("Error: Attempted ha() for invalid username \"$user\"");
        return 0;
    }
    return $rps{$user}{isadmin};
}

sub checksplits { # removed expired split hosts from the hash
    my $host;
    while ($host = each(%split)) {
        if (time()-$split{$host}{time} > $opts{splitwait}) {
            $rps{$split{$host}{account}}{online} = 0;
            delete($split{$host});
        }
    }
}

sub collision_fight {
    my($u,$opp) = @_;
    my $mysum = itemsum($u,1);
    my $oppsum = itemsum($opp,1);
    my $myroll = int(rand($mysum));
    my $opproll = int(rand($oppsum));
    if ($myroll >= $opproll) {
        my $gain = int($rps{$opp}{level}/4);
        $gain = 7 if $gain < 7;
        $gain = int(($gain/100)*$rps{$u}{next});
        chanmsg(clog(sprintf(gettext("%s [%u/%u] has come upon %s [%u/%u] and ".
				     "taken them in combat! %s is removed from ".
				     "%1\$s\'s clock."),
			     $u,$myroll,$mysum,$opp,$opproll,$oppsum,
			     duration($gain))));
        $rps{$u}{next} -= $gain;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$u,duration($rps{$u}{next})));
        if (rand(35) < 1 && $opp ne $primnick) {
            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
            chanmsg(clog(sprintf(gettext("%s has dealt %s a Critical Strike! %s".
					 " is added to %2\$s\'s clock."),
				 $u,$opp,duration($gain))));
            $rps{$opp}{next} += $gain;
            chanmsg(sprintf(gettext("%s reaches next level in %s."),$opp,duration($rps{$opp}{next})));
        }
        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
            my @items = ("ring","amulet","charm","weapon","helm","tunic",
                         "pair of gloves","set of leggings","shield",
                         "pair of boots");
            my $type = $items[rand(@items)];
            if (itemlevel($rps{$opp}{item}{$type}) > itemlevel($rps{$u}{item}{$type})) {
                chanmsg(sprintf(gettext("In the fierce battle, %s dropped his ".
					"level %u %s! %s picks it up, tossing ".
					"his old level %u %3\$s to %1\$s."),
				$opp,itemlevel($rps{$opp}{item}{$type}),
				gettext($type),$u,
				itemlevel($rps{$u}{item}{$type})));
                my $tempitem = $rps{$u}{item}{$type};
                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
                $rps{$opp}{item}{$type} = $tempitem;
            }
        }
    }
    else {
        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
        $gain = 7 if $gain < 7;
        $gain = int(($gain/100)*$rps{$u}{next});
        chanmsg(clog(sprintf(gettext("%s [%u/%u] has come upon %s [%u/%u] and ".
				     "been defeated in combat! %s is added to ".
				     "%1\$s\'s clock."),
			     $u,$myroll,$mysum,$opp,$opproll,$oppsum,
			     duration($gain))));
        $rps{$u}{next} += $gain;
        chanmsg(sprintf(gettext("%s reaches next level in %s."),$u,duration($rps{$u}{next})));
    }
}

sub writequestfile {
    return unless $opts{writequestfile};
    open(QF,">$opts{questfilename}") or do {
        chanmsg("Error: Cannot open $opts{questfilename}: $!");
        return;
    };
    # if no active quest, just empty questfile. otherwise, write it
    if (@{$quest{questers}}) {
        if ($quest{type}==1) {
            print QF "T $quest{text}\n".
                     "Y 1\n".
                     "S $quest{qtime}\n".
                     "P1 $quest{questers}->[0]\n".
                     "P2 $quest{questers}->[1]\n".
                     "P3 $quest{questers}->[2]\n".
                     "P4 $quest{questers}->[3]\n";
        }
        elsif ($quest{type}==2) {
            print QF "T $quest{text}\n".
                     "Y 2\n".
                     "S $quest{stage}\n".
                     "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
                        "$quest{p2}->[1]\n".
                     "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
                         "$rps{$quest{questers}->[0]}{y}\n".
                     "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
                         "$rps{$quest{questers}->[1]}{y}\n".
                     "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
                         "$rps{$quest{questers}->[2]}{y}\n".
                     "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
                         "$rps{$quest{questers}->[3]}{y}\n";
        }
    }
    close(QF);
}

sub loadquestfile {
    return unless ($opts{writequestfile} && -e $opts{questfilename});
    open(QF,$opts{questfilename}) or do {
        chanmsg("Error: Cannot open $opts{questfilename}: $!");
        return;
    };

    my %questdata = ();
    while (my $line = <QF>) {
        chomp $line;
        my ($tag,$data) = split(/ /,$line,2);
        $questdata{$tag} = $data;
    }
    return unless defined($questdata{Y});

    $quest{text} = $questdata{T};
    $quest{type} = $questdata{Y};
    if ($quest{type} == 1) {
        $quest{qtime} = $questdata{S};
    }
    else {
        $quest{stage} = $questdata{S};
        my ($p1x,$p1y,$p2x,$p2y) = split(/ /,$questdata{P});
        $quest{p1}->[0] = $p1x;
        $quest{p1}->[1] = $p1y;
        $quest{p2}->[0] = $p2x;
        $quest{p2}->[1] = $p2y;
    }
    for my $i (0..3) {
        ($quest{questers}->[$i],) = split(/ /,$questdata{'P'.($i+1)},2);
        if (!$rps{$quest{questers}->[$i]}{online}) {
            undef(@{$quest{questers}});
            last;
        }
    }
    close(QF);
    writequestfile();
}

sub goodness {
    my @players = grep { $rps{$_}{alignment} eq "g" &&
                         $rps{$_}{online} } keys(%rps);
    return unless @players > 1;
    splice(@players,int(rand(@players)),1) while @players > 2;
    my $gain = 5 + int(rand(8));
    chanmsg(clog(sprintf(gettext("%s and %s have not let the iniquities of ".
                 "evil men poison them. Together have they prayed to their ".
                 "god, and it is his light that now shines upon them. %u%% ".
                 "of their time is removed from their clocks."),
			 $players[0],$players[1],$gain)));
    $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
    $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
    chanmsg(sprintf(gettext("%s reaches next level in %s."),
            $players[0],duration($rps{$players[0]}{next})));
    chanmsg(sprintf(gettext("%s reaches next level in %s."),
            $players[1],duration($rps{$players[1]}{next})));
}

sub evilness {
    my @evil = grep { $rps{$_}{alignment} eq "e" &&
                      $rps{$_}{online} } keys(%rps);
    return unless @evil;
    my $me = $evil[rand(@evil)];
    if (int(rand(2)) < 1) {
        # evil only steals from good :^(
        my @good = grep { $rps{$_}{alignment} eq "g" &&
                          $rps{$_}{online} } keys(%rps);
        my $target = $good[rand(@good)];
        my @items = ("ring","amulet","charm","weapon","helm","tunic",
                     "pair of gloves","set of leggings","shield",
                     "pair of boots");
        my $type = $items[rand(@items)];
        if (itemlevel($rps{$target}{item}{$type}) > itemlevel($rps{$me}{item}{$type})) {
            my $tempitem = $rps{$me}{item}{$type};
            $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
            $rps{$target}{item}{$type} = $tempitem;
            chanmsg(clog(sprintf(gettext("%s stole %s\'s level %u %s while ".
					 "they were sleeping! %1\$s leaves his ".
					 "old level %u %4\$s behind, which ".
					 "%2\$s then takes."),
				 $me,$target,itemlevel($rps{$me}{item}{$type}),
				 gettext($type),
				 itemlevel($rps{$target}{item}{$type}))));
        }
        else {
            notice(sprintf(gettext("You made to steal %s\'s %s, but realized ".
				   "it was lower level than your own. You ".
				   "creep back into the shadows."),
			   $target,gettext($type)),$rps{$me}{nick});
        }
    }
    else { # being evil only pays about half of the time...
        my $gain = 1 + int(rand(5));
        chanmsg(clog(sprintf(gettext("%s is forsaken by his evil god. %s".
				     " is added to his clock."),$me,
			     duration(int($rps{$me}{next} * ($gain/100))))));
        $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
        chanmsg(sprintf(gettext("%s reaches next level in %s."),
			$me,duration($rps{$me}{next})));
    }
}

sub writedb {
    open(RPS,">$opts{dbfile}") or do {
        chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
        return 0;
    };
    print RPS join("\t","# username",
                        "pass",
                        "is admin",
                        "level",
                        "class",
                        "next ttl",
                        "nick",
                        "userhost",
                        "online",
                        "idled",
                        "x pos",
                        "y pos",
                        "pen_mesg",
                        "pen_nick",
                        "pen_part",
                        "pen_kick",
                        "pen_quit",
                        "pen_quest",
                        "pen_logout",
                        "created",
                        "last login",
                        "amulet",
                        "charm",
                        "helm",
                        "boots",
                        "gloves",
                        "ring",
                        "leggings",
                        "shield",
                        "tunic",
                        "weapon",
                        "alignment")."\n";
    my $k;
    keys(%rps); # reset internal pointer
    while ($k=each(%rps)) {
        if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
            print RPS join("\t",$k,
                                $rps{$k}{pass},
                                $rps{$k}{isadmin},
                                $rps{$k}{level},
                                $rps{$k}{class},
                                $rps{$k}{next},
                                $rps{$k}{nick},
                                $rps{$k}{userhost},
                                $rps{$k}{online},
                                $rps{$k}{idled},
                                $rps{$k}{x},
                                $rps{$k}{y},
                                $rps{$k}{pen_mesg},
                                $rps{$k}{pen_nick},
                                $rps{$k}{pen_part},
                                $rps{$k}{pen_kick},
                                $rps{$k}{pen_quit},
                                $rps{$k}{pen_quest},
                                $rps{$k}{pen_logout},
                                $rps{$k}{created},
                                $rps{$k}{lastlogin},
                                $rps{$k}{item}{amulet},
                                $rps{$k}{item}{charm},
                                $rps{$k}{item}{helm},
                                $rps{$k}{item}{"pair of boots"},
                                $rps{$k}{item}{"pair of gloves"},
                                $rps{$k}{item}{ring},
                                $rps{$k}{item}{"set of leggings"},
                                $rps{$k}{item}{shield},
                                $rps{$k}{item}{tunic},
                                $rps{$k}{item}{weapon},
                                $rps{$k}{alignment})."\n";
        }
    }
    close(RPS);
    open(ITEMS,">$opts{itemdbfile}") or do {
        chanmsg("ERROR: Cannot write $opts{itemdbfile}: $!");
        return 0;
    };
    print ITEMS join("\t","# x pos",
                        "y pos",
                        "type",
                        "level",
                        "age")."\n";
    my $curtime = time();
    for my $xy (keys(%mapitems)) {
        for my $i (0..$#{$mapitems{$xy}}) {
            my @coords = split(/:/,$xy);
            print ITEMS join("\t",$coords[0],
                                  $coords[1],
                                  $mapitems{$xy}[$i]{type},
                                  $mapitems{$xy}[$i]{level},
                                  $curtime-$mapitems{$xy}[$i]{lasttime})."\n";
        }
    }
    close(ITEMS);
}

sub readconfig {
    if (! -e ".irpg.conf") {
        debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
              "please.",1);
    }
    else {
        open(CONF,"<.irpg.conf") or do {
            debug("Failed to open config file .irpg.conf: $!",1);
        };
        my($line,$key,$val);
        while ($line=<CONF>) {
            next() if $line =~ /^#/; # skip comments
            $line =~ s/[\r\n]//g;
            $line =~ s/^\s+//g;
            next() if !length($line); # skip blank lines
            ($key,$val) = split(/\s+/,$line,2);
            $val = "" if !defined($val);
            $key = lc($key);
            if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
            elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
            if ($key eq "die") {
                die("Please edit the file .irpg.conf to setup your bot's ".
                    "options. Also, read the README file if you haven't ".
                    "yet.\n");
            }
            elsif ($key eq "server") { push(@{$opts{servers}},$val); }
            elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
            else { $opts{$key} = $val; }
        }
    }
}