#!/usr/local/bin/perl -w
# irpg bot v2.2.1 by jotun, fakeusername@fakedomainname.com
#
# Please mail bugs, etc. to me. There is no help available for this code; just
# ask if you need an explanation of my sloppy code. 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!
#
# v2.2.1
#   - fixed a bug in item finding; if unique item was better than helm, not
#     better than its class, you would get the item (emad)
# v2.2
#   - added 1/20000 chance of 'team battle' every 5 seconds. team battle is
#     3 players versus 3 other players. if the first three players win, their
#     time is lowered by 20% of the lowest of the three's TTL. if they lose,
#     no time is removed from any players. there is no chance for critical
#     strike in a team battle (Asterax)
#   - max level of Jotun's Fury Colossal Sword changed to 175
#   - fixed 'kick' bug; users that were kicked were not logged out
#   - kick added as a p250
#   - b0t now only bans those non-logged in users that say 'http:' that've
#     been in the channel < 90 seconds
#   - b0t won't ban for #G7-type URLs
#   - b0t now shows nick of user when new account is registered
#   - forgot to close filehandle in loaddb(); fixed
#   - added a db backup every 6 hours
# v2.1.3
#   - fixed bug where users changing their nick would not be candidates for
#     auto-login on a bot restart
#   - changed some messages to make them more friendly to female
#     players (LapCat)
# v2.1.2
#   - HoG can now carry or displace a player 5 - 75% toward the next level
#   - fixed CTCP version bug
#   - battling was changed from all users within 7 levels of you to
#     all online users
#   - added "unique" items, or a chance starting at level 25 to roll
#     higher-than-normal items
# v2.1.1
#   - DIE, JUMP, RESTART, INFO, and PEVAL now send warnings to users that
#     don't have access to tell them so. they are still penalized
#   - b0t will now penalize users without the proper access that try to use an
#     admin command
#   - add commands CHCLASS, CHUSER, and PUSH to adjust class names, usernames,
#     and next time to level, respectively
#   - HoG could occur for offline users; this is no longer the case
#   - b0t now responds to CTCP version requests (drdink)
# v2.1
#   - b0t bans non-logged-in users that say 'http:'
#   - INFO did not check ha(); fixed
#   - b0t will automagically log you back in if you were logged in before
#     a b0t restart, and if you haven't changed your nick!user@host since then
#   - removed logging
#   - dropped functions relating to old database in favor of the new one
#   - changed level up report from seconds to duration()
#   - changed item/userinfo db's to one file; battles still in battles.txt
#   - changed challenge report from seconds to duration()
#   - changed penalty text to display duration() instead of seconds
#   - added critical strike, 1/35 chance upon winning battle to cause opponent
#     to lose time (dwyn)
#   - changed summon text for HoG (res0)
#   - changed access to base off of irpg username in lieu of host
#   - changed top player report to every 6 hours
#   - changed positive HoG text (res0)
#   - changed random HoG chance to 1/20000 every 5 seconds
# v2.0.3
#   - dropped top players back to 3
#   - removed STATUS; TTL available through website.
#   - battle history added to website; added logging of battles to battles.txt
#   - peval did not next(); fixed.
#   - added HOG command, randomly chooses someone, then randomly raises/lowers
#     their TTL (20% raise, 80% lower). HOG is, of course, an abbreviation for
#     Hand of God
#   - added a 1/7500 random HoG into rpcheck()
# v2.0.2
#   - STATUS would log you out; fixed.
#   - could STATUS if not online; fixed.
#   - added DEL command to remove accounts
#   - added ALERT command to make channel alerts
#   - changed admin HELP command text to display website
# v2.0.1
#   - fixed self-battle bug
#   - changed chance to battle from 20% to 25% if level < 25, 100% if >= 25
#   - setup companion website
#   - updated HELP command to reflect website
#   - changed battle gain to (max(7,opplevel/4)/100)*your_next_ttl
#   - added battle loss of (max(7,opplevel/7)/100)*your_next_ttl
# v2.0
#   - added item finding and battling
#   - added penalties for QUIT, PART, instead of resetting time to the
#     beginning of that level
# v1.0
#   - initial version

use strict;
use IO::Socket;
use Data::Dumper;

my $TEST_MODE = 0; # connect to another test server; see lower block

my $version = "2.2.1";

my $server = "area51.slashnet.org:6667";
my $botnick = "b0t"; # nick
my $botuser = "bot"; # username
my $botrlnm = "http://www.slashnet.org/~b0t/"; # real name
my $botchan = "#g7"; # game channel
my $botidentify = "identify g7_rocks!!"; # identify to services
my $botopcmd = "PRIVMSG #g7 :opz plzkthx!!1 :)))"; # op self in channel
my $helpurl = "http://jotun.ultrazone.org/g7/"; # URL sent for help
my $admincommurl = "http://jotun.ultrazone.org/g7/admincomms.txt";
   # ^-- URL for admin help
my @access = ('yawnwraith','jotun','drdink');
   # ^-- usernames with admin access


my $outbytes = 0; # sent bytes
my $inbytes = 0; # received bytes
my $debug = 0; # print debug yes/no
my %onchan; # users on game channel
my %rps; # role-players
my $irpgdb = "irpg.db"; # database
my $rpstep = 1.16; # NEXT_LEVEL=(RPBASE*(RPSTEP**CURRENT_LEVEL))
my $rpbase = 600; # NEXT_LEVEL=(RPBASE*(RPSTEP**CURRENT_LEVEL))
my $rppenstep = 1.14; # PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
my $rpreport = 0; # constant for reporting top players
my $alrmint = 5; # secs between database rewrites
my @prev_online; # user@hosts online on restart, die
my @auto_login; # users to automatically log back on

$SIG{'HUP'} = 0; # ignore sighup

if ($TEST_MODE) {
  $server = "user-33qt3ul.dialup.mindspring.com:7800";
  $rpstep = 0; # 0-second levels
  $rpbase = 0; # 0-second levels
}

CONNECT: # cheese.
loaddb();
my $sock = IO::Socket::INET->new(PeerAddr=>$server,PeerPort=>6667);
die "Could not build socket; $!" unless $sock;

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

while (<$sock>) {
  $inbytes += length;
  s/[\r\n]//g;
  my @arg = split/ /;
  if (lc $arg[0] eq 'ping') { sts("PONG $arg[1]"); }
  if ($arg[1] eq '433') {
    $botnick .= 0;
    sts("NICK $botnick");
  }
  if (lc $arg[1] eq 'join') {
    my $usernick = (split(/!/,$arg[0]))[0];
    $usernick = substr($usernick,1);
    $onchan{$usernick}=time();
  }
  if (lc $arg[1] eq 'quit') {
    my $usernick = (split(/!/,$arg[0]))[0];
    $usernick = substr($usernick,1);
    for my $k (keys %rps) {
      if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick
      && $rps{$k}{online}) {
        $rps{$k}{online}=0;
        $rps{$k}{next}+=int(20 * ($rppenstep**$rps{$k}{level}));
      }
    }
    delete $onchan{$usernick};
  }
  if (lc $arg[1] eq 'nick') {
    my $usernick = (split(/!/,$arg[0]))[0];
    $usernick = substr($usernick,1);
    for my $k (keys %rps) {
      if ($rps{$k}{nick} eq $usernick && $rps{$k}{online}) {
        $rps{$k}{nick}=substr($arg[2],1);
        $rps{$k}{userhost}=substr($arg[0],1);
        $rps{$k}{next} += int(30 * ($rppenstep**$rps{$k}{level}));
        sts("NOTICE $rps{$k}{nick} :Penalty of ".
        duration(int(30 * ($rppenstep**$rps{$k}{level}))).
        " added to your timer for changing nicks.");
      }
    }
    $onchan{substr($arg[2],1)} = delete $onchan{$usernick};
  }
  if (lc $arg[1] eq 'part') {
    my $usernick = (split(/!/,$arg[0]))[0];
    $usernick = substr($usernick,1);
    for my $k (keys %rps) {
      if (exists $rps{$k}{nick} &&
      $rps{$k}{nick} eq $usernick && $rps{$k}{online}) {
        $rps{$k}{online}=0;
        $rps{$k}{next}+=int(200 * ($rppenstep**$rps{$k}{level}));
        sts("NOTICE $rps{$k}{nick} :Penalty of ".
        duration(int(200 * ($rppenstep**$rps{$k}{level}))).
        " added to your timer for parting.");
      }
    }
    delete $onchan{$usernick};
  }
  if (lc $arg[1] eq 'kick') {
    my $usernick = $arg[3];
    for my $k (keys %rps) {
      if (exists $rps{$k}{nick} &&
      $rps{$k}{nick} eq $usernick && $rps{$k}{online}) {
        $rps{$k}{online}=0;
        $rps{$k}{next}+=int(250 * ($rppenstep**$rps{$k}{level}));
        sts("NOTICE $rps{$k}{nick} :Penalty of ".
        duration(int(250 * ($rppenstep**$rps{$k}{level}))).
        " added to your timer for getting kicked.");
      }
    }
    delete $onchan{$usernick};
  }
  if (lc $arg[1] eq '315') {
    if (@auto_login) {
      sts("PRIVMSG $botchan :".scalar @auto_login." users matching ".
          scalar @prev_online." hosts automatically logged in; accounts: ".
          join(", ",@auto_login));
    }
    else { sts("PRIVMSG $botchan :0 users qualified for auto login."); }
    undef @prev_online;
    undef @auto_login;
  }
  if (lc $arg[1] eq '352') {
    $onchan{$arg[7]}=time();
    for my $k (keys %rps) {
      for my $host (@prev_online) {
        if ($rps{$k}{userhost} eq $arg[7]."!".$arg[4]."\@".$arg[5] &&
            $rps{$k}{userhost} eq $host) {
          $rps{$k}{online} = 1;
          $rps{$k}{lastlogin} = localtime(time());
          if (!scalar(grep { $_ eq $k } @auto_login)) {
            push(@auto_login,$k);
          }
        }
      }
    }
  }
  if ($arg[1] eq '001') {
    sts($botidentify);
    sts("JOIN $botchan");
    sts("MODE $botchan");
    sts($botopcmd);
    sts("WHO $botchan");
    $SIG{ALRM} = \&rpcheck;
    alarm(5);
  }
  if (lc $arg[1] eq 'notice') {
    my $usernick = (split(/!/,$arg[0]))[0];
    $usernick = substr($usernick,1);
    for my $k (keys %rps) {
      if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick
      && $rps{$k}{online}) {
        $rps{$k}{next} += int((length("@arg[3..$#arg]")-1) *
        ($rppenstep**$rps{$k}{level}));
        sts("NOTICE $rps{$k}{nick} :Penalty of ".
        duration(int((length("@arg[3..$#arg]")-1) *
        ($rppenstep**$rps{$k}{level}))).
        " added to your timer for notice.");
      }
    }
  }
  if (lc $arg[1] eq 'privmsg') {
    $arg[0] = substr($arg[0],1);
    my $usernick = (split/!/,$arg[0])[0];
    if (lc $arg[2] eq lc $botnick) {
      if (lc $arg[3] eq ":\1version\1") {
        sts("NOTICE $usernick :\1VERSION IRPG bot v$version by jotun; ".
            "$helpurl\1");
      }
      if (lc $arg[3] eq ":calc" && ha($usernick)) {
        my $eq = "@arg[4..$#arg]";
        $eq =~ s/[^\d\.\+\-\(\)\*\&\^\%\~\!\/]//g;
        sts("PRIVMSG $botchan :$_") for eval $eq;
        if ($@) {
          sts("PRIVMSG $usernick :EVAL ERROR   : $@");
          sts("PRIVMSG $usernick :In expression: $eq");
        }
        next;
      }
      if (lc $arg[3] eq ":peval") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to PEVAL.");
        }
        else {
          sts("PRIVMSG $usernick :$_") for eval "@arg[4..$#arg]";
          sts("PRIVMSG $usernick :EVAL ERROR: $@") if $@;
          next;
        }
      }
      if (lc $arg[3] eq ":register") {
        if ($#arg < 6 || $arg[6] eq "") {
          sts("PRIVMSG $usernick :Try: REGISTER <char name> <password> <class>");
          sts("PRIVMSG $usernick :IE : REGISTER Poseidon MyPassword ".
          "God of the Sea");
        }
        elsif (exists $rps{$arg[4]}) {
          sts("PRIVMSG $usernick :Sorry, that charname is already in use.");
        }
        elsif (!exists $onchan{$usernick}) {
          sts("PRIVMSG $usernick :Sorry, you're not in $botchan.");
        }
        elsif (length $arg[4] > 16) {
          sts("PRIVMSG $usernick :Sorry, charnames must be < 17 chars long.");
        }
        elsif (length "@arg[6..$#arg]" > 30) {
          sts("PRIVMSG $usernick :Sorry, char classes must be < 31 chars long.");
        }
        else {
          $rps{$arg[4]}{next} = $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]}{lastlogin} = localtime(time());
          $rps{$arg[4]}{pass} = crypt($arg[5],"rp");
          sts("PRIVMSG $botchan :Welcome $usernick"."'s new player $arg[4], ".
          "the @arg[6..$#arg]! Next level in ".duration($rpbase).".");
          sts("PRIVMSG $usernick :Success! Account $arg[4] created. ".
          "You have $rpbase seconds idleness until you reach level 1. ");
          sts("PRIVMSG $usernick :NOTE: The point of the game is to see who ".
          "can idle the longest. As such, talking (to channel or the ".
          "bot), parting, quitting, and changing nicks penalize you.");
          next;
        }
      }
      if (lc $arg[3] eq ":del") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to del.");
        }
        else {
          if (!defined $arg[4]) {
            sts("PRIVMSG $usernick :Try: DEL <char name>");
          }
          else {
            if (exists $rps{$arg[4]}) {
              delete $rps{$arg[4]};
              sts("PRIVMSG $botchan :Account $arg[4] removed by $arg[0].");
            }
            else { sts("PRIVMSG $usernick :No such account $arg[4]."); }
          }
          next;
        }
      }
      if (lc $arg[3] eq ":alert") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to ALERT.");
        }
        else {
          if (!defined $arg[4]) {
            sts("PRIVMSG $usernick :Try: ALERT <message>");
          }
          else {
            sts("PRIVMSG $botchan :ALERT from $usernick: @arg[4..$#arg]");
          }
          next;
        }
      }
      if (lc $arg[3] eq ":hog") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to HOG.");
        }
        else {
          sts("PRIVMSG $botchan :$usernick has summoned the Hand of God.");
          hog();
          next;
        }
      }
      if (lc $arg[3] eq ":chpass") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to CHPASS.");
        }
        else {
          if (!defined $arg[5]) {
            sts("PRIVMSG $usernick :Try: CHPASS <char name> <new pass>");
          }
          else {
            if (exists $rps{$arg[4]}) {
              $rps{$arg[4]}{pass} = crypt($arg[5],"rp");
              sts("PRIVMSG $usernick :Password for $arg[4] changed.");
            }
            else {
              sts("PRIVMSG $usernick :No such username $arg[4].");
            }
          }
          next;
        }
      }
      if (lc $arg[3] eq ":chuser") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to CHUSER.");
        }
        else {
          if (!defined $arg[5]) {
            sts("PRIVMSG $usernick :Try: CHUSER <char name> <new char name>");
          }
          elsif (!exists $rps{$arg[4]}) {
            sts("PRIVMSG $usernick :No such username $arg[4].");
          }
          elsif (exists $rps{$arg[5]}) {
            sts("PRIVMSG $usernick :Username $arg[5] is already taken.");
          }
          else {
            $rps{$arg[5]} = delete $rps{$arg[4]};
            sts("PRIVMSG $usernick :Username for $arg[4] changed to $arg[5].");
          }
          next;
        }
      }
      if (lc $arg[3] eq ":chclass") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to CHCLASS.");
        }
        else {
          if (!defined $arg[5]) {
            sts("PRIVMSG $usernick :Try: CHCLASS <char name> <new char class>");
          }
          else {
            if (exists $rps{$arg[4]}) {
              $rps{$arg[4]}{class} = "@arg[5..$#arg]";
              sts("PRIVMSG $usernick :Class for $arg[4] changed to @arg[5..$#arg].");
            }
            else { sts("PRIVMSG $usernick :No such username $arg[4]."); }
          }
          next;
        }
      }
      if (lc $arg[3] eq ":push") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You don't have access to PUSH.");
        }
        else {
          if (!defined $arg[5]) {
            sts("PRIVMSG $usernick :Try: PUSH <char name> <seconds>");
          }
          else {
            if (exists $rps{$arg[4]}) {
              $rps{$arg[4]}{next} -= $arg[5];
              sts("PRIVMSG $usernick :Time to level for $arg[4] pushed ahead ".
                  "$arg[5] seconds. $arg[4] reaches next level in ".
                  duration($rps{$arg[4]}{next}).".");
              sts("PRIVMSG $botchan :$usernick has pushed $arg[4] $arg[5] ".
                  "seconds toward level ".($rps{$arg[4]}{level}+1).
                  ". $arg[4] reaches next level in ".
                  duration($rps{$arg[4]}{next}).".");
            }
            else { sts("PRIVMSG $usernick :No such username $arg[4]."); }
          }
          next;
        }
      }   
      if (lc $arg[3] eq ":whoami") {
        my $f=0;
        for (keys %rps) {
          if (exists $rps{$_}{nick} && $rps{$_}{nick} eq $usernick
              && $rps{$_}{online}) {
            sts("PRIVMSG $usernick :You are logged in as $_.");
            $f=1;
          }
        }
        sts("PRIVMSG $usernick :You are not logged in.") if !$f;
        next;
      }
      if (lc $arg[3] eq ":help") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :To register a new account: ".
          "/msg $botnick REGISTER");
          sts("PRIVMSG $usernick :To login to an account: ".
          "/msg $botnick LOGIN");
          sts("PRIVMSG $usernick :If you forget your password, ask for help ".
          "in the channel.");
          sts("PRIVMSG $usernick :For more info, see $helpurl");
        }
        else {
          sts("PRIVMSG $usernick :Help URL is $helpurl");
          sts("PRIVMSG $usernick :Admin commands URL is $admincommurl");
        }
        next;
      }
      if (lc $arg[3] eq ":die") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You do not have access to DIE.");
        }
        else {
          sts("QUIT :DIE from $arg[0]");
          next;
        }
      }
      if (lc $arg[3] eq ":jump") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You do not have access to JUMP.");
        }
        elsif (!defined $arg[4]) {
          sts("PRIVMSG $usernick :Try JUMP <server[:port]>");
        }
        else {
          sts("QUIT :JUMP to $arg[4] from $arg[0]");
          $server = $arg[4];
          close $sock;
          sleep 3;
          goto CONNECT;
        }
      }
      if (lc $arg[3] eq ":restart") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You do not have access to RESTART.");
        }
        else {
          sts("QUIT :RESTART from $arg[0]");
          exec("perl $0");
        }
      }
      if (lc $arg[3] eq ":info") {
        if (!ha($usernick)) {
          sts("PRIVMSG $usernick :You do not have access to INFO.");
        }
        else {
          my $info = sprintf("%.2fkb sent, %.2fkb received in %s. ".
          "%d IRPG users online.",
          $outbytes/1024,$inbytes/1024,duration(time-$^T),
          scalar(grep { $rps{$_}{online} } keys %rps));
          sts("PRIVMSG $usernick :$info");
          next;
        }
      }
      if (lc $arg[3] eq ":login") {
        if ($#arg < 5 || $arg[5] eq "") {
          sts("PRIVMSG $usernick :Try: LOGIN <username> <password>");
        }
        elsif (!exists $rps{$arg[4]}) {
          sts("PRIVMSG $usernick :Sorry, no such account name. Note ".
          "that account names are case sensitive.");
        }
        elsif (!exists $onchan{$usernick}) {
          sts("PRIVMSG $usernick :Sorry, you're not in $botchan.");
        }
        elsif ($rps{$arg[4]}{pass} ne crypt($arg[5],"rp")) {
          sts("PRIVMSG $usernick :Wrong password.");
        }
        else {
          $rps{$arg[4]}{online} = 1;
          $rps{$arg[4]}{nick} = $usernick;
          $rps{$arg[4]}{userhost} = $arg[0];
          $rps{$arg[4]}{lastlogin} = localtime(time());
          sts("PRIVMSG $botchan :$arg[4], the level $rps{$arg[4]}{level} ".
          "$rps{$arg[4]}{class}, is now online from nickname $usernick. ".
          "Next level in ".duration($rps{$arg[4]}{next}).".");
          sts("PRIVMSG $usernick :Logon successful. Next level in ".
          duration($rps{$arg[4]}{next}).".");
        }
        next;
      }
    }
    my $found = 0;
    for my $k (keys %rps) {
      if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick
      && $rps{$k}{online}) {
        $rps{$k}{next} += int((length("@arg[3..$#arg]")-1) *
        ($rppenstep**$rps{$k}{level}));
        sts("NOTICE $rps{$k}{nick} :Penalty of ".
        duration(int((length("@arg[3..$#arg]")-1) *
        ($rppenstep**$rps{$k}{level}))).
        " added to your timer for privmsg.");
        $found=1;
      }
    }
    if (!$found && "@arg" =~ /http:/i && (time()-$onchan{$usernick}) < 90 &&
        "@arg" !~ /ultrazone/i) {
      sts("MODE $botchan +b $arg[0]");
    }
  }
  print "in : $_\n" if $debug;
}

print "Disconnected.\r\n" if $debug;

sub sts { # send to server
  my $text = shift;
  print $sock "$text\r\n";
  print "out: $text\n" if $debug;
  $outbytes += length($text) + 2;
}

sub ha { # return 0/1 if username has access
  my $nick = shift;
  for my $k (keys %rps) {
    if ($rps{$k}{nick} eq $nick && $rps{$k}{online}) {
      for my $l (@access) { return 1 if $l eq $k; }
    }
  }
  return 0;
}

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

sub ts { # timestamp
  my @ts = localtime(time);
  sprintf("[%02d:%02d:%02d] ",$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(70)))/100) * $rps{$player}{next});
  if ($win) {
    sts("PRIVMSG $botchan :Verily I say unto thee, the Heavens have burst ".
    "forth, and the blessed hand of God carried $player ".duration($time).
    " toward level ".($rps{$player}{level}+1).".");
    $rps{$player}{next} -= $time;
  }
  else {
    sts("PRIVMSG $botchan :Thereupon He stretched out His little finger ".
    "among them and consumed $player with fire, slowing the heathen ".
    duration($time)." from level ".($rps{$player}{level}+1).".");
    $rps{$player}{next} += $time;
  }
  sts("PRIVMSG $botchan :$player reaches next level in ".
  duration($rps{$player}{next}).".");
}

sub rpcheck { # check levels, update database
  hog() if rand(20000) < 1;
  team_battle() if rand(20000) < 1;
  if ($rpreport%4320==0) { # 4320 = six hours, if $alrmint is 5 seconds
    my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
    $rps{$a}{next}  <=> $rps{$b}{next} } keys %rps;
    sts("PRIVMSG $botchan :#G7 Idle RPG Top Players:");
    sts("PRIVMSG $botchan :$u[0], the level $rps{$u[0]}{level} ".
    "$rps{$u[0]}{class}, is #1! Next level in ".
    (duration($rps{$u[0]}{next})).".");
    sts("PRIVMSG $botchan :$u[1], the level $rps{$u[1]}{level} ".
    "$rps{$u[1]}{class}, is #2! Next level in ".
    (duration($rps{$u[1]}{next})).".");
    sts("PRIVMSG $botchan :$u[2], the level $rps{$u[2]}{level} ".
    "$rps{$u[2]}{class}, is #3! Next level in ".
    (duration($rps{$u[2]}{next})).".");
    system("cp $irpgdb .dbbackup/$irpgdb".time());
  }
  open(RPS,">$irpgdb") or die "FAILED WRITING $irpgdb: $!";

  print RPS "# username\tpass\tlevel\tclass\tnext\tnick\tuserhost\tonline 0/1".
  "\tlast login time\tamulet\tcharm\thelm\tboots\tgloves\tring\t".
  "leggings\tshield\ttunic\tweapon\n";
  for my $k (keys %rps) {
    if ($rps{$k}{online} && exists $rps{$k}{nick}
    && $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
      $rps{$k}{next}-=$alrmint;
      if ($rps{$k}{next} < 1) {
        $rps{$k}{level}++;
        $rps{$k}{next} = int($rpbase*($rpstep**$rps{$k}{level}));
        sts("PRIVMSG $botchan :$k, the $rps{$k}{class}, has attained level ".
        "$rps{$k}{level}! Next level in ".duration($rps{$k}{next}).
        ".");
        find_item($k);
        challenge_opp($k);
      }
    }
    print RPS join("\t",
    $k,
    $rps{$k}{pass},
    $rps{$k}{level},
    $rps{$k}{class},
    $rps{$k}{next},
    $rps{$k}{nick}||"",
    $rps{$k}{userhost}||"",
    $rps{$k}{online}||0,
    $rps{$k}{lastlogin},
    $rps{$k}{item}{amulet}||0,
    $rps{$k}{item}{charm}||0,
    $rps{$k}{item}{helm}||0,
    $rps{$k}{item}{"pair of boots"}||0,
    $rps{$k}{item}{"pair of gloves"}||0,
    $rps{$k}{item}{ring}||0,
    $rps{$k}{item}{"set of leggings"}||0,
    $rps{$k}{item}{shield}||0,
    $rps{$k}{item}{tunic}||0,
    $rps{$k}{item}{weapon}||0)."\n";
  }
  close RPS;
  ++$rpreport;
  $SIG{ALRM} = \&rpcheck;
  alarm($alrmint);
}

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];
  my($mysum,$oppsum);
  $mysum += $rps{$u}{item}{$_} for keys %{$rps{$u}{item}};
  $oppsum += $rps{$opp}{item}{$_} for keys %{$rps{$opp}{item}};
  if (rand($mysum) > rand($oppsum)) {
    my $gain = int($rps{$opp}{level}/4);
    $gain = 7 if $gain < 7;
    $gain = int(($gain/100)*$rps{$u}{next});
    sts("PRIVMSG $botchan :$u has challenged $opp in combat and won! ".
    duration($gain)." is removed from $u"."'s clock.");
    open(B,">>battles.txt");
    print B "$u has challenged $opp in combat and won! ".duration($gain).
    " is removed from $u"."'s clock.\n";
    close B;
    $rps{$u}{next} -= $gain;
    if (rand(35) < 1) {
      $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
      open(B,">>battles.txt");
      print B "$u has dealt $opp a Critical Strike! ".duration($gain).
      " is added to $opp"."'s clock.\n";
      close B;
      sts("PRIVMSG $botchan :$u has dealt $opp a Critical Strike! ".
      duration($gain)." is added to $opp"."'s clock.");
      $rps{$opp}{next} += $gain;
    }
  }
  else {
    my $gain = int($rps{$opp}{level}/7);
    $gain = 7 if $gain < 7;
    $gain = int(($gain/100)*$rps{$u}{next});
    sts("PRIVMSG $botchan :$u has challenged $opp in combat and lost! ".
    duration($gain)." is added to $u"."'s clock.");
    open(B,">>battles.txt");
    print B "$u has challenged $opp in combat and lost! ".duration($gain).
    " is added to $u"."'s clock.\n";
    close B;
    $rps{$u}{next} += $gain;
  }
}

sub team_battle { # pit three players against three other players
  my @opp = grep { $rps{$_}{online} } keys %rps;
  return if @opp < 6;
  splice(@opp,int rand @opp,1) while @opp > 6;
  my($mysum,$oppsum);
  $mysum += $rps{$opp[0]}{item}{$_} for keys %{$rps{$opp[0]}{item}};
  $mysum += $rps{$opp[1]}{item}{$_} for keys %{$rps{$opp[1]}{item}};
  $mysum += $rps{$opp[2]}{item}{$_} for keys %{$rps{$opp[2]}{item}};
  $oppsum += $rps{$opp[3]}{item}{$_} for keys %{$rps{$opp[3]}{item}};
  $oppsum += $rps{$opp[4]}{item}{$_} for keys %{$rps{$opp[4]}{item}};
  $oppsum += $rps{$opp[5]}{item}{$_} for keys %{$rps{$opp[5]}{item}};
  if (rand($mysum) > rand($oppsum)) {
    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);
    sts("PRIVMSG $botchan :$opp[0], $opp[1], and $opp[2] have team battled ".
        "$opp[3], $opp[4], and $opp[5] and won! ".duration($gain).
        " is removed from their clocks.");
    open(B,">>battles.txt");
    print B "$opp[0], $opp[1], and $opp[2] have team battled $opp[3], ".
            "$opp[4], and $opp[5] and won! ".duration($gain)." is removed ".
            "from their clocks.\n";
    close B;
    $rps{$opp[0]}{next} -= $gain;
    $rps{$opp[1]}{next} -= $gain;
    $rps{$opp[2]}{next} -= $gain;
  }
  else {
    sts("PRIVMSG $botchan :$opp[0], $opp[1], and $opp[2] have team battled ".
        "$opp[3], $opp[4], and $opp[5] and lost! No time is awarded.");
    open(B,">>battles.txt");
    print B "$opp[0], $opp[1], and $opp[2] have team battled $opp[3], ".
            "$opp[4], and $opp[5] and lost! No time is awarded.\n";
    close B;
  }
}

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;
  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) {
    my $ulevel = 50+int(rand(25));
    if ($ulevel >= $level && $ulevel > $rps{$u}{item}{helm}) {
      sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ".
          "You have found the level $ulevel Mattt's Omniscience Grand Crown! ".
          "Your enemies fall before you as you anticipate their every move.");
      $rps{$u}{item}{helm} = $ulevel;
    }
  }
  elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
    my $ulevel = 75+int(rand(25));
    if ($ulevel >= $level && $ulevel > $rps{$u}{item}{tunic}) {
      sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ".
          "You have found the level $ulevel Res0's Protectorate Plate Mail! ".
          "Your enemies cower in fear as their attacks have no effect on ".
          "you.");
      $rps{$u}{item}{tunic} = $ulevel;
    }
  }
  elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
    my $ulevel = 100+int(rand(25));
    if ($ulevel >= $level && $ulevel > $rps{$u}{item}{amulet}) {
      sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ".
          "You have found the level $ulevel Dwyn's Storm Magic Amulet! ".
          "Your enemies are swept away by an elemental fury before the war ".
          "has even begun.");
      $rps{$u}{item}{amulet} = $ulevel;
    }
  }
  elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
    my $ulevel = 150+int(rand(26));
    if ($ulevel >= $level && $ulevel > $rps{$u}{item}{weapon}) {
      sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ".
          "You have found the level $ulevel Jotun's Fury Colossal Sword! ".
          "Your enemies' hatred is brought to a quick end as you arc ".
          "your wrist, dealing the crushing blow.");
      $rps{$u}{item}{weapon} = $ulevel;
    }
  }
  elsif ($level > $rps{$u}{item}{$type}) {
    sts("NOTICE $rps{$u}{nick} :You found a level $level $type! Your ".
    "current $type is only level ".(0+$rps{$u}{item}{$type})." so ".
    "it seems Luck is with you.");
    $rps{$u}{item}{$type} = $level;
  }
  else {
    sts("NOTICE $rps{$u}{nick} :You found a level $level $type. Your ".
    "current $type is level ".(0+$rps{$u}{item}{$type})." so ".
    "it seems Luck is against you. You toss the $type.");
  }
}


sub loaddb { # load the players database
  undef %rps;
  %rps = ();
  (open(RPS,"<$irpgdb") || ! -e $irpgdb) or die "loaddb() failed; $!";
  while (chomp(my $l=<RPS>)) {
    next if $l =~ /^#/; # skip comments
    my @i = split("\t",$l);
    print Dumper @i if @i != 19;
    die "Anomaly in loaddb(); line $. of $irpgdb has wrong fields (".
      scalar @i.")" if @i != 19;
    if ($i[7]) { push(@prev_online,$i[6]); } # log back in
    $rps{$i[0]}{pass} = $i[1];
    $rps{$i[0]}{level} = $i[2];
    $rps{$i[0]}{class} = $i[3];
    $rps{$i[0]}{next} = $i[4];
    $rps{$i[0]}{nick} = $i[5];
    $rps{$i[0]}{userhost} = $i[6];
    $rps{$i[0]}{online} = 0;
    $rps{$i[0]}{lastlogin} = $i[8];
    $rps{$i[0]}{item}{amulet} = $i[9];
    $rps{$i[0]}{item}{charm} = $i[10];
    $rps{$i[0]}{item}{helm} = $i[11];
    $rps{$i[0]}{item}{"pair of boots"} = $i[12];
    $rps{$i[0]}{item}{"pair of gloves"} = $i[13];
    $rps{$i[0]}{item}{ring} = $i[14];
    $rps{$i[0]}{item}{"set of leggings"} = $i[15];
    $rps{$i[0]}{item}{shield} = $i[16];
    $rps{$i[0]}{item}{tunic} = $i[17];
    $rps{$i[0]}{item}{weapon} = $i[18];
  }
  close RPS;
}