#!/usr/local/bin/perl -w
# irpg bot v2.2.2 (schmolli) by jotun, fakeusername@fakedomainname.com
#
# Some code within this file was written by authors other than myself. As such,
# please contact me before distributing or modifying and distributing this
# source code.
#
# 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.2 (schmolli)
#   * The changes in this version are based almost completely on a patch sent
#     to me by Ed Schmollinger, schmolli@IRC. Many thanks to him for his help!
#     Here are his changes:
#   - SECURITY: added subroutine mksalt to generate random salt for passwds
#   - CLEANUP: added subroutines chanmsg and privmsg to send messages to
#     bot's channel and to a specified user, respectively
#   - FEATURE: added command line argument processing and removed TEST_MODE
#     (TEST_MODE is no longer necessary.)  Part of this includes moving most
#     of the variables into %opts.
#   - CLEANUP: renamed botidentify to botpw, changed option to just store pw
#     instead of entire identify string
#   - CLEANUP: changed option botopcmd to just store the message to send
#     instead of entire PRIVMSG command (is this a bad idea?)
#   - FIX: added check for number of existing players when printing top 3
#   - CLEANUP: changed "in:" and "out:" debug message to "<-" and "->"
#   - CLEANUP: indented concatenated lines
# 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;
use Getopt::Long;

my $version = "2.2.2 (schmolli)";
(my $prog = $0) =~ s/^.*\///;

my %opts = (
  'server' => 'area51.slashnet.org:6667',
  'botnick' => 'b0t',
  'botuser' => 'bot',
  'botrlnm' => 'http://www.slashnet.org/~b0t/',
  'botchan' => '#g7',
  'botpw' => 'g7_rocks!!',
  'botopcmd' => "PRIVMSG #G7 :opz plzkthx!!1 :)))",
  'helpurl' => 'http://jotun.ultrazone.org/g7/',
  'admincommurl' => 'http://jotun.ultrazone.org/g7/admincomms.txt',
  'access' => [ 'yawnwraith', 'jotun', 'drdink' ],
  'rpstep' => 1.16,
  'rpbase' => 600,
  'rppenstep' => 1.14,
  'dbfile' => 'irpg.db',
);

GetOptions(\%opts,
  "help|h",
  "verbose|v",
  "debug",
  "server|s=s",
  "botnick|n=s",
  "botuser|u=s",
  "botrlnm|r=s",
  "botchan|c=s",
  "botpw|p=s",
  "botopcmd|o=s",
  "helpurl=s",
  "admincommurl=s",
  "access=s@",
  "rpstep=f",
  "rpbase=i",
  "rppenstep=f",
  "dbfile|irpgdb|db|d=s",
) or die "error parsing command line\n";

$opts{'help'} and do { help(); exit 0; };
my $debug = $opts{'debug'} || 0;
my $v = $opts{'verbose'} || $debug;

my $outbytes = 0; # sent bytes
my $inbytes = 0; # received bytes
my %onchan; # users on game channel
my %rps; # role-players
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

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

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

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

print "Disconnected.\n" if $v || $debug;

sub sts { # send to server
  my $text = shift;
  print $sock "$text\r\n";
  print "-> $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 (@{$opts{'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) {
    chanmsg("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 {
    chanmsg("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;
  }
  chanmsg("$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;
    chanmsg("#G7 Idle RPG Top Players:");
    for my $i (0..2) {
      $#u >= $i and
      chanmsg("$u[$i], the level $rps{$u[$i]}{level} ".
              "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ".
              (duration($rps{$u[$i]}{next})).".");
    }
    system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
  }
  open(RPS,">$opts{dbfile}") or die "$opts{dbfile}: $!";

  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($opts{'rpbase'}*($opts{'rpstep'}**$rps{$k}{level}));
        sts("PRIVMSG $opts{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 $opts{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 $opts{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 $opts{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 $opts{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 $opts{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 = (); # redundant?
  (open(RPS,"<$opts{dbfile}") || ! -e $opts{dbfile}) or die "loaddb() failed; $!";
  while (my $l=<RPS>) {
    chomp $l;
    next if $l =~ /^#/; # skip comments
    my @i = split("\t",$l);
    print Dumper @i if @i != 19;
    die "Anomaly in loaddb(); line $. of $opts{dbfile} 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;
}

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;
  privmsg($msg, $opts{'botchan'});
}

sub privmsg { # send a message to an arbitrary entity
  my $msg = shift or return undef;
  my $target = shift or return undef;
  sts("PRIVMSG $target :$msg");
}

sub help { # print help message 
	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 local username
  --botrlnm, -r        Bot's real name
  --botchan, -c        IRC channel to join
  --botpw, -p          Specify passwd to identify with
  --botopcmd, -o       Specify text to send to server on successful connect
  --helpurl            URL to refer new users to
  --admincommurl       URL to refer admins to
  --access             Usernames allowed to issue admin commands

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

";
}
