source: irpg/trunk/bot/bot.v3.1.2.pl @ 1469

Last change on this file since 1469 was 1469, checked in by tereutes, 13 years ago

bug des @arg[x..y]

File size: 109.9 KB
Line 
1#!/usr/local/bin/perl
2# irpg bot v3.1.2 by jotun, jotun@idlerpg.net, et al. See http://idlerpg.net/
3#
4# Some code within this file was written by authors other than myself. As such,
5# distributing this code or distributing modified versions of this code is
6# strictly prohibited without written authorization from the authors. Contact
7# jotun@idlerpg.net. Please note that this may change (at any time, no less) if
8# authorization for distribution is given by patch submitters.
9#
10# As a side note, patches submitted for this project are automatically taken to
11# be freely distributable and modifiable for any use, public or private, though
12# I make no claim to ownership; original copyrights will be retained.. except as
13# I've just stated.
14#
15# Please mail bugs, etc. to me. Patches are welcome to fix bugs or clean up
16# the code, but please do not use a radically different coding style. Thanks
17# to everyone that's contributed!
18#
19# NOTE: This code should NOT be run as root. You deserve anything that happens
20#       to you if you run this code as a superuser. Also, note that giving a
21#       user admin access to the bot effectively gives them full access to the
22#       user under which your bot runs, as they can use the PEVAL command to
23#       execute any command, or possibly even change your password. I sincerely
24#       suggest that you exercise extreme caution when giving someone admin
25#       access to your bot, or that you disable the PEVAL command for non-owner
26#       accounts in your config file, .irpg.conf
27
28use strict;
29use warnings;
30use IO::Socket;
31use IO::Socket::INET6;
32use IO::Select;
33use Data::Dumper;
34use Getopt::Long;
35use Locale::gettext;
36use POSIX;
37
38my %opts;
39
40readconfig();
41
42my $version = "3.1.2+johm+chschu+gettext";
43
44# command line overrides .irpg.conf
45GetOptions(\%opts,
46    "help|h",
47    "verbose|v",
48    "ipv6",
49    "lang",
50    "debug",
51    "debugfile=s",
52    "server|s=s",
53    "botnick|n=s",
54    "botuser|u=s",
55    "botrlnm|r=s",
56    "botchan|c=s",
57    "botident|p=s",
58    "botmodes|m=s",
59    "botopcmd|o=s",
60    "localaddr=s",
61    "botghostcmd|g=s",
62    "helpurl=s",
63    "admincommurl=s",
64    "doban",
65    "silentmode=i",
66    "writequestfile",
67    "questfilename=s",
68    "voiceonlogin",
69    "noccodes",
70    "nononp",
71    "mapurl=s",
72    "statuscmd",
73    "pidfile=s",
74    "reconnect",
75    "reconnect_wait=i",
76    "self_clock=i",
77    "modsfile=s",
78    "casematters",
79    "detectsplits",
80    "autologin",
81    "splitwait=i",
82    "allowuserinfo",
83    "noscale",
84    "phonehome",
85    "owner=s",
86    "owneraddonly",
87    "ownerdelonly",
88    "ownerpevalonly",
89    "checkupdates",
90    "senduserlist",
91    "limitpen=i",
92    "mapx=i",
93    "mapy=i",
94    "modesperline=i",
95    "okurl|k=s@",
96    "eventsfile=s",
97    "rpstep=f",
98    "rpbase=i",
99    "rppenstep=f",
100    "dbfile|irpgdb|db|d=s",
101) or debug("Error: Could not parse command line. Try $0 --help\n",1);
102
103$opts{help} and do { help(); exit 0; };
104
105debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);
106
107setlocale(LC_MESSAGES, $opts{lang});
108bindtextdomain("irpg","lang");
109textdomain("irpg");
110
111my $outbytes = 0; # sent bytes
112my $primnick = $opts{botnick}; # for regain or register checks
113my $inbytes = 0; # received bytes
114my %onchan; # users on game channel
115my %rps; # role-players
116my %quest = (
117    questers => [],
118    p1 => [], # point 1 for q2
119    p2 => [], # point 2 for q2
120    qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
121    text => "",
122    type => 1,
123    stage => 1); # quest info
124my %mapitems = (); # items lying around
125
126my $rpreport = 0; # constant for reporting top players
127my $oldrpreport = 0; # constant for reporting top players (last value)
128my %prev_online; # user@hosts online on restart, die
129my %auto_login; # users to automatically log back on
130my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
131my $pausemode = 0; # pausemode on/off flag
132my $silentmode = 0; # silent mode 0/1/2/3, see head of file
133my @queue; # outgoing message queue
134my $lastreg = 0; # holds the time of the last reg. cleared every second.
135                 # prevents more than one account being registered / second
136my $registrations = 0; # count of registrations this period
137my $sel; # IO::Select object
138my $lasttime = 1; # last time that rpcheck() was run
139my $buffer; # buffer for socket stuff
140my $conn_tries = 0; # number of connection tries. gives up after trying each
141                    # server twice
142my $sock; # IO::Socket::INET object
143my %split; # holds nick!user@hosts for clients that have been netsplit
144my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages
145
146sub daemonize(); # prototype to avoid warnings
147
148if (! -e $opts{dbfile}) {
149    $|=1;
150    %rps = ();
151    printf gettext("%s does not appear to exist. I'm guessing this is your ".
152          "first time using IRPG. Please give an account name that you would ".
153          "like to have admin access [%s]: "), $opts{dbfile}, $opts{owner};
154    chomp(my $uname = <STDIN>);
155    $uname =~ s/\s.*//g;
156    $uname = length($uname)?$uname:$opts{owner};
157    print gettext("Enter a character class for this account: ");
158    chomp(my $uclass = <STDIN>);
159    $rps{$uname}{class} = substr($uclass,0,30);
160    print gettext("Enter a password for this account: ");
161    if ($^O ne "MSWin32") {
162        system("stty -echo");
163    }
164    chomp(my $upass = <STDIN>);
165    if ($^O ne "MSWin32") {
166        system("stty echo");
167    }
168    $rps{$uname}{pass} = crypt($upass,mksalt());
169    $rps{$uname}{next} = $opts{rpbase};
170    $rps{$uname}{nick} = "";
171    $rps{$uname}{userhost} = "";
172    $rps{$uname}{level} = 0;
173    $rps{$uname}{online} = 0;
174    $rps{$uname}{idled} = 0;
175    $rps{$uname}{created} = time();
176    $rps{$uname}{lastlogin} = time();
177    $rps{$uname}{x} = int(rand($opts{mapx}));
178    $rps{$uname}{y} = int(rand($opts{mapy}));
179    $rps{$uname}{alignment}="n";
180    $rps{$uname}{isadmin} = 1;
181    for my $item ("ring","amulet","charm","weapon","helm",
182                  "tunic","pair of gloves","shield",
183                  "set of leggings","pair of boots") {
184        $rps{$uname}{item}{$item} = 0;
185    }
186    for my $pen ("pen_mesg","pen_nick","pen_part",
187                 "pen_kick","pen_quit","pen_quest",
188                 "pen_logout","pen_logout") {
189        $rps{$uname}{$pen} = 0;
190    }
191    writedb();
192    printf gettext("OK, wrote you into %s \n"),$opts{dbfile};
193}
194
195# this is almost silly...
196if ($opts{checkupdates}) {
197    print gettext("Checking for updates...\n\n");
198    my $tempsock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80",
199                                         Timeout => 15);
200    if ($tempsock) {
201        print $tempsock "GET /g7/version.php?version=$version HTTP/1.1\r\n".
202                        "Host: jotun.ultrazone.org:80\r\n\r\n";
203        my($line,$newversion);
204        while ($line=<$tempsock>) {
205            chomp($line);
206            next() unless $line;
207            if ($line =~ /^Current version : (\S+)/) {
208                if ($version ne $1) {
209                    print gettext("There is an update available! Changes include:\n");
210                    $newversion=1;
211                }
212                else {
213                    printf gettext("You are running the latest version (v%s).".
214           "\n"), $1;
215                    close($tempsock);
216                    last();
217                }
218            }
219            elsif ($newversion && $line =~ /^(  -? .+)/) { print "$1\n"; }
220            elsif ($newversion && $line =~ /^URL: (.+)/) {
221                printf gettext("\nGet the newest version from %s!\n"), $1;
222                close($tempsock);
223                last();
224            }
225        }
226    }
227    else { print gettext(debug("Could not connect to update server."))."\n"; }
228}
229
230print "\n".gettext(debug("Becoming a daemon..."))."\n";
231daemonize();
232
233$SIG{HUP} = "readconfig"; # sighup = reread config file
234
235CONNECT: # cheese.
236
237loaddb();
238
239while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
240    debug("Connecting to $opts{servers}->[0]...");
241    my %sockinfo = (PeerAddr => $opts{servers}->[0]);
242    if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }
243
244    if ($opts{ipv6}) {
245        $sock = IO::Socket::INET6->new(%sockinfo) or
246            debug("Error: failed to connect: $!\n");
247    }
248    else {
249        $sock = IO::Socket::INET->new(%sockinfo) or
250            debug("Error: failed to connect: $!\n");
251    }
252
253    ++$conn_tries;
254    if (!$sock) {
255        # cycle front server to back if connection failed
256        push(@{$opts{servers}},shift(@{$opts{servers}}));
257    }
258    else { debug("Connected."); }
259}
260
261if (!$sock) {
262    debug("Error: Too many connection failures, exhausted server list.\n",1);
263}
264
265$conn_tries=0;
266
267$sel = IO::Select->new($sock);
268
269sts("NICK $opts{botnick}");
270sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");
271
272while (1) {
273    my($readable) = IO::Select->select($sel,undef,undef,0.5);
274    if (defined($readable)) {
275        my $fh = $readable->[0];
276        my $buffer2;
277        $fh->recv($buffer2,512,0);
278        if (length($buffer2)) {
279            $buffer .= $buffer2;
280            while (index($buffer,"\n") != -1) {
281                my $line = substr($buffer,0,index($buffer,"\n")+1);
282                $buffer = substr($buffer,length($line));
283                parse($line);
284            }
285        }
286        else {
287            # uh oh, we've been disconnected from the server, possibly before
288            # we've logged in the users in %auto_login. so, we'll set those
289            # users' online flags to 1, rewrite db, and attempt to reconnect
290            # (if that's wanted of us)
291            $rps{$_}{online}=1 for keys(%auto_login);
292            writedb();
293
294            close($fh);
295            $sel->remove($fh);
296
297            if ($opts{reconnect}) {
298                undef(@queue);
299                undef($sock);
300                debug("Socket closed; disconnected. Cleared outgoing message ".
301                      "queue. Waiting $opts{reconnect_wait}s before next ".
302                      "connection attempt...");
303                sleep($opts{reconnect_wait});
304                goto CONNECT;
305            }
306            else { debug("Socket closed; disconnected.",1); }
307        }
308    }
309    else { select(undef,undef,undef,1); }
310    if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
311}
312
313
314sub parse {
315    my($in) = shift;
316    $inbytes += length($in); # increase parsed byte count
317    $in =~ s/[\r\n]//g; # strip all \r and \n
318    debug("<- $in");
319    my @arg = split(/\s/,$in); # split into "words"
320    my $usernick = substr((split(/!/,$arg[0]))[0],1);
321    # logged in char name of nickname, or undef if nickname is not online
322    my $username = finduser($usernick);
323    if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
324    elsif (lc($arg[0]) eq 'error') {
325        # uh oh, we've been disconnected from the server, possibly before we've
326        # logged in the users in %auto_login. so, we'll set those users' online
327        # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
328        # us)
329        $rps{$_}{online}=1 for keys(%auto_login);
330        writedb();
331        return;
332    }
333    $arg[1] = lc($arg[1]); # original case no longer matters
334    if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
335        $opts{botnick} .= 0;
336        sts("NICK $opts{botnick}");
337    }
338    elsif ($arg[1] eq 'join') {
339        # %onchan holds time user joined channel. used for the advertisement ban
340        $onchan{$usernick}=time();
341        if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
342            delete($split{substr($arg[0],1)});
343        }
344        elsif ($opts{botnick} eq $usernick) {
345            sts("WHO $opts{botchan}");
346            (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
347            sts($opcmd);
348            $lasttime = time(); # start rpcheck()
349        }
350        elsif ($opts{autologin}) {
351            for my $k (keys %rps) {
352                if (":".$rps{$k}{userhost} eq $arg[0]) {
353                    if ($opts{voiceonlogin}) {         
354                        sts("MODE $opts{botchan} +v :$usernick");
355                    }
356                    $rps{$k}{online} = 1;
357                    $rps{$k}{nick} = $usernick;
358                    $rps{$k}{lastlogin} = time();
359                    chanmsg(sprintf(gettext("%s, the level %u ".
360                                            "%s, is now online from ".
361                                            "nickname %s. Next level in %s."),
362            $k,$rps{$k}{level},$rps{$k}{class},
363            $usernick,duration($rps{$k}{next})));       
364                    notice(sprintf(gettext("Logon successful. Next level in ".
365             "%s."),duration($rps{$k}{next})),
366         $usernick);
367                }
368            }
369        }
370    }
371    elsif ($arg[1] eq 'quit') {
372        # if we see our nick come open, grab it (skipping queue)
373        if ($usernick eq $primnick) { sts("NICK $primnick",1); }
374        elsif ($opts{'detectsplits'} &&
375               "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
376            if (defined($username)) { # user was online
377                $split{substr($arg[0],1)}{time}=time();
378                $split{substr($arg[0],1)}{account}=$username;
379            }
380        }
381        else {
382            penalize($username,"quit");
383        }
384        delete($onchan{$usernick});
385    }
386    elsif ($arg[1] eq 'nick') {
387        # if someone (nickserv) changes our nick for us, update $opts{botnick}
388        if ($usernick eq $opts{botnick}) {
389            $opts{botnick} = substr($arg[2],1);
390        }
391        # if we see our nick come open, grab it (skipping queue), unless it was
392        # us who just lost it
393        elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
394        else {
395            penalize($username,"nick",$arg[2]);
396            $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
397        }
398    }
399    elsif ($arg[1] eq 'part') {
400        penalize($username,"part");
401        delete($onchan{$usernick});
402    }
403    elsif ($arg[1] eq 'kick') {
404        $usernick = $arg[3];
405        penalize(finduser($usernick),"kick");
406        delete($onchan{$usernick});
407    }
408    # don't penalize /notices to the bot
409    elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
410        penalize($username,"notice",length("@arg[3..$#arg]")-1);
411    }
412    elsif ($arg[1] eq '001') {
413        # send our identify command, set our usermode, join channel
414        sts($opts{botident});
415        sts("MODE $opts{botnick} :$opts{botmodes}");
416        sts("JOIN $opts{botchan}");
417        $opts{botchan} =~ s/ .*//; # strip channel key if present
418    }
419    elsif ($arg[1] eq '315') {
420        # 315 is /WHO end. report who we automagically signed online iff it will
421        # print < 1k of text
422        if (keys(%auto_login)) {
423            # not a true measure of size, but easy
424            if (length("%auto_login") < 1024 && $opts{senduserlist}) {
425                chanmsg(sprintf(gettext("%u users matching %u hosts ".
426          "automatically logged in; accounts: "),
427        scalar(keys(%auto_login)),
428        scalar(keys(%prev_online))).
429      join(", ",keys(%auto_login)));
430            }
431            else {
432                chanmsg(sprintf(gettext("%u users matching %u hosts ".
433          "automatically logged in."),
434        scalar(keys(%auto_login)),
435        scalar(keys(%prev_online))));
436            }
437            if ($opts{voiceonlogin}) {
438                my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
439                while (scalar @vnicks >= $opts{modesperline}) {
440                    sts("MODE $opts{botchan} +".
441                        ('v' x $opts{modesperline})." ".
442                        join(" ",@vnicks[0..$opts{modesperline}-1]));
443                    splice(@vnicks,0,$opts{modesperline});
444                }
445                sts("MODE $opts{botchan} +".
446                    ('v' x (scalar @vnicks))." ".
447                    join(" ",@vnicks));
448            }
449        }
450        else { chanmsg(gettext("0 users qualified for auto login.")); }
451        undef(%prev_online);
452        undef(%auto_login);
453        loadquestfile();
454    }
455    elsif ($arg[1] eq '005') {
456        if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
457    }
458    elsif ($arg[1] eq '352') {
459        my $user;
460        # 352 is one line of /WHO. check that the nick!user@host exists as a key
461        # in %prev_online, the list generated in loaddb(). the value is the user
462        # to login
463        $onchan{$arg[7]}=time();
464        if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
465            $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
466            $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
467        }
468    }
469    elsif ($arg[1] eq 'privmsg') {
470        $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
471        if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
472            $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
473            if ($arg[3] eq "\1version\1") {
474                notice("\1VERSION IRPG bot v$version by jotun; ".
475                       "http://idlerpg.net/\1",$usernick);
476            }
477            elsif ($arg[3] eq "peval") {
478                if (!ha($username) || ($opts{ownerpevalonly} &&
479                    $opts{owner} ne $username)) {
480                    privmsg(sprintf(gettext("You don't have access to %s."),
481            "PEVAL"), $usernick);
482                }
483                else {
484                    my @peval = eval "@arg[4..$#arg]";
485                    if (@peval >= 4 || length("@peval") > 1024) {
486                        privmsg("Command produced too much output to send ".
487                                "outright; queueing ".length("@peval").
488                                " bytes in ".scalar(@peval)." items. Use ".
489                                "CLEARQ to clear queue if needed.",$usernick,1);
490                        privmsg($_,$usernick) for @peval;
491                    }
492                    else { privmsg($_,$usernick, 1) for @peval; }
493                    privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
494                }
495            }
496            elsif ($arg[3] eq "register") {
497                if (defined $username) {
498                    privmsg(sprintf(gettext("Sorry, you are already online as ".
499              "%s."), $username), $usernick);
500                }
501                else {
502                    if ($#arg < 6 || $arg[6] eq "") {
503                        privmsg(gettext("Try: REGISTER <char name> <password> ".
504          "<class>"), $usernick);
505                        privmsg(gettext("IE : REGISTER Poseidon MyPassword God ".
506          "of the Sea"), $usernick);
507                    }
508                    elsif ($pausemode) {
509                        privmsg(gettext("Sorry, new accounts may not be ".
510          "registered while the bot is in pause ".
511          "mode; please wait a few minutes and ".
512          "try again."),$usernick);
513                    }
514                    elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
515                           scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
516                        privmsg(gettext("Sorry, that character name is already ".
517          "in use."), $usernick);
518                    }
519                    elsif (lc($arg[4]) eq lc($opts{botnick}) ||
520                           lc($arg[4]) eq lc($primnick)) {
521                        privmsg(gettext("Sorry, that character name cannot be ".
522          "registered."), $usernick);
523                    }
524                    elsif (!exists($onchan{$usernick})) {
525                        privmsg(sprintf(gettext("Sorry, you're not in %s."),
526          $opts{botchan}), $usernick);
527                    }
528                    elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
529                        privmsg(gettext("Sorry, character names must be < 17 ".
530          "and > 0 chars long."), $usernick);
531                    }
532                    elsif ($arg[4] =~ /^#/) {
533                        privmsg(gettext("Sorry, character names may not begin ".
534          "with #."), $usernick);
535                    }
536                    elsif ($arg[4] =~ /\001/) {
537                        privmsg(gettext("Sorry, character names may not include".
538                                " character \\001."),$usernick);
539                    }
540                    elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
541                           "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
542                        privmsg(gettext("Sorry, neither character names nor ".
543          "classes may include control codes."),
544        $usernick);
545                    }
546                    elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
547                           "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
548                        privmsg(gettext("Sorry, neither character names nor ".
549          "classes may include non-printable ".
550          "chars."), $usernick);
551                    }
552                    elsif (length("@arg[6..$#arg]") > 30) {
553                        privmsg(gettext("Sorry, character classes must be < 31".
554          " chars long."), $usernick);
555                    }
556                    elsif (time() == $lastreg) {
557                        privmsg(gettext("Wait 1 second and try again."),
558        $usernick);               
559                    }
560                    else {
561                        if ($opts{voiceonlogin}) {
562                            sts("MODE $opts{botchan} +v :$usernick");
563                        }
564                        ++$registrations;
565                        $lastreg = time();
566                        $rps{$arg[4]}{next} = $opts{rpbase};
567                        $rps{$arg[4]}{class} = "@arg[6..$#arg]";
568                        $rps{$arg[4]}{level} = 0;
569                        $rps{$arg[4]}{online} = 1;
570                        $rps{$arg[4]}{nick} = $usernick;
571                        $rps{$arg[4]}{userhost} = $arg[0];
572                        $rps{$arg[4]}{created} = time();
573                        $rps{$arg[4]}{lastlogin} = time();
574                        $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
575                        $rps{$arg[4]}{x} = int(rand($opts{mapx}));
576                        $rps{$arg[4]}{y} = int(rand($opts{mapy}));
577                        $rps{$arg[4]}{alignment}="n";
578                        $rps{$arg[4]}{isadmin} = 0;
579                        for my $item ("ring","amulet","charm","weapon","helm",
580                                      "tunic","pair of gloves","shield",
581                                      "set of leggings","pair of boots") {
582                            $rps{$arg[4]}{item}{$item} = 0;
583                        }
584                        for my $pen ("pen_mesg","pen_nick","pen_part",
585                                     "pen_kick","pen_quit","pen_quest",
586                                     "pen_logout","pen_logout") {
587                            $rps{$arg[4]}{$pen} = 0;
588                        }
589                        chanmsg(sprintf(gettext("Welcome %s\'s new player %s, ".
590            "the %s! Next level in %s."),
591          $usernick,$arg[4], join(" ",(@arg[6..$#arg])),
592          duration($opts{rpbase})));
593                        privmsg(sprintf(gettext("Success! Account %s created. ".
594            "You have %u seconds idleness ".
595            "until you reach level 1."),
596          $arg[4],$opts{rpbase}), $usernick);
597                        privmsg(gettext("NOTE: The point of the game is to see ".
598          "who can idle the longest. As such, ".
599          "talking in the channel, parting, ".
600          "quitting, and changing nicks all ".
601          "penalize you."),$usernick);
602                        if ($opts{phonehome}) {
603                            my $tempsock = IO::Socket::INET->new(PeerAddr=>
604                                "jotun.ultrazone.org:80");
605                            if ($tempsock) {
606                                print $tempsock
607                                    "GET /g7/count.php?new=1 HTTP/1.1\r\n".
608                                    "Host: jotun.ultrazone.org:80\r\n\r\n";
609                                sleep(1);
610                                close($tempsock);
611                            }
612                        }
613                    }
614                }
615            }
616            elsif ($arg[3] eq "delold") {
617                if (!ha($username)) {
618                    privmsg(sprintf(gettext("You don't have access to %s."),
619            "DELOLD"), $usernick);
620                }
621                # insure it is a number
622                elsif ($arg[4] !~ /^[\d\.]+$/) {
623                    privmsg(gettext("Try: DELOLD <# of days>"), $usernick, 1);
624                }
625                else {
626                    my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
627                                             ($arg[4] * 86400) &&
628                                             !$rps{$_}{online} } keys(%rps);
629                    delete(@rps{@oldaccounts});
630                    chanmsg(sprintf(gettext("%u accounts not accessed in ".
631              "the last %u days removed by %s."),
632            scalar(@oldaccounts),$arg[4],$arg[0]));
633                }
634            }
635            elsif ($arg[3] eq "del") {
636                if (!ha($username)) {
637                    privmsg(sprintf(gettext("You don't have access to %s."),
638            "DEL"), $usernick);
639                }
640                elsif (!defined($arg[4])) {
641                   privmsg(gettext("Try: DEL <char name>"), $usernick, 1);
642                }
643                elsif (!exists($rps{$arg[4]})) {
644                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
645          $usernick, 1);
646                }
647                else {
648                    delete($rps{$arg[4]});
649                    chanmsg(sprintf(gettext("Account %s removed by %s."),
650            $arg[4],$arg[0]));
651                }
652            }
653            elsif ($arg[3] eq "mkadmin") {
654                if (!ha($username) || ($opts{owneraddonly} &&
655                    $opts{owner} ne $username)) {
656                    privmsg(sprintf(gettext("You don't have access to %s."),
657            "MKADMIN"), $usernick);
658                }
659                elsif (!defined($arg[4])) {
660                    privmsg(gettext("Try: MKADMIN <char name>"), $usernick, 1);
661                }
662                elsif (!exists($rps{$arg[4]})) {
663                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
664          $usernick, 1);
665                }
666                else {
667                    $rps{$arg[4]}{isadmin}=1;
668                    privmsg(sprintf(gettext("Account %s is now a bot admin."),
669            $arg[4]),$usernick, 1);
670                }
671            }
672            elsif ($arg[3] eq "deladmin") {
673                if (!ha($username) || ($opts{ownerdelonly} &&
674                    $opts{owner} ne $username)) {
675                    privmsg(sprintf(gettext("You don't have access to %s."),
676          "DELADMIN"), $usernick);
677                }
678                elsif (!defined($arg[4])) {
679                    privmsg(gettext("Try: DELADMIN <char name>"), $usernick, 1);
680                }
681                elsif (!exists($rps{$arg[4]})) {
682                    privmsg(sprintf(gettext("No such account %s."),$arg[4]),
683          $usernick, 1);
684                }
685                elsif ($arg[4] eq $opts{owner}) {
686                    privmsg(gettext("Cannot DELADMIN owner account."),
687          $usernick, 1);
688                }
689                else {
690                    $rps{$arg[4]}{isadmin}=0;
691                    privmsg(sprintf(gettext("Account %s is no longer a bot ".
692              "admin."),$arg[4]), $usernick, 1);
693                }
694            }
695            elsif ($arg[3] eq "hog") {
696                if (!ha($username)) {
697                    privmsg(sprintf(gettext("You don't have access to %s."),
698            "HOG"), $usernick);
699                }
700                else {
701                    chanmsg(sprintf(gettext("%s has summoned the Hand of God."),
702            $usernick));
703                    hog();
704                }
705            }
706            elsif ($arg[3] eq "rehash") {
707                if (!ha($username)) {
708                    privmsg(sprintf(gettext("You don't have access to %s."),
709          "REHASH"), $usernick);
710                }
711                else {
712                    readconfig();
713                    privmsg(gettext("Reread config file."),$usernick,1);
714                    $opts{botchan} =~ s/ .*//; # strip channel key if present
715                }
716            }
717            elsif ($arg[3] eq "chpass") {
718                if (!ha($username)) {
719                    privmsg(sprintf(gettext("You don't have access to %s."),
720          "CHPASS"), $usernick);
721                }
722                elsif (!defined($arg[5])) {
723                    privmsg(gettext("Try: CHPASS <char name> <new pass>"),
724          $usernick, 1);
725                }
726                elsif (!exists($rps{$arg[4]})) {
727                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
728          $usernick, 1);
729                }
730                else {
731                    $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
732                    privmsg(sprintf(gettext("Password for %s changed."),
733            $arg[4]), $usernick, 1);
734                }
735            }
736            elsif ($arg[3] eq "chuser") {
737                if (!ha($username)) {
738                    privmsg(sprintf(gettext("You don't have access to %s."),
739          "CHUSER"), $usernick);
740                }
741                elsif (!defined($arg[5])) {
742                    privmsg(gettext("Try: CHUSER <char name> <new char name>"),
743                            $usernick, 1);
744                }
745                elsif (!exists($rps{$arg[4]})) {
746                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
747          $usernick, 1);
748                }
749                elsif (exists($rps{$arg[5]})) {
750                    privmsg(sprintf(gettext("Username %s is already taken."),
751            $arg[5]), $usernick,1);
752                }
753                else {
754                    $rps{$arg[5]} = delete($rps{$arg[4]});
755                    privmsg(sprintf(gettext("Username for %s changed to %s."),
756              $arg[4],$arg[5]), $usernick, 1);
757                }
758            }
759            elsif ($arg[3] eq "chclass") {
760                if (!ha($username)) {
761                    privmsg(sprintf(gettext("You don't have access to %s."),
762          "CHCLASS"), $usernick);
763                }
764                elsif (!defined($arg[5])) {
765                    privmsg(gettext("Try: CHCLASS <char name> <new char class>"),
766                            $usernick, 1);
767                }
768                elsif (!exists($rps{$arg[4]})) {
769                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
770          $usernick, 1);
771                }
772                else {
773                    $rps{$arg[4]}{class} = "@arg[5..$#arg]";
774                    privmsg(sprintf(gettext("Class for %s changed to %s."),
775            $arg[4],join(" ",(@arg[5..$#arg]))), $usernick, 1);
776                }
777            }
778            elsif ($arg[3] eq "push") {
779                if (!ha($username)) {
780                    privmsg(sprintf(gettext("You don't have access to %s."),
781          "PUSH"), $usernick);
782                }
783                # insure it's a positive or negative, integral number of seconds
784                elsif ($arg[5] !~ /^\-?\d+$/) {
785                    privmsg(gettext("Try: PUSH <char name> <seconds>"),
786          $usernick, 1);
787                }
788                elsif (!exists($rps{$arg[4]})) {
789                    privmsg(sprintf(gettext("No such username %s."),$arg[4]),
790          $usernick, 1);
791                }
792                elsif ($arg[5] > $rps{$arg[4]}{next}) {
793                    privmsg(sprintf(gettext("Time to level for %s (%u s) is ".
794              "lower than %d; setting TTL to 0."),
795            $arg[4],$rps{$arg[4]}{next},$arg[5]),
796                            $usernick, 1);
797                    chanmsg(sprintf(gettext("%s has pushed %s %d seconds ".
798              "toward level %u"),
799            $usernick,$arg[4],$rps{$arg[4]}{next},
800            ($rps{$arg[4]}{level}+1)));
801                    $rps{$arg[4]}{next}=0;
802                }
803                else {
804                    $rps{$arg[4]}{next} -= $arg[5];
805                     chanmsg(sprintf(gettext("%s has pushed %s %d seconds ".
806               "toward level %u. %2\$s reaches ".
807               "next level in %5\$s."),
808             $usernick,$arg[4],$arg[5],
809             ($rps{$arg[4]}{level}+1),
810             duration($rps{$arg[4]}{next})));
811                }
812            }   
813            elsif ($arg[3] eq "logout") {
814                if (defined($username)) {
815                    penalize($username,"logout");
816                }
817                else {
818                    privmsg(gettext("You are not logged in."), $usernick);
819                }
820            }
821            elsif ($arg[3] eq "quest") {
822                if (!@{$quest{questers}}) {
823                    privmsg(gettext("There is no active quest."),$usernick);
824                }
825                elsif ($quest{type} == 1) {
826                    privmsg(sprintf(gettext("%s, and %s are on a quest to %s".
827              ". Quest to complete in %s."),
828            join(", ",(@{$quest{questers}})[0..2]),
829            $quest{questers}->[3],$quest{text},
830            duration($quest{qtime}-time()))
831                            ,$usernick);
832                }
833                elsif ($quest{type} == 2) {
834                    privmsg(sprintf(gettext("%s, and %s are on a quest to ".
835              "%s. Participants must first reach ".
836              "[%u,%u], then [%u,%u]."),
837            join(", ",(@{$quest{questers}})[0..2]),
838            $quest{questers}->[3],$quest{text},
839            $quest{p1}->[0],$quest{p1}->[1],
840            $quest{p2}->[0],$quest{p2}->[1]).
841                            ($opts{mapurl}?sprintf(gettext(" See %s to monitor ".
842                 "their journey's ".
843                 "progress."),
844               $opts{mapurl}):""),$usernick);
845                }
846            }
847            elsif ($arg[3] eq "status" && $opts{statuscmd}) {
848                if (!defined($username)) {
849                    privmsg(gettext("You are not logged in."), $usernick);
850                }
851                # argument is optional
852                elsif ($arg[4] && !exists($rps{$arg[4]})) {
853                    privmsg(gettext("No such user."),$usernick);
854                }
855                elsif ($arg[4]) { # optional 'user' argument
856                    privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
857                            "$rps{$arg[4]}{class}; Status: O".
858                            ($rps{$arg[4]}{online}?"n":"ff")."line; ".
859                            "TTL: ".duration($rps{$arg[4]}{next})."; ".
860                            "Idled: ".duration($rps{$arg[4]}{idled}).
861                            "; Item sum: ".itemsum($arg[4]),$usernick);
862                }
863                else { # no argument, look up this user
864                    privmsg("$username: Level $rps{$username}{level} ".
865                            "$rps{$username}{class}; Status: O".
866                            ($rps{$username}{online}?"n":"ff")."line; ".
867                            "TTL: ".duration($rps{$username}{next})."; ".
868                            "Idled: ".duration($rps{$username}{idled})."; ".
869                            "Item sum: ".itemsum($username),$usernick);
870                }
871            }
872            elsif ($arg[3] eq "whoami") {
873                if (!defined($username)) {
874                    privmsg(gettext("You are not logged in."), $usernick);
875                }
876                else {
877                    privmsg(sprintf(gettext("You are %s, the level %u %s. ".
878              "Next level in %s"),
879            $username,$rps{$username}{level},
880            $rps{$username}{class},
881            duration($rps{$username}{next})), $usernick);
882                }
883            }
884            elsif ($arg[3] eq "newpass") {
885                if (!defined($username)) {
886                    privmsg(gettext("You are not logged in."), $usernick)
887                }
888                elsif (!defined($arg[4])) {
889                    privmsg(gettext("Try: NEWPASS <new password>"), $usernick);
890                }
891                else {
892                    $rps{$username}{pass} = crypt($arg[4],mksalt());
893                    privmsg(gettext("Your password was changed."),$usernick);
894                }
895            }
896            elsif ($arg[3] eq "align") {
897                if (!defined($username)) {
898                    privmsg(gettext("You are not logged in."), $usernick)
899                }
900                elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" && 
901                       lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
902                    privmsg(gettext("Try: ALIGN <good|neutral|evil>"),
903          $usernick);
904                }
905                else {
906                    $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
907                    chanmsg(sprintf(gettext("%s has changed alignment to: "),
908            $username).gettext(lc($arg[4])).".");
909                    privmsg(gettext("Your alignment was changed to ").
910          gettext(lc($arg[4])).".", $usernick);
911                }
912            }
913            elsif ($arg[3] eq "removeme") {
914                if (!defined($username)) {
915                    privmsg(gettext("You are not logged in."), $usernick)
916                }
917                else {
918                    privmsg(sprintf(gettext("Account %s removed."),$username),
919          $usernick);
920                    chanmsg(sprintf(gettext("%s removed his account, %s, the %s".
921              "."),
922            $arg[0],$username,$rps{$username}{class}));
923                    delete($rps{$username});
924                }
925            }
926            elsif ($arg[3] eq "help") {
927                if (!ha($username)) {
928                    privmsg(sprintf(gettext("For information on IRPG bot ".
929              "commands, see %s"), $opts{helpurl}),
930          $usernick);
931                }
932                else {
933                    privmsg(sprintf(gettext("Help URL is %s"),$opts{helpurl}),
934          $usernick, 1);
935                    privmsg(sprintf(gettext("Admin commands URL is %s"),
936            $opts{admincommurl}), $usernick, 1);
937                }
938            }
939            elsif ($arg[3] eq "die") {
940                if (!ha($username)) {
941                    privmsg(sprintf(gettext("You do not have access to %s."),
942            "DIE"), $usernick);
943                }
944                else {
945                    $opts{reconnect} = 0;
946                    writedb();
947                    sts(sprintf(gettext("QUIT :DIE from %s"),$arg[0]),1);
948                }
949            }
950            elsif ($arg[3] eq "reloaddb") {
951                if (!ha($username)) {
952                    privmsg(sprintf(gettext("You do not have access to %s."),
953            "RELOADDB"), $usernick);
954                }
955                elsif (!$pausemode) {
956                    privmsg(gettext("ERROR: Can only use LOADDB while in ".
957            "PAUSE mode."), $usernick, 1);
958                }
959                else {
960                    loaddb();
961                    privmsg(sprintf(gettext("Reread player database file; %u ".
962              "accounts loaded."),
963            scalar(keys(%rps))), $usernick,1);
964                }
965            }
966            elsif ($arg[3] eq "backup") {
967                if (!ha($username)) {
968                    privmsg(sprintf(gettext("You do not have access to %s."),
969            "BACKUP"), $usernick);
970                }
971                else {
972                    backup();
973                    privmsg(sprintf(gettext("%s copied to .dbbackup/%s"),
974            $opts{dbfile},$opts{dbfile}.time()),
975          $usernick,1);
976                }
977            }
978            elsif ($arg[3] eq "pause") {
979                if (!ha($username)) {
980                    privmsg(sprintf(gettext("You do not have access to %s."),
981            "PAUSE"), $usernick);
982                }
983                else {
984                    $pausemode = $pausemode ? 0 : 1;
985                    privmsg(sprintf(gettext("PAUSE_MODE set to %s."),$pausemode),
986          $usernick,1);
987                }
988            }
989            elsif ($arg[3] eq "silent") {
990                if (!ha($username)) {
991                    privmsg(sprintf(gettext("You do not have access to %s."),
992            "SILENT"), $usernick);
993                }
994                elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
995                    privmsg(gettext("Try: SILENT <mode>"), $usernick,1);
996                }
997                else {
998                    $silentmode = $arg[4];
999                    privmsg(sprintf(gettext("SILENT_MODE set to %s."),
1000            $silentmode), $usernick,1);
1001                }
1002            }
1003            elsif ($arg[3] eq "jump") {
1004                if (!ha($username)) {
1005                    privmsg(sprintf(gettext("You do not have access to %s."),
1006            "JUMP"), $usernick);
1007                }
1008                elsif (!defined($arg[4])) {
1009                    privmsg(gettext("Try: JUMP <server[:port]>"), $usernick, 1);
1010                }
1011                else {
1012                    writedb();
1013                    sts(sprintf(gettext("QUIT :JUMP to %s from %s"),
1014        $arg[4],$arg[0]));
1015                    unshift(@{$opts{servers}},$arg[4]);
1016                    close($sock);
1017                    sleep(3);
1018                    goto CONNECT;
1019                }
1020            }
1021            elsif ($arg[3] eq "restart") {
1022                if (!ha($username)) {
1023                    privmsg(sprintf(gettext("You do not have access to %s."),
1024            "RESTART"), $usernick);
1025                }
1026                else {
1027                    writedb();
1028                    sts(sprintf(gettext("QUIT :RESTART from %s"),$arg[0]),1);
1029                    close($sock);
1030                    exec("perl $0");
1031                }
1032            }
1033            elsif ($arg[3] eq "clearq") {
1034                if (!ha($username)) {
1035                    privmsg(sprintf(gettext("You do not have access to %s."),
1036            "CLEARQ"), $usernick);
1037                }
1038                else {
1039                    undef(@queue);
1040                    chanmsg(sprintf(gettext("Outgoing message queue cleared by ".
1041              "%s."),$arg[0]));
1042                    privmsg(gettext("Outgoing message queue cleared."),
1043          $usernick,1);
1044                }
1045            }
1046            elsif ($arg[3] eq "info") {
1047                my $info;
1048                if (!ha($username) && $opts{allowuserinfo}) {
1049                    $info = sprintf(gettext("IRPG bot v%s by jotun, ".
1050              "http://idlerpg.net/. On via ".
1051              "server: %s. Admins online: %s."),
1052            $version,$opts{servers}->[0],
1053            join(", ", map { $rps{$_}{nick} }
1054           grep { $rps{$_}{isadmin} &&
1055            $rps{$_}{online} } keys(%rps)));
1056                    privmsg($info, $usernick);
1057                }
1058                elsif (!ha($username) && !$opts{allowuserinfo}) {
1059                    privmsg(sprintf(gettext("You do not have access to %s."),
1060            "INFO"), $usernick);
1061                }
1062                else {
1063                    my $queuedbytes = 0;
1064                    $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
1065                    $info = sprintf(gettext(
1066                        "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
1067                        "online of %d total users. %d accounts created since ".
1068                        "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
1069                        "Outgoing queue is %d bytes in %d items. On via: %s. ".
1070                        "Admins online: %s."),
1071                        $outbytes/1024,
1072                        $inbytes/1024,
1073                        duration(time()-$^T),
1074                        scalar(grep { $rps{$_}{online} } keys(%rps)),
1075                        scalar(keys(%rps)),
1076                        $registrations,
1077                        $pausemode,
1078                        $silentmode,
1079                        $queuedbytes,
1080                        scalar(@queue),
1081                        $opts{servers}->[0],
1082                        join(", ",map { $rps{$_}{nick} }
1083                                  grep { $rps{$_}{isadmin} && $rps{$_}{online} }
1084                                  keys(%rps)));
1085                    privmsg($info, $usernick, 1);
1086                }
1087            }
1088            elsif ($arg[3] eq "login") {
1089                if (defined($username)) {
1090                    notice(sprintf(gettext("Sorry, you are already online as ".
1091             "%s."),$username), $usernick);
1092                }
1093                else {
1094                    if ($#arg < 5 || $arg[5] eq "") {
1095                        notice(gettext("Try: LOGIN <username> <password>"),
1096             $usernick);
1097                    }
1098                    elsif (!exists $rps{$arg[4]}) {
1099                        notice(gettext("Sorry, no such account name. Note that ".
1100               "account names are case sensitive."),
1101             $usernick);
1102                    }
1103                    elsif (!exists $onchan{$usernick}) {
1104                        notice(sprintf(gettext("Sorry, you're not in %s."),
1105               $opts{botchan}), $usernick);
1106                    }
1107                    elsif ($rps{$arg[4]}{pass} ne
1108                           crypt($arg[5],$rps{$arg[4]}{pass})) {
1109                        notice(gettext("Wrong password."), $usernick);
1110                    }
1111                    else {
1112                        if ($opts{voiceonlogin}) {
1113                            sts("MODE $opts{botchan} +v :$usernick");
1114                        }
1115                        $rps{$arg[4]}{online} = 1;
1116                        $rps{$arg[4]}{nick} = $usernick;
1117                        $rps{$arg[4]}{userhost} = $arg[0];
1118                        $rps{$arg[4]}{lastlogin} = time();
1119                        chanmsg(sprintf(gettext("%s, the level %u %s, is now ".
1120            "online from nickname %s. Next ".
1121            "level in %s."),
1122          $arg[4],$rps{$arg[4]}{level},
1123          $rps{$arg[4]}{class},$usernick,
1124          duration($rps{$arg[4]}{next})));
1125                        notice(gettext("Logon successful. Next level in ").
1126                               duration($rps{$arg[4]}{next}).".", $usernick);
1127                    }
1128                }
1129            }
1130        }
1131        # penalize returns true if user was online and successfully penalized.
1132        # if the user is not logged in, then penalize() fails. so, if user is
1133        # offline, and they say something including "http:", and they've been on
1134        # the channel less than 90 seconds, and the http:-style ban is on, then
1135        # check to see if their url is in @{$opts{okurl}}. if not, kickban them
1136        elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
1137               index(lc("@arg[3..$#arg]"),"http:") != -1 &&
1138               (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
1139            my $isokurl = 0;
1140            for (@{$opts{okurl}}) {
1141                if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
1142            }
1143            if (!$isokurl) {
1144                sts("MODE $opts{botchan} +b $arg[0]");
1145                sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
1146                    "be lifted within the hour.");
1147                push(@bans,$arg[0]) if @bans < 12;
1148            }
1149        }
1150    }
1151}
1152
1153sub sts { # send to server
1154    my($text,$skipq) = @_;
1155    if ($skipq) {
1156        if ($sock) {
1157            print $sock "$text\r\n";
1158            $outbytes += length($text) + 2;
1159            debug("-> $text");
1160        }
1161        else {
1162            # something is wrong. the socket is closed. clear the queue
1163            undef(@queue);
1164            debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
1165            return;
1166        }
1167    }
1168    else {
1169        push(@queue,$text);
1170        debug(sprintf("(q%03d) = %s\n",$#queue,$text));
1171    }
1172}
1173
1174sub fq { # deliver message(s) from queue
1175    if (!@queue) {
1176        ++$freemessages if $freemessages < 4;
1177        return undef;
1178    }
1179    my $sentbytes = 0;
1180    for (0..$freemessages) {
1181        last() if !@queue; # no messages left to send
1182        # lower number of "free" messages we have left
1183        my $line=shift(@queue);
1184        # if we have already sent one message, and the next message to be sent
1185        # plus the previous messages we have sent this call to fq() > 768 bytes,
1186        # then requeue this message and return. we don't want to flood off,
1187        # after all
1188        if ($_ != 0 && (length($line)+$sentbytes) > 768) {
1189            unshift(@queue,$line);
1190            last();
1191        }
1192        if ($sock) {
1193            debug("(fm$freemessages) -> $line");
1194            --$freemessages if $freemessages > 0;
1195            print $sock "$line\r\n";
1196            $sentbytes += length($line) + 2;
1197        }
1198        else {
1199            undef(@queue);
1200            debug("Disconnected: cleared outgoing message queue.");
1201            last();
1202        }
1203        $outbytes += length($line) + 2;
1204    }
1205}
1206
1207sub ttl { # return ttl
1208    my $lvl = shift;
1209    return ($opts{rpbase} * ($opts{rpstep}**$lvl)) if $lvl <= 60;
1210    return (($opts{rpbase} * ($opts{rpstep}**60))
1211             + (86400*($lvl - 60)));
1212}
1213
1214sub penttl { # return ttl with $opts{rppenstep}
1215    my $lvl = shift;
1216    return ($opts{rpbase} * ($opts{rppenstep}**$lvl)) if $lvl <= 60;
1217    return (($opts{rpbase} * ($opts{rppenstep}**60))
1218             + (86400*($lvl - 60)));
1219}
1220
1221sub duration { # return human duration of seconds
1222    my $s = shift;
1223    return "NA ($s)" if $s !~ /^\d+$/;
1224    return sprintf(ngettext("%d day, %02d:%02d:%02d",
1225          "%d days, %02d:%02d:%02d",int($s/86400)),
1226       $s/86400,($s%86400)/3600,($s%3600)/60,($s%60));
1227}
1228
1229sub ts { # timestamp
1230    my @ts = localtime(time());
1231    return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
1232                   $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
1233}
1234
1235sub hog { # summon the hand of god
1236    my @players = grep { $rps{$_}{online} } keys(%rps);
1237    my $player = $players[rand(@players)];
1238    my $win = int(rand(5));
1239    my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
1240    if ($win) {
1241        chanmsg(clog(sprintf(gettext("Verily I say unto thee, the Heavens have ".
1242             "burst forth, and the blessed hand of God ".
1243             "carried %s %s toward level %u."),
1244           $player,duration($time),($rps{$player}{level}+1))));
1245        $rps{$player}{next} -= $time;
1246    }
1247    else {
1248        chanmsg(clog(sprintf(gettext("Thereupon He stretched out His little ".
1249             "finger among them and consumed %s with ".
1250             "fire, slowing the heathen %s from level ".
1251             "%u."),
1252           $player,duration($time),($rps{$player}{level}+1))));
1253        $rps{$player}{next} += $time;
1254    }
1255    chanmsg(sprintf(gettext("%s reaches next level in %s."),
1256        $player,duration($rps{$player}{next})));
1257}
1258
1259sub rpcheck { # check levels, update database
1260    # check splits hash to see if any split users have expired
1261    checksplits() if $opts{detectsplits};
1262    # send out $freemessages lines of text from the outgoing message queue
1263    fq();
1264    # clear registration limiting
1265    $lastreg = 0;
1266    my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
1267    # there's really nothing to do here if there are no online users
1268    return unless $online;
1269    my $onlineevil = scalar(grep { $rps{$_}{online} &&
1270                                   $rps{$_}{alignment} eq "e" } keys(%rps));
1271    my $onlinegood = scalar(grep { $rps{$_}{online} &&
1272                                   $rps{$_}{alignment} eq "g" } keys(%rps));
1273    if (!$opts{noscale}) {
1274        if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
1275        if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
1276        if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
1277        if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
1278    }
1279    else {
1280        hog() if rand(4000) < 1;
1281        team_battle() if rand(4000) < 1;
1282        calamity() if rand(4000) < 1;
1283        godsend() if rand(2000) < 1;
1284    }
1285    if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
1286    if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
1287    if (rand((10*86400)/$opts{self_clock}) < 1) { war(); }
1288
1289    moveplayers();
1290    process_items();
1291   
1292    # statements using $rpreport do not bother with scaling by the clock because
1293    # $rpreport is adjusted by the number of seconds since last rpcheck()
1294    if (($rpreport%120 < $oldrpreport%120) && $opts{writequestfile}) { writequestfile(); }
1295    if (time() > $quest{qtime}) {
1296        if (!@{$quest{questers}}) { quest(); }
1297        elsif ($quest{type} == 1) {
1298            chanmsg(clog(sprintf(gettext("%s, and %s have blessed the realm by ".
1299           "completing their quest! 25%% of their ".
1300           "burden is eliminated."),
1301         join(", ",(@{$quest{questers}})[0..2]),
1302         $quest{questers}->[3])));
1303            for (@{$quest{questers}}) {
1304                $rps{$_}{next} = int($rps{$_}{next} * .75);
1305            }
1306            undef(@{$quest{questers}});
1307            $quest{qtime} = time() + 21600;
1308            writequestfile();
1309        }
1310        # quest type 2 awards are handled in moveplayers()
1311    }
1312    if ($rpreport && ($rpreport%36000 < $oldrpreport%36000)) { # 10 hours
1313        my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
1314                       $rps{$a}{next}  <=> $rps{$b}{next} } keys(%rps);
1315        chanmsg(gettext("Idle RPG Top Players:")) if @u;
1316        for my $i (0..2) {
1317            $#u >= $i and
1318            chanmsg(sprintf(gettext("%s, the level %u %s, is #%u! Next level in".
1319            " %s."),
1320          $u[$i],$rps{$u[$i]}{level},
1321          $rps{$u[$i]}{class},($i + 1),
1322          (duration($rps{$u[$i]}{next}))));
1323        }
1324        backup();
1325    }
1326    if (($rpreport%3600 < $oldrpreport%3600) && $rpreport) { # 1 hour
1327        my @players = grep { $rps{$_}{online} &&
1328                             $rps{$_}{level} > 44 } keys(%rps);
1329        # 20% of all players must be level 45+
1330        if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
1331            challenge_opp($players[int(rand(@players))]);
1332        }
1333        while (@bans) {
1334            sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
1335            splice(@bans,0,4);
1336        }
1337    }
1338    if ($rpreport%1800 < $oldrpreport%1800) { # 30 mins
1339        if ($opts{botnick} ne $primnick) {
1340            sts($opts{botghostcmd}) if $opts{botghostcmd};
1341            sts("NICK $primnick");
1342        }
1343    }
1344    if (($rpreport%600 < $oldrpreport%600) && $pausemode) { # warn every 10m
1345        chanmsg(gettext("WARNING: Cannot write database in PAUSE mode!"));
1346    }
1347    # do not write in pause mode, and do not write if not yet connected. (would
1348    # log everyone out if the bot failed to connect. $lasttime = time() on
1349    # successful join to $opts{botchan}, initial value is 1). if fails to open
1350    # $opts{dbfile}, will not update $lasttime and so should have correct values
1351    # on next rpcheck().
1352    if ($lasttime != 1) {
1353        my $curtime=time();
1354        for my $k (keys(%rps)) {
1355            if ($rps{$k}{online} && exists $rps{$k}{nick} &&
1356                $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
1357                $rps{$k}{next} -= ($curtime - $lasttime);
1358                $rps{$k}{idled} += ($curtime - $lasttime);
1359                if ($rps{$k}{next} < 1) {
1360                    my $ttl = int(ttl($rps{$k}{level}));
1361                    $rps{$k}{level}++;
1362                    $rps{$k}{next} += $ttl;
1363                    chanmsg(sprintf(gettext("%s, the %s, has attained level ".
1364              "%u! Next level in %s."),
1365            $k,$rps{$k}{class},$rps{$k}{level},
1366            duration($ttl)));
1367                    find_item($k);
1368                    challenge_opp($k);
1369                }
1370            }
1371            # attempt to make sure this is an actual user, and not just an
1372            # artifact of a bad PEVAL
1373        }
1374        if (!$pausemode && ($rpreport%60 < $oldrpreport%60)) { writedb(); }
1375        $oldrpreport = $rpreport;
1376        $rpreport += $curtime - $lasttime;
1377        $lasttime = $curtime;
1378    }
1379}
1380
1381sub war { # let the four quadrants battle
1382    my @players = grep { $rps{$_}{online} } keys(%rps);
1383    my @quadrantname = ("Northeast", "Southeast", "Southwest", "Northwest");
1384    my %quadrant = ();
1385    my @sum = (0,0,0,0,0);
1386    # get quadrant for each player and item sum per quadrant
1387    for my $k (@players) {
1388        # "quadrant" 4 is for players in the middle
1389        $quadrant{$k} = 4;
1390        if (2 * $rps{$k}{y} + 1 < $opts{mapy}) {
1391            $quadrant{$k} = 3 if (2 * $rps{$k}{x} + 1 < $opts{mapx});
1392            $quadrant{$k} = 0 if (2 * $rps{$k}{x} + 1 > $opts{mapx});
1393        }
1394        elsif (2 * $rps{$k}{y} + 1 > $opts{mapy})
1395        {
1396            $quadrant{$k} = 2 if (2 * $rps{$k}{x} + 1 < $opts{mapx});
1397            $quadrant{$k} = 1 if (2 * $rps{$k}{x} + 1 > $opts{mapx});
1398        }
1399        $sum[$quadrant{$k}] += itemsum($k);
1400    }
1401    # roll for each quadrant
1402    my @roll = (0,0,0,0);
1403    $roll[$_] = int(rand($sum[$_])) foreach (0..3);
1404    # winner if value >= maximum value of both direct neighbors, "quadrant" 4 never wins
1405    my @iswinner = map($_ < 4 && $roll[$_] >= $roll[($_ + 1) % 4] &&
1406                                 $roll[$_] >= $roll[($_ + 3) % 4],(0..4));
1407    my @winners = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep($iswinner[$_],(0..3)));
1408    # construct text from winners array
1409    my $winnertext = "";
1410    $winnertext = pop(@winners) if (scalar(@winners) > 0);
1411    $winnertext = pop(@winners)." and $winnertext" if (scalar(@winners) > 0);
1412    $winnertext = pop(@winners).", $winnertext" while (scalar(@winners) > 0);
1413    $winnertext = "has shown the power of $winnertext" if ($winnertext ne "");
1414    # loser if value < minimum value of both direct neighbors, "quadrant" 4 never loses
1415    my @isloser = map($_ < 4 && $roll[$_] < $roll[($_ + 1) % 4] &&
1416                                $roll[$_] < $roll[($_ + 3) % 4],(0..4));
1417    my @losers = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep($isloser[$_],(0..3)));
1418    # construct text from losers array
1419    my $losertext = "";
1420    $losertext = pop(@losers) if (scalar(@losers) > 0);
1421    $losertext = pop(@losers)." and $losertext" if (scalar(@losers) > 0);
1422    $losertext = pop(@losers).", $losertext" while (scalar(@losers) > 0);
1423    $losertext = "led $losertext to perdition" if ($losertext ne "");
1424    # build array of text for neutrals
1425    my @neutrals = map("the $quadrantname[$_] [$roll[$_]/$sum[$_]]",grep(!$iswinner[$_] && !$isloser[$_],(0..3)));
1426    # construct text from neutrals array
1427    my $neutraltext = "";
1428    $neutraltext = pop(@neutrals) if (scalar(@neutrals) > 0);
1429    $neutraltext = pop(@neutrals)." and $neutraltext" if (scalar(@neutrals) > 0);
1430    $neutraltext = pop(@neutrals).", $neutraltext" while (scalar(@neutrals) > 0);
1431    $neutraltext = " The diplomacy of $neutraltext was admirable." if ($neutraltext ne "");
1432    if ($winnertext ne "" && $losertext ne "") {
1433        # there are winners and losers
1434        chanmsg(clog("The war between the four parts of the realm ".
1435                     "$winnertext, whereas it $losertext.$neutraltext"));
1436    }
1437    elsif ($winnertext eq "" && $losertext eq "") {
1438        # there are only neutrals
1439        chanmsg(clog("The war between the four parts of the realm ".
1440                     "was well-balanced.$neutraltext"));
1441    }
1442    else {
1443        # there are either winners or losers
1444        chanmsg(clog("The war between the four parts of the realm ".
1445                     "$winnertext$losertext.$neutraltext"));
1446    }
1447    for my $k (@players) {
1448        # halve ttl of users in winning quadrant
1449        # users in "quadrant" 4 are not awarded or penalized
1450        $rps{$k}{next} = int($rps{$k}{next} / 2) if ($iswinner[$quadrant{$k}]);
1451        # double ttl of users in losing quadrant
1452        $rps{$k}{next} *= 2 if ($isloser[$quadrant{$k}]);
1453    }
1454}
1455
1456sub challenge_opp { # pit argument player against random player
1457    my $u = shift;
1458    if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
1459    my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
1460    return unless @opps;
1461    my $opp = $opps[int(rand(@opps))];
1462    $opp = $primnick if rand(@opps+1) < 1;
1463    my $mysum = itemsum($u,1);
1464    my $oppsum = itemsum($opp,1);
1465    my $myroll = int(rand($mysum));
1466    my $opproll = int(rand($oppsum));
1467    if ($myroll >= $opproll) {
1468        my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
1469        $gain = 7 if $gain < 7;
1470        $gain = int(($gain/100)*$rps{$u}{next});
1471        chanmsg(clog(sprintf(gettext("%s [%u/%u] has challenged %s [%u/%u] in ".
1472             "combat and won! %s is removed from ".
1473             "%1\$s\'s clock."),
1474           $u,$myroll,$mysum,$opp,$opproll,$oppsum,
1475           duration($gain))));
1476        $rps{$u}{next} -= $gain;
1477        chanmsg(sprintf(gettext("%s reaches next level in %s."),
1478      $u,duration($rps{$u}{next})));
1479        my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
1480                       $rps{$u}{alignment} eq "e" ? 20 :
1481                       35;
1482        if (rand($csfactor) < 1 && $opp ne $primnick) {
1483            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1484            chanmsg(clog(sprintf(gettext("%s has dealt %s a Critical Strike! %s".
1485           " is added to %2\$s\'s clock."),
1486         $u,$opp,duration($gain))));
1487            $rps{$opp}{next} += $gain;
1488            chanmsg(sprintf(gettext("%s reaches next level in %s."),
1489          $opp,duration($rps{$opp}{next})));
1490        }
1491        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
1492            my @items = ("ring","amulet","charm","weapon","helm","tunic",
1493                         "pair of gloves","set of leggings","shield",
1494                         "pair of boots");
1495            my $type = $items[rand(@items)];
1496            if (itemlevel($rps{$opp}{item}{$type}) > itemlevel($rps{$u}{item}{$type})) {
1497                chanmsg(clog(sprintf(gettext("In the fierce battle, %s dropped ".
1498               "his level %u %s! %s picks it up, ".
1499               "tossing his old level %u %3\$s to".
1500               " %1\$s."),
1501             $opp,itemlevel($rps{$opp}{item}{$type}),
1502             gettext($type),$u,
1503             itemlevel($rps{$u}{item}{$type}))));
1504                my $tempitem = $rps{$u}{item}{$type};
1505                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
1506                $rps{$opp}{item}{$type} = $tempitem;
1507            }
1508        }
1509    }
1510    else {
1511        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
1512        $gain = 7 if $gain < 7;
1513        $gain = int(($gain/100)*$rps{$u}{next});
1514        chanmsg(clog(sprintf(gettext("%s [%u/%u] has challenged %s [%u/%u] in ".
1515             "combat and lost! %s is added to %1\$s\'s ".
1516             "clock."),$u,$myroll,$mysum,$opp,$opproll,
1517           $oppsum,duration($gain))));
1518        $rps{$u}{next} += $gain;
1519        chanmsg(sprintf(gettext("%s reaches next level in %s."),
1520      $u,duration($rps{$u}{next})));
1521    }
1522}
1523
1524sub team_battle { # pit three players against three other players
1525    my @opp = grep { $rps{$_}{online} } keys(%rps);
1526    return if @opp < 6;
1527    # choose random point       
1528    my $x = int(rand($opts{mapx}));
1529    my $y = int(rand($opts{mapy}));
1530    my %polar = ();
1531    for my $player (@opp) {   
1532        my $dx = $rps{$player}{x}-$x;
1533        my $dy = $rps{$player}{y}-$y;
1534        # polar coordinates
1535        $polar{$player}{r} = sqrt($dx*$dx+$dy*$dy);
1536        $polar{$player}{phi} = atan2($dy,$dx)     
1537    }
1538    # sort by radius
1539    my @sorted = sort { $polar{$a}{r} <=> $polar{$b}{r} } keys %polar;
1540    # get players at least as close as #6
1541    @sorted = grep { $polar{$_}{r} <= $polar{$sorted[5]}{r} } @sorted;
1542    # pick 6 random players from these 
1543    @opp = ();
1544    for (my $i = 0; $i < 6; $i++) {
1545        $opp[$i] = splice(@sorted,int(rand(@sorted)),1); 
1546    }
1547    # sort by angle
1548    @opp = sort { $polar{$a}{phi} <=> $polar{$b}{phi} } @opp;
1549    # shift splitting position
1550    my $rot = int(rand(6));
1551    @opp = @opp[$rot..5,0..$rot-1]; 
1552    my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
1553    my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
1554    my $gain = $rps{$opp[0]}{next};
1555    for my $p (1,2) {
1556        $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
1557    }
1558    $gain = int($gain*.20);
1559    my $myroll = int(rand($mysum));
1560    my $opproll = int(rand($oppsum));
1561    if ($myroll >= $opproll) {
1562        chanmsg(clog(sprintf(gettext("%s, %s and %s [%u/%u] have team battled ".
1563             "%s, %s and %s [%u/%u] at [%u,%u] and won!".
1564             " %s is removed from their clocks."),
1565           $opp[0],$opp[1],$opp[2],$myroll,$mysum,
1566           $opp[3],$opp[4],$opp[5],$opproll,$oppsum,
1567           $x,$y,duration($gain))));
1568        $rps{$opp[0]}{next} -= $gain;
1569        $rps{$opp[1]}{next} -= $gain;
1570        $rps{$opp[2]}{next} -= $gain;
1571    }
1572    else {
1573        chanmsg(clog(sprintf(gettext("%s, %s and %s [%u/%u] have team battled ".
1574             "%s, %s and %s [%u/%u] at [%u,%u] and ".
1575             "lost! %s is added to their clocks."),
1576           $opp[0],$opp[1],$opp[2],$myroll,$mysum,
1577           $opp[3],$opp[4],$opp[5],$opproll,$oppsum,
1578           $x,$y,duration($gain))));
1579        $rps{$opp[0]}{next} += $gain;
1580        $rps{$opp[1]}{next} += $gain;
1581        $rps{$opp[2]}{next} += $gain;
1582    }
1583}
1584
1585sub itemlevel {
1586    my $level = shift;
1587    $level =~ s/\D$//;
1588    return $level;
1589}
1590
1591sub itemtag {
1592    my $level = shift;
1593    $level =~ s/^\d+//;
1594    return $level;
1595}
1596
1597sub process_items { # decrease items lying around
1598    my $curtime = time();
1599
1600    for my $xy (keys(%mapitems)) {
1601        for my $i (0..$#{$mapitems{$xy}}) {
1602            my $level = $mapitems{$xy}[$i]{level};
1603            my $ttl = int($opts{rpitembase} * ttl(itemlevel($level)) / 600);
1604            if ($mapitems{$xy}[$i]{lasttime} + $ttl <= $curtime ) {
1605               $mapitems{$xy}[$i]{lasttime} += $ttl;
1606               $mapitems{$xy}[$i]{level} = downgrade_item($level);
1607               splice(@{$mapitems{$xy}},$i,1) if ($mapitems{$xy}[$i]{level} == 0);
1608            }
1609        }
1610    }
1611}
1612
1613sub drop_item { # drop item on the map
1614    my $u = shift;
1615    my $type = shift;
1616    my $level = shift;
1617    my $ulevel = itemlevel($level);
1618    my $x = $rps{$u}{x};
1619    my $y = $rps{$u}{y};
1620
1621    push(@{$mapitems{"$x:$y"}},{type=>$type,level=>$level,lasttime=>time()}) if ($ulevel > 0);
1622}
1623
1624sub downgrade_item { # returns the decreased item level
1625    my $level = shift;
1626    my $ulevel = itemlevel($level);
1627    my $tag = itemtag($level);
1628    my %minlevel = (''=>0,a=>50,h=>50,b=>75,d=>150,e=>175,f=>250,g=>300);
1629    $tag = '' if ($ulevel == $minlevel{$tag});
1630    $ulevel-- if ($ulevel > 0);
1631    return "$ulevel$tag";
1632}
1633
1634sub exchange_item { # take item and drop the current
1635    my $u = shift;
1636    my $type = shift;
1637    my $level = shift;
1638    my $ulevel = itemlevel($level);
1639    my $tag = itemtag($level);
1640
1641    if ($tag eq 'a') {
1642        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1643             "You have found the level %u Mattt's ".
1644             "Omniscience Grand Crown! Your enemies fall ".
1645             "before you as you anticipate their every move."),
1646           $ulevel),$rps{$u}{nick});
1647    }
1648    elsif ($tag eq 'b') {
1649        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1650             "You have found the level %u Res0's ".
1651             "Protectorate Plate Mail! Your enemies cower in".
1652             " fear as their attacks have no effect on you."),
1653           $ulevel),$rps{$u}{nick});
1654    }
1655    elsif ($tag eq 'c') {
1656        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1657             "You have found the level %u Dwyn's Storm Magic ".
1658             "Amulet! Your enemies are swept away by an".
1659             "elemental fury before the war has even begun"),
1660           $ulevel),$rps{$u}{nick});
1661    }
1662    elsif ($tag eq 'd') {
1663        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1664             "You have found the level %u Jotun's Fury ".
1665             "Colossal Sword! Your enemies' hatred is brought".
1666             "to a quick end as you arc your wrist, dealing ".
1667             "the crushing blow."),$ulevel),$rps{$u}{nick});
1668    }
1669    elsif ($tag eq 'e') {
1670        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1671             "You have found the level %u Drdink's Cane of ".
1672             "Blind Rage! Your enemies are tossed aside as ".
1673             "you blindly swing your arm around hitting ".
1674             "stuff."),$ulevel),$rps{$u}{nick});
1675    }
1676    elsif ($tag eq 'f') {
1677        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1678             "You have found the level %u Mrquick's Magical ".
1679             "Boots of Swiftness! Your enemies are left ".
1680             "choking on your dust as you run from them ".
1681             "very, very quickly."),$ulevel),$rps{$u}{nick});
1682    }
1683    elsif ($tag eq 'g') {
1684        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1685             "You have found the level %u Jeff's Cluehammer ".
1686             "of Doom! Your enemies are left with a sudden ".
1687             "and intense clarity of mind... even as you ".
1688             "relieve them of it."),$ulevel),$rps{$u}{nick});
1689    }
1690    elsif ($tag eq 'h') {
1691        notice(sprintf(gettext("The light of the gods shines down upon you! ".
1692             "You have found the level %u Juliet's Glorious ".
1693             "Ring of Sparkliness! You enemies are blinded ".
1694             "by both its glory and their greed as you bring ".
1695             "desolation upon them."),$ulevel),
1696               $rps{$u}{nick});
1697    }
1698    else {
1699        notice(sprintf(gettext("You found a level %u %s! Your current %2\$s is ".
1700             "only level %u, so it seems Luck is with you!"),
1701           $ulevel,gettext($type),itemlevel($rps{$u}{item}{$type})),
1702         $rps{$u}{nick});
1703    }
1704
1705    drop_item($u,$type,$rps{$u}{item}{$type});
1706    $rps{$u}{item}{$type} = $level;
1707}
1708
1709sub find_item { # find item for argument player
1710    my $u = shift;
1711    my @items = ("ring","amulet","charm","weapon","helm","tunic",
1712                 "pair of gloves","set of leggings","shield","pair of boots");
1713    my $type = $items[rand(@items)];
1714    my $level = 1;
1715    my $ulevel;
1716    for my $num (1 .. int($rps{$u}{level}*1.5)) {
1717        if (rand(1.4**($num/4)) < 1) {
1718            $level = $num;
1719        }
1720    }
1721    if ($rps{$u}{level} >= 25 && rand(40) < 1) {
1722        $ulevel = 50+int(rand(25));
1723        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{helm})) {
1724            exchange_item($u,"helm",$ulevel."a");
1725            return;
1726        }
1727    }
1728    elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
1729        $ulevel = 50+int(rand(25));
1730        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{ring})) {
1731            exchange_item($u,"ring",$ulevel."h");
1732            return;
1733        }
1734    }
1735    elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
1736        $ulevel = 75+int(rand(25));
1737        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{tunic})) {
1738            exchange_item($u,"tunic",$ulevel."b");
1739            return;
1740        }
1741    }
1742    elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
1743        $ulevel = 100+int(rand(25));
1744        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{amulet})) {
1745            exchange_item($u,"amulet",$ulevel."c");
1746            return;
1747        }
1748    }
1749    elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
1750        $ulevel = 150+int(rand(25));
1751        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
1752            exchange_item($u,"weapon",$ulevel."d");
1753            return;
1754        }
1755    }
1756    elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
1757        $ulevel = 175+int(rand(26));
1758        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
1759            exchange_item($u,"weapon",$ulevel."e");
1760            return;
1761        }
1762    }
1763    elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
1764        $ulevel = 250+int(rand(51));
1765        if ($ulevel >= $level && $ulevel >
1766            itemlevel($rps{$u}{item}{"pair of boots"})) {
1767            exchange_item($u,"pair of boots",$ulevel."f");
1768            return;
1769        }
1770    }
1771    elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
1772        $ulevel = 300+int(rand(51));
1773        if ($ulevel >= $level && $ulevel > itemlevel($rps{$u}{item}{weapon})) {
1774            exchange_item($u,"weapon",$ulevel."g");
1775            return;
1776        }
1777    }
1778    if ($level > itemlevel($rps{$u}{item}{$type})) {
1779        exchange_item($u,$type,$level);
1780    }
1781    else {
1782        notice(sprintf(gettext("You found a level %u %s. Your current %2\$s is ".
1783             "level %3\$u, so it seems Luck is against you. ".
1784             "You toss the %2\$s."),
1785           $level,gettext($type),itemlevel($rps{$u}{item}{$type})),
1786         $rps{$u}{nick});
1787        drop_item($u,$type,$level);
1788    }
1789}
1790
1791sub loaddb { # load the players and items database
1792    backup();
1793    my $l;
1794    %rps = ();
1795    if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
1796        sts("QUIT :loaddb() failed: $!");
1797    }
1798    while ($l=<RPS>) {
1799        chomp($l);
1800        next if $l =~ /^#/; # skip comments
1801        my @i = split("\t",$l);
1802        print Dumper(@i) if @i != 32;
1803        if (@i != 32) {
1804            sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
1805                "wrong fields (".scalar(@i).")");
1806            debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
1807                "fields (".scalar(@i).")",1);
1808        }
1809        if (!$sock) { # if not RELOADDB
1810            if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
1811        }
1812        ($rps{$i[0]}{pass},
1813        $rps{$i[0]}{isadmin},
1814        $rps{$i[0]}{level},
1815        $rps{$i[0]}{class},
1816        $rps{$i[0]}{next},
1817        $rps{$i[0]}{nick},
1818        $rps{$i[0]}{userhost},
1819        $rps{$i[0]}{online},
1820        $rps{$i[0]}{idled},
1821        $rps{$i[0]}{x},
1822        $rps{$i[0]}{y},
1823        $rps{$i[0]}{pen_mesg},
1824        $rps{$i[0]}{pen_nick},
1825        $rps{$i[0]}{pen_part},
1826        $rps{$i[0]}{pen_kick},
1827        $rps{$i[0]}{pen_quit},
1828        $rps{$i[0]}{pen_quest},
1829        $rps{$i[0]}{pen_logout},
1830        $rps{$i[0]}{created},
1831        $rps{$i[0]}{lastlogin},
1832        $rps{$i[0]}{item}{amulet},
1833        $rps{$i[0]}{item}{charm},
1834        $rps{$i[0]}{item}{helm},
1835        $rps{$i[0]}{item}{"pair of boots"},
1836        $rps{$i[0]}{item}{"pair of gloves"},
1837        $rps{$i[0]}{item}{ring},
1838        $rps{$i[0]}{item}{"set of leggings"},
1839        $rps{$i[0]}{item}{shield},
1840        $rps{$i[0]}{item}{tunic},
1841        $rps{$i[0]}{item}{weapon},
1842        $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
1843    }
1844    close(RPS);
1845    debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
1846          scalar(keys(%prev_online))." previously online.");
1847    if (!open(ITEMS,$opts{itemdbfile}) && -e $opts{itemdbfile}) {
1848        sts("QUIT :loaddb() failed: $!");
1849    }
1850    my $cnt = 0;
1851    %mapitems = ();
1852    while ($l=<ITEMS>) {
1853        chomp($l);
1854        next if $l =~ /^#/; # skip comments
1855        my @i = split("\t",$l);
1856        print Dumper(@i) if @i != 5;
1857        if (@i != 5) {
1858            sts("QUIT: Anomaly in loaddb(); line $. of $opts{itemdbfile} has ".
1859                "wrong fields (".scalar(@i).")");
1860            debug("Anomaly in loaddb(); line $. of $opts{itemdbfile} has wrong ".
1861                "fields (".scalar(@i).")",1);
1862        }
1863        my $curtime = time();
1864        push(@{$mapitems{"$i[0]:$i[1]"}},{type=>$i[2],level=>$i[3],lasttime=>$curtime-$i[4]});
1865        $cnt++;
1866    }
1867    close(ITEMS);
1868    debug("loaddb(): loaded $cnt items.");
1869}
1870
1871sub moveplayers {
1872    return unless $lasttime > 1;
1873    my $onlinecount = grep { $rps{$_}{online} } keys %rps;
1874    return unless $onlinecount;
1875    for (my $i=0;$i<$opts{self_clock};++$i) {
1876        # temporary hash to hold player positions, detect collisions
1877        my %positions = ();
1878        if ($quest{type} == 2 && @{$quest{questers}}) {
1879            my $allgo = 1; # have all users reached <p1|p2>?
1880            for (@{$quest{questers}}) {
1881                if ($quest{stage}==1) {
1882                    if ($rps{$_}{x} != $quest{p1}->[0] ||
1883                        $rps{$_}{y} != $quest{p1}->[1]) {
1884                        $allgo=0;
1885                        last();
1886                    }
1887                }
1888                else {
1889                    if ($rps{$_}{x} != $quest{p2}->[0] ||
1890                        $rps{$_}{y} != $quest{p2}->[1]) {
1891                        $allgo=0;
1892                        last();
1893                    }
1894                }
1895            }
1896            # all participants have reached point 1, now point 2
1897            if ($quest{stage}==1 && $allgo) {
1898                $quest{stage}=2;
1899                $allgo=0; # have not all reached p2 yet
1900            }
1901            elsif ($quest{stage} == 2 && $allgo) {
1902                chanmsg(clog(sprintf(gettext("%s, and %s have completed their ".
1903               "journey! 25%% of their burden is ".
1904               "eliminated."),
1905             join(", ",(@{$quest{questers}})[0..2]),
1906             $quest{questers}->[3])));
1907                for (@{$quest{questers}}) {
1908                    $rps{$_}{next} = int($rps{$_}{next} * .75);
1909                }
1910                undef(@{$quest{questers}});
1911                $quest{qtime} = time() + 21600; # next quest starts in 6 hours
1912                $quest{type} = 1; # probably not needed
1913                writequestfile();
1914            }
1915            else {
1916                my(%temp,$player);
1917                # load keys of %temp with online users
1918                ++@temp{grep { $rps{$_}{online} } keys(%rps)};
1919                # delete questers from list
1920                delete(@temp{@{$quest{questers}}});
1921                while ($player = each(%temp)) {
1922                    $rps{$player}{x} += int(rand(3))-1;
1923                    $rps{$player}{y} += int(rand(3))-1;
1924                    # if player goes over edge, wrap them back around
1925                    if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
1926                    if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
1927                    if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
1928                    if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
1929                   
1930                    if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1931                        !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1932                        if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1933                            !$rps{$player}{isadmin} && rand(100) < 1) {
1934                            chanmsg(sprintf(gettext("%s encounters %s and bows".
1935                " humbly."),
1936              $player,
1937              $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}));
1938                        }
1939                        if (rand($onlinecount) < 1) {
1940                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1941                            collision_fight($player,
1942                                $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1943                        }
1944                    }
1945                    else {
1946                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1947                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1948                    }
1949                }
1950                for (@{$quest{questers}}) {
1951                    if ($quest{stage} == 1) {
1952                        if (rand(100) < 1) {
1953                            if ($rps{$_}{x} != $quest{p1}->[0]) {
1954                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
1955                                                1 : -1);
1956                            }
1957                            if ($rps{$_}{y} != $quest{p1}->[1]) {
1958                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
1959                                                1 : -1);
1960                            }
1961                        }
1962                    }
1963                    elsif ($quest{stage}==2) {
1964                        if (rand(100) < 1) {
1965                            if ($rps{$_}{x} != $quest{p2}->[0]) {
1966                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
1967                                                1 : -1);
1968                            }
1969                            if ($rps{$_}{y} != $quest{p2}->[1]) {
1970                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
1971                                                1 : -1);
1972                            }
1973                        }
1974                    }
1975                }
1976            }
1977        }
1978        else {
1979            for my $player (keys(%rps)) {
1980                next unless $rps{$player}{online};
1981                $rps{$player}{x} += int(rand(3))-1;
1982                $rps{$player}{y} += int(rand(3))-1;
1983                # if player goes over edge, wrap them back around
1984                if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
1985                if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
1986                if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
1987                if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
1988                if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1989                    !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1990                    if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1991                        !$rps{$player}{isadmin} && rand(100) < 1) {
1992                        chanmsg(sprintf(gettext("%s encounters %s and bows ".
1993            "humbly."),$player,
1994          $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}));
1995                    }
1996                    if (rand($onlinecount) < 1) {
1997                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1998                        collision_fight($player,
1999                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
2000                    }
2001                }
2002                else {
2003                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
2004                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
2005                }
2006            }
2007        }
2008        # pick up items lying around
2009        for my $u (keys(%rps)) {
2010            next unless $rps{$u}{online};
2011            my $x = $rps{$u}{x};
2012            my $y = $rps{$u}{y};
2013            for $i (0..$#{$mapitems{"$x:$y"}}) {
2014                my $item = $mapitems{"$x:$y"}[$i];
2015                if (itemlevel($item->{level}) > itemlevel($rps{$u}{item}{$item->{type}})) {
2016                    exchange_item($u,$item->{type},$item->{level});
2017                    splice(@{$mapitems{"$x:$y"}},$i,1);
2018                }
2019            }
2020        }
2021    }
2022}
2023
2024sub mksalt { # generate a random salt for passwds
2025    join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
2026}
2027
2028sub chanmsg { # send a message to the channel
2029    my $msg = shift or return undef;
2030    if ($silentmode & 1) { return undef; }
2031    privmsg($msg, $opts{botchan}, shift);
2032}
2033
2034sub privmsg { # send a message to an arbitrary entity
2035    my $msg = shift or return undef;
2036    my $target = shift or return undef;
2037    my $force = shift;
2038    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
2039        && !$force) {
2040        return undef;
2041    }
2042    while (length($msg)) {
2043        sts("PRIVMSG $target :".substr($msg,0,450),$force);
2044        substr($msg,0,450)="";
2045    }
2046}
2047
2048sub notice { # send a notice to an arbitrary entity
2049    my $msg = shift or return undef;
2050    my $target = shift or return undef;
2051    my $force = shift;
2052    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
2053        && !$force) {
2054        return undef;
2055    }
2056    while (length($msg)) {
2057        sts("NOTICE $target :".substr($msg,0,450),$force);
2058        substr($msg,0,450)="";
2059    }
2060}
2061
2062sub help { # print help message
2063    (my $prog = $0) =~ s/^.*\///;
2064
2065    print "
2066usage: $prog [OPTIONS]
2067  --help, -h           Print this message
2068  --verbose, -v        Print verbose messages
2069  --server, -s         Specify IRC server:port to connect to
2070  --botnick, -n        Bot's IRC nick
2071  --botuser, -u        Bot's username
2072  --botrlnm, -r        Bot's real name
2073  --botchan, -c        IRC channel to join
2074  --botident, -p       Specify identify-to-services command
2075  --botmodes, -m       Specify usermodes for the bot to set upon connect
2076  --botopcmd, -o       Specify command to send to server on successful connect
2077  --botghostcmd, -g    Specify command to send to server to regain primary
2078                       nickname when in use
2079  --doban              Advertisement ban on/off flag
2080  --okurl, -k          Bot will not ban for web addresses that contain these
2081                       strings
2082  --debug              Debug on/off flag
2083  --helpurl            URL to refer new users to
2084  --admincommurl       URL to refer admins to
2085
2086  Timing parameters:
2087  --rpbase             Base time to level up
2088  --rpstep             Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
2089  --rppenstep          PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
2090
2091";
2092}
2093
2094sub itemsum {
2095    my $user = shift;
2096    # is this for a battle? if so, good users get a 10% boost and evil users get
2097    # a 10% detriment
2098    my $battle = shift;
2099    return -1 unless defined $user;
2100    my $sum = 0;
2101    if ($user eq $primnick) {
2102        for my $u (keys(%rps)) {
2103            $sum = itemsum($u) if $sum < itemsum($u);
2104        }
2105        return $sum+1;
2106    }
2107    if (!exists($rps{$user})) { return -1; }
2108    $sum += itemlevel($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
2109    if ($battle) {
2110        return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
2111               $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
2112               $sum;
2113    }
2114    return $sum;
2115}
2116
2117sub daemonize() {
2118    # win32 doesn't daemonize (this way?)
2119    if ($^O eq "MSWin32") {
2120        print debug("Nevermind, this is Win32, no I'm not.")."\n";
2121        return;
2122    }
2123    use POSIX 'setsid';
2124    $SIG{CHLD} = sub { };
2125    fork() && exit(0); # kill parent
2126    POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
2127    $SIG{CHLD} = sub { };
2128    fork() && exit(0); # kill the parent as the process group leader
2129    $SIG{CHLD} = sub { };
2130    open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
2131    open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
2132    open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
2133    # write our PID to $opts{pidfile}, or return semi-silently on failure
2134    open(PIDFILE,">$opts{pidfile}") || do {
2135        debug("Error: failed opening pid file: $!");
2136        return;
2137    };
2138    print PIDFILE $$;
2139    close(PIDFILE);
2140}
2141
2142sub calamity { # suffer a little one
2143    my @players = grep { $rps{$_}{online} } keys(%rps);
2144    return unless @players;
2145    my $player = $players[rand(@players)];
2146    if (rand(10) < 1) {
2147        my @items = ("amulet","charm","weapon","tunic","set of leggings",
2148                     "shield");
2149        my $type = $items[rand(@items)];
2150        if ($type eq "amulet") {
2151            chanmsg(clog(sprintf(gettext("%s fell, chipping the stone in his ".
2152           "amulet! %1\$s\'s %s loses 10%% of its".
2153           " effectiveness."),
2154         $player,gettext($type))));
2155        }
2156        elsif ($type eq "charm") {
2157            chanmsg(clog(sprintf(gettext("%s slipped and dropped his charm in a".
2158           " dirty bog! %1\$s\'s %s loses 10%% of".
2159           " its effectiveness."),
2160         $player,gettext($type))));
2161        }
2162        elsif ($type eq "weapon") {
2163            chanmsg(clog(sprintf(gettext("%s left his weapon out in the rain to".
2164           " rust! %1\$s\'s %s loses 10%% of its ".
2165           "effectiveness."),
2166         $player,gettext($type))));
2167        }
2168        elsif ($type eq "tunic") {
2169            chanmsg(clog(sprintf(gettext("%s spilled a level 7 shrinking potion".
2170           " on his tunic! %1\$s\'s %s loses 10%%".
2171           " of its effectiveness."),
2172         $player,gettext($type))));
2173        }
2174        elsif ($type eq "shield") {
2175            chanmsg(clog(sprintf(gettext("%s\'s shield was damaged by a ".
2176           "dragon's fiery breath! %1\$s\'s %s ".
2177           "loses 10%% of its effectiveness."),
2178         $player,gettext($type))));
2179        }
2180        else {
2181            chanmsg(clog(sprintf(gettext("%s burned a hole through his leggings".
2182           " while ironing them! %1\$s\'s %s ".
2183           "loses 10%% of its effectiveness."),
2184        $player,gettext($type))));
2185        }
2186        my $suffix="";
2187        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
2188        $rps{$player}{item}{$type} = int(itemlevel($rps{$player}{item}{$type}) * .9);
2189        $rps{$player}{item}{$type}.=$suffix;
2190    }
2191    else {
2192        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
2193        if (!open(Q,$opts{eventsfile})) {
2194            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
2195        }
2196        my($i,$actioned);
2197        while (my $line = <Q>) {
2198            chomp($line);
2199            if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
2200        }
2201        chanmsg(clog(sprintf(gettext("%s %s. This terrible calamity has slowed ".
2202             "them %s from level %u."),
2203           $player,$actioned,duration($time),
2204           ($rps{$player}{level}+1))));
2205        $rps{$player}{next} += $time;
2206        chanmsg(sprintf(gettext("%s reaches next level in %s."),
2207      $player,duration($rps{$player}{next})));
2208    }
2209}
2210
2211sub godsend { # bless the unworthy
2212    my @players = grep { $rps{$_}{online} } keys(%rps);
2213    return unless @players;
2214    my $player = $players[rand(@players)];
2215    if (rand(10) < 1) {
2216        my @items = ("amulet","charm","weapon","tunic","set of leggings",
2217                     "shield");
2218        my $type = $items[rand(@items)];
2219        if ($type eq "amulet") {
2220            chanmsg(clog(sprintf(gettext("%s\'s %s was blessed by a passing".
2221           " cleric! %1\$s\'s %2\$s gains 10%% ".
2222           "effectiveness."),
2223         $player,gettext($type))));
2224        }
2225        elsif ($type eq "charm") {
2226            chanmsg(clog(sprintf(gettext("%s\'s %s ate a bolt of lightning! ".
2227           "%1\$s\'s %2\$s gains 10%% ".
2228           "effectiveness."),
2229         $player,gettext($type))));
2230        }
2231        elsif ($type eq "weapon") {
2232            chanmsg(clog(sprintf(gettext("%s sharpened the edge of his %s! ".
2233           "%1\$s\'s %2\$s gains 10%% ".
2234           "effectiveness."),
2235        $player,gettext($type))));
2236        }
2237        elsif ($type eq "tunic") {
2238            chanmsg(clog(sprintf(gettext("A magician cast a spell of Rigidity ".
2239           "on %s\'s %s! %1\$s\'s %2\$s gains ".
2240           "10%% effectiveness."),
2241         $player,gettext($type))));
2242        }
2243        elsif ($type eq "shield") {
2244            chanmsg(clog(sprintf(gettext("%s reinforced his %s with a ".
2245           "dragon's scales! %1\$s\'s %2\$s gains".
2246           " 10%% effectiveness."),
2247        $player,gettext($type))));
2248        }
2249        else {
2250            chanmsg(clog(sprintf(gettext("The local wizard imbued %s\'s pants ".
2251           "with a Spirit of Fortitude! %1\$s\'s ".
2252           "%2\$s gains 10%% effectiveness."),
2253        $player,gettext($type))));
2254        }
2255        my $suffix="";
2256        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
2257        $rps{$player}{item}{$type} = int(itemlevel($rps{$player}{item}{$type}) * 1.1);
2258        $rps{$player}{item}{$type}.=$suffix;
2259    }
2260    else {
2261        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
2262        my $actioned;
2263        if (!open(Q,$opts{eventsfile})) {
2264            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
2265        }
2266        my $i;
2267        while (my $line = <Q>) {
2268            chomp($line);
2269            if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
2270                $actioned = $1;
2271            }
2272        }
2273        chanmsg(clog(sprintf(gettext("%s %s! This wondrous godsend has ".
2274             "accelerated them %s towards level %u."),
2275           $player,$actioned,duration($time),
2276           ($rps{$player}{level}+1))));
2277        $rps{$player}{next} -= $time;
2278        chanmsg(sprintf(gettext("%s reaches next level in %s."),
2279      $player,duration($rps{$player}{next})));
2280    }
2281}
2282
2283sub quest {
2284    @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
2285                                 time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
2286    if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
2287    while (@{$quest{questers}} > 4) {
2288        splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
2289    }
2290    if (!open(Q,$opts{eventsfile})) {
2291        return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
2292    }
2293    my $i;
2294    while (my $line = <Q>) {
2295        chomp($line);
2296        if ($line =~ /^Q/ && rand(++$i) < 1) {
2297            if ($line =~ /^Q1 (.*)/) {
2298                $quest{text} = $1;
2299                $quest{type} = 1;
2300                $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
2301            }
2302            elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
2303                $quest{p1} = [$1,$2];
2304                $quest{p2} = [$3,$4];
2305                $quest{text} = $5;
2306                $quest{type} = 2;
2307                $quest{stage} = 1;
2308            }
2309        }
2310    }
2311    close(Q);
2312    if ($quest{type} == 1) {
2313        chanmsg(sprintf(gettext("%s, and %s have been chosen by the gods to ".
2314        "%s. Quest to end in %s."),
2315      join(", ",(@{$quest{questers}})[0..2]),
2316      $quest{questers}->[3],$quest{text},
2317      duration($quest{qtime}-time())));   
2318    }
2319    elsif ($quest{type} == 2) {
2320        chanmsg(sprintf(gettext("%s, and %s have been chosen by the gods to ".
2321        "%s. Participants must first reach [%u,%u], ".
2322        "then [%u,%u]."),
2323      join(", ",(@{$quest{questers}})[0..2]),
2324      $quest{questers}->[3],$quest{text},
2325      $quest{p1}->[0],$quest{p1}->[1],
2326      $quest{p2}->[0],$quest{p2}->[1]).
2327                ($opts{mapurl}?sprintf(gettext(" See %s to monitor their ".
2328                 "journey's progress."),
2329               $opts{mapurl}):""));
2330    }
2331    writequestfile();
2332}
2333
2334sub questpencheck {
2335    my $k = shift;
2336    my ($quester,$player);
2337    for $quester (@{$quest{questers}}) {
2338        if ($quester eq $k) {
2339            chanmsg(clog(sprintf(gettext(
2340       "%s\'s prudence and self-regard has brought the ".
2341                         "wrath of the gods upon the realm. All your great ".
2342                         "wickedness makes you as it were heavy with lead, ".
2343                         "and to tend downwards with great weight and ".
2344                         "pressure towards hell. Therefore have you drawn ".
2345                         "yourselves 15 steps closer to that gaping maw.")
2346         ,$k)));
2347            for $player (grep { $rps{$_}{online} } keys %rps) {
2348                my $gain = int(15 * penttl($rps{$player}{level}) / $opts{rpbase});
2349                $rps{$player}{pen_quest} += $gain;
2350                $rps{$player}{next} += $gain;
2351            }
2352            undef(@{$quest{questers}});
2353            $quest{qtime} = time() + 43200; # 12 hours
2354            writequestfile();
2355            last;
2356        }
2357    }
2358}
2359
2360sub clog {
2361    my $mesg = shift;
2362    open(B,">>$opts{modsfile}") or do {
2363        debug("Error: Cannot open $opts{modsfile}: $!");
2364        chanmsg("Error: Cannot open $opts{modsfile}: $!");
2365        return $mesg;
2366    };
2367    print B ts()."$mesg\n";
2368    close(B);
2369    return $mesg;
2370}
2371
2372sub backup() {
2373    if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
2374    if ($^O ne "MSWin32") {
2375        system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
2376        system("cp $opts{itemdbfile} .dbbackup/$opts{itemdbfile}".time());
2377    }
2378    else {
2379        system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
2380        system("copy $opts{itemdbfile} .dbbackup\\$opts{itemdbfile}".time());
2381    }
2382}
2383
2384sub penalize {
2385    my $username = shift;
2386    return 0 if !defined($username);
2387    return 0 if !exists($rps{$username});
2388    my $type = shift;
2389    my $pen = 0;
2390    questpencheck($username);
2391    if ($type eq "quit") {
2392        $pen = int(20 * penttl($rps{$username}{level}) / $opts{rpbase});
2393        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2394            $pen = $opts{limitpen};
2395        }
2396        $rps{$username}{pen_quit}+=$pen;
2397        $rps{$username}{online}=0;
2398    }
2399    elsif ($type eq "nick") {
2400        my $newnick = shift;
2401        $pen = int(30 * penttl($rps{$username}{level}) / $opts{rpbase});
2402        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2403            $pen = $opts{limitpen};
2404        }
2405        $rps{$username}{pen_nick}+=$pen;
2406        $rps{$username}{nick} = substr($newnick,1);
2407        $rps{$username}{userhost} =~ s/^[^!]+/$rps{$username}{nick}/e;
2408        notice(sprintf(gettext("Penalty of %s added to your timer for ".
2409               "nick change."),duration($pen)),$rps{$username}{nick});
2410    }
2411    elsif ($type eq "privmsg" || $type eq "notice") {
2412        $pen = int(shift(@_) * penttl($rps{$username}{level}) / $opts{rpbase});
2413        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2414            $pen = $opts{limitpen};
2415        }
2416        $rps{$username}{pen_mesg}+=$pen;
2417        notice(sprintf(gettext("Penalty of %s added to your timer for %s."),
2418           duration($pen),$type),$rps{$username}{nick});
2419    }
2420    elsif ($type eq "part") {
2421        $pen = int(200 * penttl($rps{$username}{level}) / $opts{rpbase});
2422        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2423            $pen = $opts{limitpen};
2424        }
2425        $rps{$username}{pen_part}+=$pen;
2426        notice(sprintf(gettext("Penalty of %s added to your timer for parting."),
2427           duration($pen)),$rps{$username}{nick});
2428        $rps{$username}{online}=0;
2429    }
2430    elsif ($type eq "kick") {
2431        $pen = int(250 * penttl($rps{$username}{level}) / $opts{rpbase});
2432        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2433            $pen = $opts{limitpen};
2434        }
2435        $rps{$username}{pen_kick}+=$pen;
2436        notice(sprintf(gettext("Penalty of %s added to your timer for ".
2437               "being kicked."),duration($pen)),$rps{$username}{nick});
2438        $rps{$username}{online}=0;
2439    }
2440    elsif ($type eq "logout") {
2441        $pen = int(20 * penttl($rps{$username}{level}) / $opts{rpbase});
2442        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2443            $pen = $opts{limitpen};
2444        }
2445        $rps{$username}{pen_logout} += $pen;
2446        notice(sprintf(gettext("Penalty of %s added to your timer for ".
2447               "LOGOUT command."),duration($pen)),$rps{$username}{nick});
2448        $rps{$username}{online}=0;
2449    }
2450    $rps{$username}{next} += $pen;
2451    return 1; # successfully penalized a user! woohoo!
2452}
2453
2454sub debug {
2455    (my $text = shift) =~ s/[\r\n]//g;
2456    my $die = shift;
2457    if ($opts{debug} || $opts{verbose}) {
2458        open(DBG,">>$opts{debugfile}") or do {
2459            chanmsg("Error: Cannot open debug file: $!");
2460            return;
2461        };
2462        print DBG ts()."$text\n";
2463        close(DBG);
2464    }
2465    if ($die) { die("$text\n"); }
2466    return $text;
2467}
2468
2469sub finduser {
2470    my $nick = shift;
2471    return undef if !defined($nick);
2472    for my $user (keys(%rps)) {
2473        next unless $rps{$user}{online};
2474        if ($rps{$user}{nick} eq $nick) { return $user; }
2475    }
2476    return undef;
2477}
2478
2479sub ha { # return 0/1 if username has access
2480    my $user = shift;
2481    if (!defined($user)) {
2482        debug("Error: Attempted ha() for undefined username");
2483        return 0;
2484    }
2485    if (!exists($rps{$user})) {
2486        debug("Error: Attempted ha() for invalid username \"$user\"");
2487        return 0;
2488    }
2489    return $rps{$user}{isadmin};
2490}
2491
2492sub checksplits { # removed expired split hosts from the hash
2493    my $host;
2494    while ($host = each(%split)) {
2495        if (time()-$split{$host}{time} > $opts{splitwait}) {
2496            $rps{$split{$host}{account}}{online} = 0;
2497            delete($split{$host});
2498        }
2499    }
2500}
2501
2502sub collision_fight {
2503    my($u,$opp) = @_;
2504    my $mysum = itemsum($u,1);
2505    my $oppsum = itemsum($opp,1);
2506    my $myroll = int(rand($mysum));
2507    my $opproll = int(rand($oppsum));
2508    if ($myroll >= $opproll) {
2509        my $gain = int($rps{$opp}{level}/4);
2510        $gain = 7 if $gain < 7;
2511        $gain = int(($gain/100)*$rps{$u}{next});
2512        chanmsg(clog(sprintf(gettext("%s [%u/%u] has come upon %s [%u/%u] and ".
2513             "taken them in combat! %s is removed from ".
2514             "%1\$s\'s clock."),
2515           $u,$myroll,$mysum,$opp,$opproll,$oppsum,
2516           duration($gain))));
2517        $rps{$u}{next} -= $gain;
2518        chanmsg(sprintf(gettext("%s reaches next level in %s."),
2519      $u,duration($rps{$u}{next})));
2520        if (rand(35) < 1 && $opp ne $primnick) {
2521            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2522            chanmsg(clog(sprintf(gettext("%s has dealt %s a Critical Strike! %s".
2523           " is added to %2\$s\'s clock."),
2524         $u,$opp,duration($gain))));
2525            $rps{$opp}{next} += $gain;
2526            chanmsg(sprintf(gettext("%s reaches next level in %s."),$opp,duration($rps{$opp}{next})));
2527        }
2528        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
2529            my @items = ("ring","amulet","charm","weapon","helm","tunic",
2530                         "pair of gloves","set of leggings","shield",
2531                         "pair of boots");
2532            my $type = $items[rand(@items)];
2533            if (itemlevel($rps{$opp}{item}{$type}) > itemlevel($rps{$u}{item}{$type})) {
2534                chanmsg(sprintf(gettext("In the fierce battle, %s dropped his ".
2535          "level %u %s! %s picks it up, tossing ".
2536          "his old level %u %3\$s to %1\$s."),
2537        $opp,itemlevel($rps{$opp}{item}{$type}),
2538        gettext($type),$u,
2539        itemlevel($rps{$u}{item}{$type})));
2540                my $tempitem = $rps{$u}{item}{$type};
2541                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
2542                $rps{$opp}{item}{$type} = $tempitem;
2543            }
2544        }
2545    }
2546    else {
2547        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
2548        $gain = 7 if $gain < 7;
2549        $gain = int(($gain/100)*$rps{$u}{next});
2550        chanmsg(clog(sprintf(gettext("%s [%u/%u] has come upon %s [%u/%u] and ".
2551             "been defeated in combat! %s is added to ".
2552             "%1\$s\'s clock."),
2553           $u,$myroll,$mysum,$opp,$opproll,$oppsum,
2554           duration($gain))));
2555        $rps{$u}{next} += $gain;
2556        chanmsg(sprintf(gettext("%s reaches next level in %s."),$u,duration($rps{$u}{next})));
2557    }
2558}
2559
2560sub writequestfile {
2561    return unless $opts{writequestfile};
2562    open(QF,">$opts{questfilename}") or do {
2563        chanmsg("Error: Cannot open $opts{questfilename}: $!");
2564        return;
2565    };
2566    # if no active quest, just empty questfile. otherwise, write it
2567    if (@{$quest{questers}}) {
2568        if ($quest{type}==1) {
2569            print QF "T $quest{text}\n".
2570                     "Y 1\n".
2571                     "S $quest{qtime}\n".
2572                     "P1 $quest{questers}->[0]\n".
2573                     "P2 $quest{questers}->[1]\n".
2574                     "P3 $quest{questers}->[2]\n".
2575                     "P4 $quest{questers}->[3]\n";
2576        }
2577        elsif ($quest{type}==2) {
2578            print QF "T $quest{text}\n".
2579                     "Y 2\n".
2580                     "S $quest{stage}\n".
2581                     "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
2582                        "$quest{p2}->[1]\n".
2583                     "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
2584                         "$rps{$quest{questers}->[0]}{y}\n".
2585                     "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
2586                         "$rps{$quest{questers}->[1]}{y}\n".
2587                     "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
2588                         "$rps{$quest{questers}->[2]}{y}\n".
2589                     "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
2590                         "$rps{$quest{questers}->[3]}{y}\n";
2591        }
2592    }
2593    close(QF);
2594}
2595
2596sub loadquestfile {
2597    return unless ($opts{writequestfile} && -e $opts{questfilename});
2598    open(QF,$opts{questfilename}) or do {
2599        chanmsg("Error: Cannot open $opts{questfilename}: $!");
2600        return;
2601    };
2602
2603    my %questdata = ();
2604    while (my $line = <QF>) {
2605        chomp $line;
2606        my ($tag,$data) = split(/ /,$line,2);
2607        $questdata{$tag} = $data;
2608    }
2609    return unless defined($questdata{Y});
2610
2611    $quest{text} = $questdata{T};
2612    $quest{type} = $questdata{Y};
2613    if ($quest{type} == 1) {
2614        $quest{qtime} = $questdata{S};
2615    }
2616    else {
2617        $quest{stage} = $questdata{S};
2618        my ($p1x,$p1y,$p2x,$p2y) = split(/ /,$questdata{P});
2619        $quest{p1}->[0] = $p1x;
2620        $quest{p1}->[1] = $p1y;
2621        $quest{p2}->[0] = $p2x;
2622        $quest{p2}->[1] = $p2y;
2623    }
2624    for my $i (0..3) {
2625        ($quest{questers}->[$i],) = split(/ /,$questdata{'P'.($i+1)},2);
2626        if (!$rps{$quest{questers}->[$i]}{online}) {
2627            undef(@{$quest{questers}});
2628            last;
2629        }
2630    }
2631    close(QF);
2632    writequestfile();
2633}
2634
2635sub goodness {
2636    my @players = grep { $rps{$_}{alignment} eq "g" &&
2637                         $rps{$_}{online} } keys(%rps);
2638    return unless @players > 1;
2639    splice(@players,int(rand(@players)),1) while @players > 2;
2640    my $gain = 5 + int(rand(8));
2641    chanmsg(clog(sprintf(gettext("%s and %s have not let the iniquities of ".
2642                 "evil men poison them. Together have they prayed to their ".
2643                 "god, and it is his light that now shines upon them. %u%% ".
2644                 "of their time is removed from their clocks."),
2645       $players[0],$players[1],$gain)));
2646    $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
2647    $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
2648    chanmsg(sprintf(gettext("%s reaches next level in %s."),
2649            $players[0],duration($rps{$players[0]}{next})));
2650    chanmsg(sprintf(gettext("%s reaches next level in %s."),
2651            $players[1],duration($rps{$players[1]}{next})));
2652}
2653
2654sub evilness {
2655    my @evil = grep { $rps{$_}{alignment} eq "e" &&
2656                      $rps{$_}{online} } keys(%rps);
2657    return unless @evil;
2658    my $me = $evil[rand(@evil)];
2659    if (int(rand(2)) < 1) {
2660        # evil only steals from good :^(
2661        my @good = grep { $rps{$_}{alignment} eq "g" &&
2662                          $rps{$_}{online} } keys(%rps);
2663        my $target = $good[rand(@good)];
2664        my @items = ("ring","amulet","charm","weapon","helm","tunic",
2665                     "pair of gloves","set of leggings","shield",
2666                     "pair of boots");
2667        my $type = $items[rand(@items)];
2668        if (itemlevel($rps{$target}{item}{$type}) > itemlevel($rps{$me}{item}{$type})) {
2669            my $tempitem = $rps{$me}{item}{$type};
2670            $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
2671            $rps{$target}{item}{$type} = $tempitem;
2672            chanmsg(clog(sprintf(gettext("%s stole %s\'s level %u %s while ".
2673           "they were sleeping! %1\$s leaves his ".
2674           "old level %u %4\$s behind, which ".
2675           "%2\$s then takes."),
2676         $me,$target,itemlevel($rps{$me}{item}{$type}),
2677         gettext($type),
2678         itemlevel($rps{$target}{item}{$type}))));
2679        }
2680        else {
2681            notice(sprintf(gettext("You made to steal %s\'s %s, but realized ".
2682           "it was lower level than your own. You ".
2683           "creep back into the shadows."),
2684         $target,gettext($type)),$rps{$me}{nick});
2685        }
2686    }
2687    else { # being evil only pays about half of the time...
2688        my $gain = 1 + int(rand(5));
2689        chanmsg(clog(sprintf(gettext("%s is forsaken by his evil god. %s".
2690             " is added to his clock."),$me,
2691           duration(int($rps{$me}{next} * ($gain/100))))));
2692        $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
2693        chanmsg(sprintf(gettext("%s reaches next level in %s."),
2694      $me,duration($rps{$me}{next})));
2695    }
2696}
2697
2698sub writedb {
2699    open(RPS,">$opts{dbfile}") or do {
2700        chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
2701        return 0;
2702    };
2703    print RPS join("\t","# username",
2704                        "pass",
2705                        "is admin",
2706                        "level",
2707                        "class",
2708                        "next ttl",
2709                        "nick",
2710                        "userhost",
2711                        "online",
2712                        "idled",
2713                        "x pos",
2714                        "y pos",
2715                        "pen_mesg",
2716                        "pen_nick",
2717                        "pen_part",
2718                        "pen_kick",
2719                        "pen_quit",
2720                        "pen_quest",
2721                        "pen_logout",
2722                        "created",
2723                        "last login",
2724                        "amulet",
2725                        "charm",
2726                        "helm",
2727                        "boots",
2728                        "gloves",
2729                        "ring",
2730                        "leggings",
2731                        "shield",
2732                        "tunic",
2733                        "weapon",
2734                        "alignment")."\n";
2735    my $k;
2736    keys(%rps); # reset internal pointer
2737    while ($k=each(%rps)) {
2738        if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
2739            print RPS join("\t",$k,
2740                                $rps{$k}{pass},
2741                                $rps{$k}{isadmin},
2742                                $rps{$k}{level},
2743                                $rps{$k}{class},
2744                                $rps{$k}{next},
2745                                $rps{$k}{nick},
2746                                $rps{$k}{userhost},
2747                                $rps{$k}{online},
2748                                $rps{$k}{idled},
2749                                $rps{$k}{x},
2750                                $rps{$k}{y},
2751                                $rps{$k}{pen_mesg},
2752                                $rps{$k}{pen_nick},
2753                                $rps{$k}{pen_part},
2754                                $rps{$k}{pen_kick},
2755                                $rps{$k}{pen_quit},
2756                                $rps{$k}{pen_quest},
2757                                $rps{$k}{pen_logout},
2758                                $rps{$k}{created},
2759                                $rps{$k}{lastlogin},
2760                                $rps{$k}{item}{amulet},
2761                                $rps{$k}{item}{charm},
2762                                $rps{$k}{item}{helm},
2763                                $rps{$k}{item}{"pair of boots"},
2764                                $rps{$k}{item}{"pair of gloves"},
2765                                $rps{$k}{item}{ring},
2766                                $rps{$k}{item}{"set of leggings"},
2767                                $rps{$k}{item}{shield},
2768                                $rps{$k}{item}{tunic},
2769                                $rps{$k}{item}{weapon},
2770                                $rps{$k}{alignment})."\n";
2771        }
2772    }
2773    close(RPS);
2774    open(ITEMS,">$opts{itemdbfile}") or do {
2775        chanmsg("ERROR: Cannot write $opts{itemdbfile}: $!");
2776        return 0;
2777    };
2778    print ITEMS join("\t","# x pos",
2779                        "y pos",
2780                        "type",
2781                        "level",
2782                        "age")."\n";
2783    my $curtime = time();
2784    for my $xy (keys(%mapitems)) {
2785        for my $i (0..$#{$mapitems{$xy}}) {
2786            my @coords = split(/:/,$xy);
2787            print ITEMS join("\t",$coords[0],
2788                                  $coords[1],
2789                                  $mapitems{$xy}[$i]{type},
2790                                  $mapitems{$xy}[$i]{level},
2791                                  $curtime-$mapitems{$xy}[$i]{lasttime})."\n";
2792        }
2793    }
2794    close(ITEMS);
2795}
2796
2797sub readconfig {
2798    if (! -e ".irpg.conf") {
2799        debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
2800              "please.",1);
2801    }
2802    else {
2803        open(CONF,"<.irpg.conf") or do {
2804            debug("Failed to open config file .irpg.conf: $!",1);
2805        };
2806        my($line,$key,$val);
2807        while ($line=<CONF>) {
2808            next() if $line =~ /^#/; # skip comments
2809            $line =~ s/[\r\n]//g;
2810            $line =~ s/^\s+//g;
2811            next() if !length($line); # skip blank lines
2812            ($key,$val) = split(/\s+/,$line,2);
2813            $val = "" if !defined($val);
2814            $key = lc($key);
2815            if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
2816            elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
2817            if ($key eq "die") {
2818                die("Please edit the file .irpg.conf to setup your bot's ".
2819                    "options. Also, read the README file if you haven't ".
2820                    "yet.\n");
2821            }
2822            elsif ($key eq "server") { push(@{$opts{servers}},$val); }
2823            elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
2824            else { $opts{$key} = $val; }
2825        }
2826    }
2827}
Note: See TracBrowser for help on using the repository browser.