source: irpg/trunk/bot/bot.v3.1.2.K.pl @ 1444

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

import initial

File size: 97.4 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::Select;
32use Data::Dumper;
33use Getopt::Long;
34
35my %opts;
36
37readconfig();
38
39my $version = "3.1.2";
40
41# command line overrides .irpg.conf
42GetOptions(\%opts,
43    "help|h",
44    "verbose|v",
45    "debug",
46    "debugfile=s",
47    "server|s=s",
48    "botnick|n=s",
49    "botuser|u=s",
50    "botrlnm|r=s",
51    "botchan|c=s",
52    "botident|p=s",
53    "botmodes|m=s",
54    "botopcmd|o=s",
55    "localaddr=s",
56    "botghostcmd|g=s",
57    "helpurl=s",
58    "admincommurl=s",
59    "doban",
60    "silentmode=i",
61    "writequestfile",
62    "questfilename=s",
63    "voiceonlogin",
64    "noccodes",
65    "nononp",
66    "mapurl=s",
67    "statuscmd",
68    "pidfile=s",
69    "reconnect",
70    "reconnect_wait=i",
71    "self_clock=i",
72    "modsfile=s",
73    "casematters",
74    "detectsplits",
75    "splitwait=i",
76    "allowuserinfo",
77    "noscale",
78    "phonehome",
79    "owner=s",
80    "owneraddonly",
81    "ownerdelonly",
82    "ownerpevalonly",
83    "checkupdates",
84    "senduserlist",
85    "limitpen=i",
86    "mapx=i",
87    "mapy=i",
88    "modesperline=i",
89    "okurl|k=s@",
90    "eventsfile=s",
91    "rpstep=f",
92    "rpbase=i",
93    "rppenstep=f",
94    "dbfile|irpgdb|db|d=s",
95) or debug("Error: Could not parse command line. Try $0 --help\n",1);
96
97$opts{help} and do { help(); exit 0; };
98
99debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);
100
101my $outbytes = 0; # sent bytes
102my $primnick = $opts{botnick}; # for regain or register checks
103my $inbytes = 0; # received bytes
104my %onchan; # users on game channel
105my %rps; # role-players
106my %quest = (
107    questers => [],
108    p1 => [], # point 1 for q2
109    p2 => [], # point 2 for q2
110    qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
111    text => "",
112    type => 1,
113    stage => 1); # quest info
114
115my $rpreport = 0; # constant for reporting top players
116my %prev_online; # user@hosts online on restart, die
117my %auto_login; # users to automatically log back on
118my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
119my $pausemode = 0; # pausemode on/off flag
120my $silentmode = 0; # silent mode 0/1/2/3, see head of file
121my @queue; # outgoing message queue
122my $lastreg = 0; # holds the time of the last reg. cleared every second.
123                 # prevents more than one account being registered / second
124my $registrations = 0; # count of registrations this period
125my $sel; # IO::Select object
126my $lasttime = 1; # last time that rpcheck() was run
127my $buffer; # buffer for socket stuff
128my $conn_tries = 0; # number of connection tries. gives up after trying each
129                    # server twice
130my $sock; # IO::Socket::INET object
131my %split; # holds nick!user@hosts for clients that have been netsplit
132my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages
133
134sub daemonize(); # prototype to avoid warnings
135
136if (! -e $opts{dbfile}) {
137    $|=1;
138    %rps = ();
139    print "$opts{dbfile} does not appear to exist. I'm guessing this is your ".
140          "first time using IRPG. Please give an account name that you would ".
141          "like to have admin access [$opts{owner}]: ";
142    chomp(my $uname = <STDIN>);
143    $uname =~ s/\s.*//g;
144    $uname = length($uname)?$uname:$opts{owner};
145    print "Enter a character class for this account: ";
146    chomp(my $uclass = <STDIN>);
147    $rps{$uname}{class} = substr($uclass,0,30);
148    print "Enter a password for this account: ";
149    if ($^O ne "MSWin32") {
150        system("stty -echo");
151    }
152    chomp(my $upass = <STDIN>);
153    if ($^O ne "MSWin32") {
154        system("stty echo");
155    }
156    $rps{$uname}{pass} = crypt($upass,mksalt());
157    $rps{$uname}{next} = $opts{rpbase};
158    $rps{$uname}{nick} = "";
159    $rps{$uname}{userhost} = "";
160    $rps{$uname}{level} = 0;
161    $rps{$uname}{online} = 0;
162    $rps{$uname}{idled} = 0;
163    $rps{$uname}{created} = time();
164    $rps{$uname}{lastlogin} = time();
165    $rps{$uname}{x} = int(rand($opts{mapx}));
166    $rps{$uname}{y} = int(rand($opts{mapy}));
167    $rps{$uname}{alignment}="n";
168    $rps{$uname}{isadmin} = 1;
169    for my $item ("Jouet","Arme de Precision","Bouffe","Arme de CaC","Casque (Rune 1)",
170                  "Tenue (Rune 3)","Rune de Force","Accessoire (Rune 2)",
171                  "Rune de Precision","Vehicule") {
172        $rps{$uname}{item}{$item} = 0;
173    }
174    for my $pen ("pen_mesg","pen_nick","pen_part",
175                 "pen_kick","pen_quit","pen_quest",
176                 "pen_logout","pen_logout") {
177        $rps{$uname}{$pen} = 0;
178    }
179    writedb();
180    print "OK, wrote you into $opts{dbfile}.\n";
181}
182
183# this is almost silly...
184if ($opts{checkupdates}) {
185    print "Checking for updates...\n\n";
186    my $tempsock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80",
187                                         Timeout => 15);
188    if ($tempsock) {
189        print $tempsock "GET /g7/version.php?version=$version HTTP/1.1\r\n".
190                        "Host: jotun.ultrazone.org:80\r\n\r\n";
191        my($line,$newversion);
192        while ($line=<$tempsock>) {
193            chomp($line);
194            next() unless $line;
195            if ($line =~ /^Current version : (\S+)/) {
196                if ($version ne $1) {
197                    print "There is an update available! Changes include:\n";
198                    $newversion=1;
199                }
200                else {
201                    print "You are running the latest version (v$1).\n";
202                    close($tempsock);
203                    last();
204                }
205            }
206            elsif ($newversion && $line =~ /^(  -? .+)/) { print "$1\n"; }
207            elsif ($newversion && $line =~ /^URL: (.+)/) {
208                print "\nGet the newest version from $1!\n";
209                close($tempsock);
210                last();
211            }
212        }
213    }
214    else { print debug("Could not connect to update server.")."\n"; }
215}
216
217print "\n".debug("Becoming a daemon...")."\n";
218daemonize();
219
220$SIG{HUP} = "readconfig"; # sighup = reread config file
221
222CONNECT: # cheese.
223
224loaddb();
225
226while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
227    debug("Connecting to $opts{servers}->[0]...");
228    my %sockinfo = (PeerAddr => $opts{servers}->[0],
229                    PeerPort => 6667);
230    if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }
231    $sock = IO::Socket::INET->new(%sockinfo) or
232        debug("Error: failed to connect: $!\n");
233    ++$conn_tries;
234    if (!$sock) {
235        # cycle front server to back if connection failed
236        push(@{$opts{servers}},shift(@{$opts{servers}}));
237    }
238    else { debug("Connected."); }
239}
240
241if (!$sock) {
242    debug("Error: Too many connection failures, exhausted server list.\n",1);
243}
244
245$conn_tries=0;
246
247$sel = IO::Select->new($sock);
248
249sts("NICK $opts{botnick}");
250sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");
251
252while (1) {
253    my($readable) = IO::Select->select($sel,undef,undef,0.5);
254    if (defined($readable)) {
255        my $fh = $readable->[0];
256        my $buffer2;
257        $fh->recv($buffer2,512,0);
258        if (length($buffer2)) {
259            $buffer .= $buffer2;
260            while (index($buffer,"\n") != -1) {
261                my $line = substr($buffer,0,index($buffer,"\n")+1);
262                $buffer = substr($buffer,length($line));
263                parse($line);
264            }
265        }
266        else {
267            # uh oh, we've been disconnected from the server, possibly before
268            # we've logged in the users in %auto_login. so, we'll set those
269            # users' online flags to 1, rewrite db, and attempt to reconnect
270            # (if that's wanted of us)
271            $rps{$_}{online}=1 for keys(%auto_login);
272            writedb();
273
274            close($fh);
275            $sel->remove($fh);
276
277            if ($opts{reconnect}) {
278                undef(@queue);
279                undef($sock);
280                debug("Socket closed; disconnected. Cleared outgoing message ".
281                      "queue. Waiting $opts{reconnect_wait}s before next ".
282                      "connection attempt...");
283                sleep($opts{reconnect_wait});
284                goto CONNECT;
285            }
286            else { debug("Socket closed; disconnected.",1); }
287        }
288    }
289    else { select(undef,undef,undef,1); }
290    if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
291}
292
293
294sub parse {
295    my($in) = shift;
296    $inbytes += length($in); # increase parsed byte count
297    $in =~ s/[\r\n]//g; # strip all \r and \n
298    debug("<- $in");
299    my @arg = split(/\s/,$in); # split into "words"
300    my $usernick = substr((split(/!/,$arg[0]))[0],1);
301    # logged in char name of nickname, or undef if nickname is not online
302    my $username = finduser($usernick);
303    if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
304    elsif (lc($arg[0]) eq 'error') {
305        # uh oh, we've been disconnected from the server, possibly before we've
306        # logged in the users in %auto_login. so, we'll set those users' online
307        # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
308        # us)
309        $rps{$_}{online}=1 for keys(%auto_login);
310        writedb();
311        return;
312    }
313    $arg[1] = lc($arg[1]); # original case no longer matters
314    if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
315        $opts{botnick} .= 0;
316        sts("NICK $opts{botnick}");
317    }
318    elsif ($arg[1] eq 'join') {
319        # %onchan holds time user joined channel. used for the advertisement ban
320        $onchan{$usernick}=time();
321        if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
322            delete($split{substr($arg[0],1)});
323        }
324        elsif ($opts{botnick} eq $usernick) {
325            sts("WHO $opts{botchan}");
326            (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
327            sts($opcmd);
328            $lasttime = time(); # start rpcheck()
329        }
330    }
331    elsif ($arg[1] eq 'quit') {
332        # if we see our nick come open, grab it (skipping queue)
333        if ($usernick eq $primnick) { sts("NICK $primnick",1); }
334        elsif ($opts{'detectsplits'} &&
335               "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
336            if (defined($username)) { # user was online
337                $split{substr($arg[0],1)}{time}=time();
338                $split{substr($arg[0],1)}{account}=$username;
339            }
340        }
341        else {
342            penalize($username,"quit");
343        }
344        delete($onchan{$usernick});
345    }
346    elsif ($arg[1] eq 'nick') {
347        # if someone (nickserv) changes our nick for us, update $opts{botnick}
348        if ($usernick eq $opts{botnick}) {
349            $opts{botnick} = substr($arg[2],1);
350        }
351        # if we see our nick come open, grab it (skipping queue), unless it was
352        # us who just lost it
353        elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
354        else {
355            penalize($username,"nick",$arg[2]);
356            $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
357        }
358    }
359    elsif ($arg[1] eq 'part') {
360        penalize($username,"part");
361        delete($onchan{$usernick});
362    }
363    elsif ($arg[1] eq 'kick') {
364        $usernick = $arg[3];
365        penalize(finduser($usernick),"kick");
366        delete($onchan{$usernick});
367    }
368    # don't penalize /notices to the bot
369    elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
370        penalize($username,"notice",length("@arg[3..$#arg]")-1);
371    }
372    elsif ($arg[1] eq '001') {
373        # send our identify command, set our usermode, join channel
374        sts($opts{botident});
375        sts("MODE $opts{botnick} :$opts{botmodes}");
376        sts("JOIN $opts{botchan}");
377        $opts{botchan} =~ s/ .*//; # strip channel key if present
378    }
379    elsif ($arg[1] eq '315') {
380        # 315 is /WHO end. report who we automagically signed online iff it will
381        # print < 1k of text
382        if (keys(%auto_login)) {
383            # not a true measure of size, but easy
384            if (length("%auto_login") < 1024 && $opts{senduserlist}) {
385                chanmsg(scalar(keys(%auto_login))." users matching ".
386                        scalar(keys(%prev_online))." hosts automatically ".
387                        "logged in; accounts: ".join(", ",keys(%auto_login)));
388            }
389            else {
390                chanmsg(scalar(keys(%auto_login))." users matching ".
391                        scalar(keys(%prev_online))." hosts automatically ".
392                        "logged in.");
393            }
394            if ($opts{voiceonlogin}) {
395                my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
396                while (@vnicks) {
397                    sts("MODE $opts{botchan} +".
398                        ('v' x $opts{modesperline})." ".
399                        join(" ",@vnicks[0..$opts{modesperline}-1]));
400                    splice(@vnicks,0,$opts{modesperline});
401                }
402            }
403        }
404        else { chanmsg("0 users qualified for auto login."); }
405        undef(%prev_online);
406        undef(%auto_login);
407    }
408    elsif ($arg[1] eq '005') {
409        if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
410    }
411    elsif ($arg[1] eq '352') {
412        my $user;
413        # 352 is one line of /WHO. check that the nick!user@host exists as a key
414        # in %prev_online, the list generated in loaddb(). the value is the user
415        # to login
416        $onchan{$arg[7]}=time();
417        if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
418            $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
419            $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
420        }
421    }
422    elsif ($arg[1] eq 'privmsg') {
423        $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
424        if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
425            $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
426            if ($arg[3] eq "\1version\1") {
427                notice("\1VERSION IRPG bot v$version by jotun; ".
428                       "http://idlerpg.net/\1",$usernick);
429            }
430            elsif ($arg[3] eq "peval") {
431                if (!ha($username) || ($opts{ownerpevalonly} &&
432                    $opts{owner} ne $username)) {
433                    privmsg("You don't have access to PEVAL.", $usernick);
434                }
435                else {
436                    my @peval = eval "@arg[4..$#arg]";
437                    if (@peval >= 4 || length("@peval") > 1024) {
438                        privmsg("Command produced too much output to send ".
439                                "outright; queueing ".length("@peval").
440                                " bytes in ".scalar(@peval)." items. Use ".
441                                "CLEARQ to clear queue if needed.",$usernick,1);
442                        privmsg($_,$usernick) for @peval;
443                    }
444                    else { privmsg($_,$usernick, 1) for @peval; }
445                    privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
446                }
447            }
448            elsif ($arg[3] eq "register") {
449                if (defined $username) {
450                    privmsg("Sorry, you are already online as $username.",
451                            $usernick);
452                }
453                else {
454                    if ($#arg < 6 || $arg[6] eq "") {
455                        privmsg("Try: REGISTER <char name> <password> <class>",
456                                $usernick);
457                        privmsg("IE : REGISTER Poseidon MyPassword God of the ".
458                                "Sea",$usernick);
459                    }
460                    elsif ($pausemode) {
461                        privmsg("Sorry, new accounts may not be registered ".
462                                "while the bot is in pause mode; please wait ".
463                                "a few minutes and try again.",$usernick);
464                    }
465                    elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
466                           scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
467                        privmsg("Sorry, that character name is already in use.",
468                                $usernick);
469                    }
470                    elsif (lc($arg[4]) eq lc($opts{botnick}) ||
471                           lc($arg[4]) eq lc($primnick)) {
472                        privmsg("Sorry, that character name cannot be ".
473                                "registered.",$usernick);
474                    }
475                    elsif (!exists($onchan{$usernick})) {
476                        privmsg("Sorry, you're not in $opts{botchan}.",
477                                $usernick);
478                    }
479                    elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
480                        privmsg("Sorry, character names must be < 17 and > 0 ".
481                                "chars long.", $usernick);
482                    }
483                    elsif ($arg[4] =~ /^#/) {
484                        privmsg("Sorry, character names may not begin with #.",
485                                $usernick);
486                    }
487                    elsif ($arg[4] =~ /\001/) {
488                        privmsg("Sorry, character names may not include ".
489                                "character \\001.",$usernick);
490                    }
491                    elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
492                           "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
493                        privmsg("Sorry, neither character names nor classes ".
494                                "may include control codes.",$usernick);
495                    }
496                    elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
497                           "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
498                        privmsg("Sorry, neither character names nor classes ".
499                                "may include non-printable chars.",$usernick);
500                    }
501                    elsif (length("@arg[6..$#arg]") > 30) {
502                        privmsg("Sorry, character classes must be < 31 chars ".
503                                "long.",$usernick);
504                    }
505                    elsif (time() == $lastreg) {
506                        privmsg("Wait 1 second and try again.",$usernick);               
507                    }
508                    else {
509                        if ($opts{voiceonlogin}) {
510                            sts("MODE $opts{botchan} +v :$usernick");
511                        }
512                        ++$registrations;
513                        $lastreg = time();
514                        $rps{$arg[4]}{next} = $opts{rpbase};
515                        $rps{$arg[4]}{class} = "@arg[6..$#arg]";
516                        $rps{$arg[4]}{level} = 0;
517                        $rps{$arg[4]}{online} = 1;
518                        $rps{$arg[4]}{nick} = $usernick;
519                        $rps{$arg[4]}{userhost} = $arg[0];
520                        $rps{$arg[4]}{created} = time();
521                        $rps{$arg[4]}{lastlogin} = time();
522                        $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
523                        $rps{$arg[4]}{x} = int(rand($opts{mapx}));
524                        $rps{$arg[4]}{y} = int(rand($opts{mapy}));
525                        $rps{$arg[4]}{alignment}="n";
526                        $rps{$arg[4]}{isadmin} = 0;
527                        for my $item ("Jouet","Arme de Precision","Bouffe","Arme de CaC","Casque (Rune 1)",
528                                      "Tenue (Rune 3)","Rune de Force","Accessoire (Rune 2)",
529                                      "Rune de Precision","Vehicule") {
530                            $rps{$arg[4]}{item}{$item} = 0;
531                        }
532                        for my $pen ("pen_mesg","pen_nick","pen_part",
533                                     "pen_kick","pen_quit","pen_quest",
534                                     "pen_logout","pen_logout") {
535                            $rps{$arg[4]}{$pen} = 0;
536                        }
537                        chanmsg(sprintf(gettext("Welcome %s\'s new player %s, ".
538            "the %s! Next level in %s."),
539          $usernick,$arg[4],@arg[6..$#arg],
540          duration($opts{rpbase})));
541                        privmsg("Success! Account $arg[4] created. You have ".
542                                "$opts{rpbase} seconds idleness until you ".
543                                "reach level 1. ", $usernick);
544                        privmsg("NOTE: The point of the game is to see who ".
545                                "can idle the longest. As such, talking in ".
546                                "the channel, parting, quitting, and changing ".
547                                "nicks all penalize you.",$usernick);
548                        if ($opts{phonehome}) {
549                            my $tempsock = IO::Socket::INET->new(PeerAddr=>
550                                "jotun.ultrazone.org:80");
551                            if ($tempsock) {
552                                print $tempsock
553                                    "GET /g7/count.php?new=1 HTTP/1.1\r\n".
554                                    "Host: jotun.ultrazone.org:80\r\n\r\n";
555                                sleep(1);
556                                close($tempsock);
557                            }
558                        }
559                    }
560                }
561            }
562            elsif ($arg[3] eq "delold") {
563                if (!ha($username)) {
564                    privmsg("You don't have access to DELOLD.", $usernick);
565                }
566                # insure it is a number
567                elsif ($arg[4] !~ /^[\d\.]+$/) {
568                    privmsg("Try: DELOLD <# of days>", $usernick, 1);
569                }
570                else {
571                    my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
572                                             ($arg[4] * 86400) &&
573                                             !$rps{$_}{online} } keys(%rps);
574                    delete(@rps{@oldaccounts});
575                    chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
576                            "the last $arg[4] days removed by $arg[0].");
577                }
578            }
579            elsif ($arg[3] eq "del") {
580                if (!ha($username)) {
581                    privmsg("Vous n'avez pas acces a DEL.", $usernick);
582                }
583                elsif (!defined($arg[4])) {
584                   privmsg("Essayez: DEL <nomduperso>", $usernick, 1);
585                }
586                elsif (!exists($rps{$arg[4]})) {
587                    privmsg("Pas de compte $arg[4].", $usernick, 1);
588                }
589                else {
590                    delete($rps{$arg[4]});
591                    chanmsg("Compte $arg[4] supprime par $arg[0].");
592                }
593            }
594            elsif ($arg[3] eq "mkadmin") {
595                if (!ha($username) || ($opts{owneraddonly} &&
596                    $opts{owner} ne $username)) {
597                    privmsg("Vous n avez pas acces a MKADMIN.", $usernick);
598                }
599                elsif (!defined($arg[4])) {
600                    privmsg("Essayez: MKADMIN <nomperso>", $usernick, 1);
601                }
602                elsif (!exists($rps{$arg[4]})) {
603                    privmsg("Pas de compte $arg[4].", $usernick, 1);
604                }
605                else {
606                    $rps{$arg[4]}{isadmin}=1;
607                    privmsg("Compte $arg[4] est maintenant un bot admin.",$usernick, 1);
608                }
609            }
610            elsif ($arg[3] eq "deladmin") {
611                if (!ha($username) || ($opts{ownerdelonly} &&
612                    $opts{owner} ne $username)) {
613                    privmsg("Vous n avez pas acces a DELADMIN.", $usernick);
614                }
615                elsif (!defined($arg[4])) {
616                    privmsg("Essayez: DELADMIN <nomperso>", $usernick, 1);
617                }
618                elsif (!exists($rps{$arg[4]})) {
619                    privmsg("Pas de compte $arg[4].", $usernick, 1);
620                }
621                elsif ($arg[4] eq $opts{owner}) {
622                    privmsg("Impossible de DELADMIN sur le compte du proprietaire.", $usernick, 1);
623                }
624                else {
625                    $rps{$arg[4]}{isadmin}=0;
626                    privmsg("Compte $arg[4] n est plus un compte admin.",
627                            $usernick, 1);
628                }
629            }
630            elsif ($arg[3] eq "hog") {
631                if (!ha($username)) {
632                    privmsg("Vous n avez pas acces a HOG.", $usernick);
633                }
634                else {
635                    chanmsg("$usernick a invoque la main de Schlavbeuk.");
636                    hog();
637                }
638            }
639            elsif ($arg[3] eq "rehash") {
640                if (!ha($username)) {
641                    privmsg("Vous n avez pas acces a REHASH.", $usernick);
642                }
643                else {
644                    readconfig();
645                    privmsg("Reread config file.",$usernick,1);
646                    $opts{botchan} =~ s/ .*//; # strip channel key if present
647                }
648            }
649            elsif ($arg[3] eq "chpass") {
650                if (!ha($username)) {
651                    privmsg("Vous n avez pas acces a CHPASS.", $usernick);
652                }
653                elsif (!defined($arg[5])) {
654                    privmsg("Essayez: CHPASS <nomperso> <nouveaupass>", $usernick, 1);
655                }
656                elsif (!exists($rps{$arg[4]})) {
657                    privmsg("Pas de perso nomme $arg[4].", $usernick, 1);
658                }
659                else {
660                    $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
661                    privmsg("Le mot de passe pour $arg[4] est change.", $usernick, 1);
662                }
663            }
664            elsif ($arg[3] eq "chuser") {
665                if (!ha($username)) {
666                    privmsg("Vous n avez pas acces a CHUSER.", $usernick);
667                }
668                elsif (!defined($arg[5])) {
669                    privmsg("Essayez: CHUSER <nomperso> <nouveaunomperso>",
670                            $usernick, 1);
671                }
672                elsif (!exists($rps{$arg[4]})) {
673                    privmsg("Pas de perso nomme $arg[4].", $usernick, 1);
674                }
675                elsif (exists($rps{$arg[5]})) {
676                    privmsg("Le nom $arg[5] est deja pris.", $usernick,1);
677                }
678                else {
679                    $rps{$arg[5]} = delete($rps{$arg[4]});
680                    privmsg("Le nom de perso $arg[4] est change en $arg[5].",
681                            $usernick, 1);
682                }
683            }
684            elsif ($arg[3] eq "chclass") {
685                if (!ha($username)) {
686                    privmsg("Vous n avez pas acces a CHCLASS.", $usernick);
687                }
688                elsif (!defined($arg[5])) {
689                    privmsg("Essayez: CHCLASS <nomperso> <nouvelleclasse>",
690                            $usernick, 1);
691                }
692                elsif (!exists($rps{$arg[4]})) {
693                    privmsg("Pas de perso $arg[4].", $usernick, 1);
694                }
695                else {
696                    $rps{$arg[4]}{class} = "@arg[5..$#arg]";
697                    privmsg("La classe de $arg[4] est change en @arg[5..$#arg].",
698                            $usernick, 1);
699                }
700            }
701            elsif ($arg[3] eq "push") {
702                if (!ha($username)) {
703                    privmsg("Vous n avez pas acces a PUSH.", $usernick);
704                }
705                # insure it's a positive or negative, integral number of seconds
706                elsif ($arg[5] !~ /^\-?\d+$/) {
707                    privmsg("Essayez: PUSH <nomperso> <secondes>", $usernick, 1);
708                }
709                elsif (!exists($rps{$arg[4]})) {
710                    privmsg("Pas de compte $arg[4].", $usernick, 1);
711                }
712                elsif ($arg[5] > $rps{$arg[4]}{next}) {
713                    privmsg("Le temps pour changer de niveau de $arg[4] ($rps{$arg[4]}{next}s) ".
714                            "est plus petit que $arg[5]; mise a 0 du compteur.",
715                            $usernick, 1);
716                    chanmsg("$usernick a pousse $arg[4] $rps{$arg[4]}{next} ".
717                            "secondes vers le niveau ".($rps{$arg[4]}{level}+1));
718                    $rps{$arg[4]}{next}=0;
719                }
720                else {
721                    $rps{$arg[4]}{next} -= $arg[5];
722                     chanmsg("$usernick a pousse $arg[4] $arg[5] secondes ".
723                             "vers le niveau ".($rps{$arg[4]}{level}+1).". ".
724                             "$arg[4] atteindra le niveau suivant dans ".
725                             duration($rps{$arg[4]}{next}).".");
726                }
727            }   
728            elsif ($arg[3] eq "logout") {
729                if (defined($username)) {
730                    penalize($username,"logout");
731                }
732                else {
733                    privmsg("Vous n etes pas connecte.", $usernick);
734                }
735            }
736            elsif ($arg[3] eq "quest") {
737                if (!@{$quest{questers}}) {
738                    privmsg("Il n y a pas de quete active.",$usernick);
739                }
740                elsif ($quest{type} == 1) {
741                    privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
742                            "$quest{questers}->[3] are on a quest to ".
743                            "$quest{text}. Quest to complete in ".
744                            duration($quest{qtime}-time()).".",$usernick);
745                }
746                elsif ($quest{type} == 2) {
747                    privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
748                            "$quest{questers}->[3] are on a quest to ".
749                            "$quest{text}. Participants must first reach ".
750                            "[$quest{p1}->[0],$quest{p1}->[1]], then ".
751                            "[$quest{p2}->[0],$quest{p2}->[1]].".
752                            ($opts{mapurl}?" See $opts{mapurl} to monitor ".
753                            "their journey's progress.":""),$usernick);
754                }
755            }
756            elsif ($arg[3] eq "status" && $opts{statuscmd}) {
757                if (!defined($username)) {
758                    privmsg("Vous n etes pas connecte.", $usernick);
759                }
760                # argument is optional
761                elsif ($arg[4] && !exists($rps{$arg[4]})) {
762                    privmsg("No such user.",$usernick);
763                }
764                elsif ($arg[4]) { # optional 'user' argument
765                    privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
766                            "$rps{$arg[4]}{class}; Status: O".
767                            ($rps{$arg[4]}{online}?"n":"ff")."line; ".
768                            "TTL: ".duration($rps{$arg[4]}{next})."; ".
769                            "Idled: ".duration($rps{$arg[4]}{idled}).
770                            "; Item sum: ".itemsum($arg[4]),$usernick);
771                }
772                else { # no argument, look up this user
773                    privmsg("$username: Level $rps{$username}{level} ".
774                            "$rps{$username}{class}; Status: O".
775                            ($rps{$username}{online}?"n":"ff")."line; ".
776                            "TTL: ".duration($rps{$username}{next})."; ".
777                            "Idled: ".duration($rps{$username}{idled})."; ".
778                            "Item sum: ".itemsum($username),$usernick);
779                }
780            }
781            elsif ($arg[3] eq "whoami") {
782                if (!defined($username)) {
783                    privmsg("Vous n etes pas connecte.", $usernick);
784                }
785                else {
786                    privmsg("Vous etes $username, le niveau ".
787                            $rps{$username}{level}." $rps{$username}{class}. ".
788                            "Prochain Level dans ".duration($rps{$username}{next}),
789                            $usernick);
790                }
791            }
792            elsif ($arg[3] eq "newpass") {
793                if (!defined($username)) {
794                    privmsg("Vous n etes pas connecte.", $usernick)
795                }
796                elsif (!defined($arg[4])) {
797                    privmsg("Essayez : NEWPASS <nouveaumotdepasse>", $usernick);
798                }
799                else {
800                    $rps{$username}{pass} = crypt($arg[4],mksalt());
801                    privmsg("Your password was changed.",$usernick);
802                }
803            }
804            elsif ($arg[3] eq "align") {
805                if (!defined($username)) {
806                    privmsg("Vous n etes pas connecte.", $usernick)
807                }
808                elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" && 
809                       lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
810                    privmsg("Try: ALIGN <good|neutral|evil>", $usernick);
811                }
812                else {
813                    $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
814                    chanmsg("$username has changed alignment to: ".lc($arg[4]).
815                            ".");
816                    privmsg("Votre alignement a ete change, Vous etes maintenant ".lc($arg[4]).".",
817                            $usernick);
818                }
819            }
820            elsif ($arg[3] eq "removeme") {
821                if (!defined($username)) {
822                    privmsg("Vous n etes pas connecte.", $usernick)
823                }
824                else {
825                    privmsg("Compte $username supprime.",$usernick);
826                    chanmsg("$arg[0] removed his account, $username, the ".
827                            $rps{$username}{class}.".");
828                    delete($rps{$username});
829                }
830            }
831            elsif ($arg[3] eq "help") {
832                if (!ha($username)) {
833                    privmsg("Pour avoir des infos sur les commandes IRPG, allez voir ".
834                            $opts{helpurl}, $usernick);
835                }
836                else {
837                    privmsg("Le site d'aide est $opts{helpurl}", $usernick, 1);
838                    privmsg("Admin commands URL is $opts{admincommurl}",
839                            $usernick, 1);
840                }
841            }
842            elsif ($arg[3] eq "die") {
843                if (!ha($username)) {
844                    privmsg("Vous n'avez pas acces a DIE.", $usernick);
845                }
846                else {
847                    $opts{reconnect} = 0;
848                    writedb();
849                    sts("QUIT :DIE from $arg[0]",1);
850                }
851            }
852            elsif ($arg[3] eq "reloaddb") {
853                if (!ha($username)) {
854                    privmsg("Vous n'avez pas acces a RELOADDB.", $usernick);
855                }
856                elsif (!$pausemode) {
857                    privmsg("ERROR: Can only use LOADDB while in PAUSE mode.",
858                            $usernick, 1);
859                }
860                else {
861                    loaddb();
862                    privmsg("Reread player database file; ".scalar(keys(%rps)).
863                            " accounts loaded.",$usernick,1);
864                }
865            }
866            elsif ($arg[3] eq "backup") {
867                if (!ha($username)) {
868                    privmsg("Vous n avez pas acces a BACKUP.", $usernick);
869                }
870                else {
871                    backup();
872                    privmsg("$opts{dbfile} copied to ".
873                            ".dbbackup/$opts{dbfile}".time(),$usernick,1);
874                }
875            }
876            elsif ($arg[3] eq "pause") {
877                if (!ha($username)) {
878                    privmsg("Vous n avez pas acces a PAUSE.", $usernick);
879                }
880                else {
881                    $pausemode = $pausemode ? 0 : 1;
882                    privmsg("PAUSE_MODE mis a $pausemode.",$usernick,1);
883                }
884            }
885            elsif ($arg[3] eq "silent") {
886                if (!ha($username)) {
887                    privmsg("Vous n avez pas acces a SILENT.", $usernick);
888                }
889                elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
890                    privmsg("Essayez: SILENT <mode>", $usernick,1);
891                }
892                else {
893                    $silentmode = $arg[4];
894                    privmsg("SILENT_MODE mis a $silentmode.",$usernick,1);
895                }
896            }
897            elsif ($arg[3] eq "jump") {
898                if (!ha($username)) {
899                    privmsg("Vous n avez pas acces a JUMP.", $usernick);
900                }
901                elsif (!defined($arg[4])) {
902                    privmsg("Try: JUMP <server[:port]>", $usernick, 1);
903                }
904                else {
905                    writedb();
906                    sts("QUIT :JUMP to $arg[4] from $arg[0]");
907                    unshift(@{$opts{servers}},$arg[4]);
908                    close($sock);
909                    sleep(3);
910                    goto CONNECT;
911                }
912            }
913            elsif ($arg[3] eq "restart") {
914                if (!ha($username)) {
915                    privmsg("Vous n avez pas acces a RESTART.", $usernick);
916                }
917                else {
918                    writedb();
919                    sts("QUIT :RESTART de $arg[0]",1);
920                    close($sock);
921                    exec("perl $0");
922                }
923            }
924            elsif ($arg[3] eq "clearq") {
925                if (!ha($username)) {
926                    privmsg("Vous n avez pas a acces a CLEARQ.", $usernick);
927                }
928                else {
929                    undef(@queue);
930                    chanmsg("Outgoing message queue cleared by $arg[0].");
931                    privmsg("Outgoing message queue cleared.",$usernick,1);
932                }
933            }
934            elsif ($arg[3] eq "info") {
935                my $info;
936                if (!ha($username) && $opts{allowuserinfo}) {
937                    $info = "IRPG bot v$version par jotun ".
938                            "http://idlerpg.net/. On via server: ".
939                            $opts{servers}->[0].". Admins online: ".
940                            join(", ", map { $rps{$_}{nick} }
941                                      grep { $rps{$_}{isadmin} &&
942                                             $rps{$_}{online} } keys(%rps)).".";
943                    privmsg($info, $usernick);
944                }
945                elsif (!ha($username) && !$opts{allowuserinfo}) {
946                    privmsg("Vous n avez pas acces a INFO.", $usernick);
947                }
948                else {
949                    my $queuedbytes = 0;
950                    $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
951                    $info = sprintf(
952                        "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
953                        "online of %d total users. %d accounts created since ".
954                        "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
955                        "Outgoing queue is %d bytes in %d items. On via: %s. ".
956                        "Admins online: %s.",
957                        $outbytes/1024,
958                        $inbytes/1024,
959                        duration(time()-$^T),
960                        scalar(grep { $rps{$_}{online} } keys(%rps)),
961                        scalar(keys(%rps)),
962                        $registrations,
963                        $pausemode,
964                        $silentmode,
965                        $queuedbytes,
966                        scalar(@queue),
967                        $opts{servers}->[0],
968                        join(", ",map { $rps{$_}{nick} }
969                                  grep { $rps{$_}{isadmin} && $rps{$_}{online} }
970                                  keys(%rps)));
971                    privmsg($info, $usernick, 1);
972                }
973            }
974            elsif ($arg[3] eq "login") {
975                if (defined($username)) {
976                    notice("Desole, vous etes deja online en tant que $username.",
977                            $usernick);
978                }
979                else {
980                    if ($#arg < 5 || $arg[5] eq "") {
981                        notice("Essayez : LOGIN <nomdutilisateur> <motdepasse>", $usernick);
982                    }
983                    elsif (!exists $rps{$arg[4]}) {
984                        notice("Desole, aucun compte de ce nom. Attention les noms de compte ".
985                                "tiennent compte des majuscules.",$usernick);
986                    }
987                    elsif (!exists $onchan{$usernick}) {
988                        notice("Desole, vous n etes pas dans $opts{botchan}.",
989                                $usernick);
990                    }
991                    elsif ($rps{$arg[4]}{pass} ne
992                           crypt($arg[5],$rps{$arg[4]}{pass})) {
993                        notice("Wrong password.", $usernick);
994                    }
995                    else {
996                        if ($opts{voiceonlogin}) {
997                            sts("MODE $opts{botchan} +v :$usernick");
998                        }
999                        $rps{$arg[4]}{online} = 1;
1000                        $rps{$arg[4]}{nick} = $usernick;
1001                        $rps{$arg[4]}{userhost} = $arg[0];
1002                        $rps{$arg[4]}{lastlogin} = time();
1003                        chanmsg("$arg[4], the level $rps{$arg[4]}{level} ".
1004                                "$rps{$arg[4]}{class}, is now online from ".
1005                                "nickname $usernick. Next level in ".
1006                                duration($rps{$arg[4]}{next}).".");
1007                        notice("Logon successful. Next level in ".
1008                               duration($rps{$arg[4]}{next}).".", $usernick);
1009                    }
1010                }
1011            }
1012        }
1013        # penalize returns true if user was online and successfully penalized.
1014        # if the user is not logged in, then penalize() fails. so, if user is
1015        # offline, and they say something including "http:", and they've been on
1016        # the channel less than 90 seconds, and the http:-style ban is on, then
1017        # check to see if their url is in @{$opts{okurl}}. if not, kickban them
1018        elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
1019               index(lc("@arg[3..$#arg]"),"http:") != -1 &&
1020               (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
1021            my $isokurl = 0;
1022            for (@{$opts{okurl}}) {
1023                if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
1024            }
1025            if (!$isokurl) {
1026                sts("MODE $opts{botchan} +b $arg[0]");
1027                sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
1028                    "be lifted within the hour.");
1029                push(@bans,$arg[0]) if @bans < 12;
1030            }
1031        }
1032    }
1033}
1034
1035sub sts { # send to server
1036    my($text,$skipq) = @_;
1037    if ($skipq) {
1038        if ($sock) {
1039            print $sock "$text\r\n";
1040            $outbytes += length($text) + 2;
1041            debug("-> $text");
1042        }
1043        else {
1044            # something is wrong. the socket is closed. clear the queue
1045            undef(@queue);
1046            debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
1047            return;
1048        }
1049    }
1050    else {
1051        push(@queue,$text);
1052        debug(sprintf("(q%03d) = %s\n",$#queue,$text));
1053    }
1054}
1055
1056sub fq { # deliver message(s) from queue
1057    if (!@queue) {
1058        ++$freemessages if $freemessages < 4;
1059        return undef;
1060    }
1061    my $sentbytes = 0;
1062    for (0..$freemessages) {
1063        last() if !@queue; # no messages left to send
1064        # lower number of "free" messages we have left
1065        my $line=shift(@queue);
1066        # if we have already sent one message, and the next message to be sent
1067        # plus the previous messages we have sent this call to fq() > 768 bytes,
1068        # then requeue this message and return. we don't want to flood off,
1069        # after all
1070        if ($_ != 0 && (length($line)+$sentbytes) > 768) {
1071            unshift(@queue,$line);
1072            last();
1073        }
1074        if ($sock) {
1075            debug("(fm$freemessages) -> $line");
1076            --$freemessages if $freemessages > 0;
1077            print $sock "$line\r\n";
1078            $sentbytes += length($line) + 2;
1079        }
1080        else {
1081            undef(@queue);
1082            debug("Disconnected: cleared outgoing message queue.");
1083            last();
1084        }
1085        $outbytes += length($line) + 2;
1086    }
1087}
1088
1089sub duration { # return human duration of seconds
1090    my $s = shift;
1091    return "NA ($s)" if $s !~ /^\d+$/;
1092    return sprintf("%d day%s, %02d:%02d:%02d",$s/86400,int($s/86400)==1?"":"s",
1093                   ($s%86400)/3600,($s%3600)/60,($s%60));
1094}
1095
1096sub ts { # timestamp
1097    my @ts = localtime(time());
1098    return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
1099                   $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
1100}
1101
1102sub hog { # summon the hand of god
1103    my @players = grep { $rps{$_}{online} } keys(%rps);
1104    my $player = $players[rand(@players)];
1105    my $win = int(rand(5));
1106    my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
1107    if ($win) {
1108        chanmsg(clog("Schlavbeuk est descendu des cieux et, dans sa grandes bonte, ".
1109                     "a accorde sa benediction a $player ".
1110                     duration($time)." pour le niveau ".($rps{$player}{level}+1).
1111                     "."));
1112        $rps{$player}{next} -= $time;
1113    }
1114    else {
1115        chanmsg(clog("Schlavbeuk, ayant un peu trop force sur la biere ".
1116                     "et a lance quelques eclairs au hasard... $player etait au mauvais endroit au mauvais moment ".
1117                     duration($time)." from level ".($rps{$player}{level}+1).
1118                     "."));
1119        $rps{$player}{next} += $time;
1120    }
1121    chanmsg("$player aura atteint le prochain niveau dans ".duration($rps{$player}{next}).".");
1122}
1123
1124sub rpcheck { # check levels, update database
1125    # check splits hash to see if any split users have expired
1126    checksplits() if $opts{detectsplits};
1127    # send out $freemessages lines of text from the outgoing message queue
1128    fq();
1129    # clear registration limiting
1130    $lastreg = 0;
1131    my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
1132    # there's really nothing to do here if there are no online users
1133    return unless $online;
1134    my $onlineevil = scalar(grep { $rps{$_}{online} &&
1135                                   $rps{$_}{alignment} eq "e" } keys(%rps));
1136    my $onlinegood = scalar(grep { $rps{$_}{online} &&
1137                                   $rps{$_}{alignment} eq "g" } keys(%rps));
1138    if (!$opts{noscale}) {
1139        if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
1140        if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
1141        if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
1142        if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
1143    }
1144    else {
1145        hog() if rand(4000) < 1;
1146        team_battle() if rand(4000) < 1;
1147        calamity() if rand(4000) < 1;
1148        godsend() if rand(2000) < 1;
1149    }
1150    if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
1151    if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
1152
1153    moveplayers();
1154   
1155    # statements using $rpreport do not bother with scaling by the clock because
1156    # $rpreport is adjusted by the number of seconds since last rpcheck()
1157    if ($rpreport%120==0 && $opts{writequestfile}) { writequestfile(); }
1158    if (time() > $quest{qtime}) {
1159        if (!@{$quest{questers}}) { quest(); }
1160        elsif ($quest{type} == 1) {
1161            chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", and ".
1162                         "$quest{questers}->[3] have blessed the realm by ".
1163                         "completing their quest! 25% of their burden is ".
1164                         "eliminated."));
1165            for (@{$quest{questers}}) {
1166                $rps{$_}{next} = int($rps{$_}{next} * .75);
1167            }
1168            undef(@{$quest{questers}});
1169            $quest{qtime} = time() + 21600;
1170        }
1171        # quest type 2 awards are handled in moveplayers()
1172    }
1173    if ($rpreport && $rpreport%36000==0) { # 10 hours
1174        my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
1175                       $rps{$a}{next}  <=> $rps{$b}{next} } keys(%rps);
1176        chanmsg("Idle RPG Top Players:") if @u;
1177        for my $i (0..2) {
1178            $#u >= $i and
1179            chanmsg("$u[$i], the level $rps{$u[$i]}{level} ".
1180                    "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ".
1181                    (duration($rps{$u[$i]}{next})).".");
1182        }
1183        backup();
1184    }
1185    if ($rpreport%3600==0 && $rpreport) { # 1 hour
1186        my @players = grep { $rps{$_}{online} &&
1187                             $rps{$_}{level} > 44 } keys(%rps);
1188        # 20% of all players must be level 45+
1189        if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
1190            challenge_opp($players[int(rand(@players))]);
1191        }
1192        while (@bans) {
1193            sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
1194            splice(@bans,0,4);
1195        }
1196    }
1197    if ($rpreport%1800==0) { # 30 mins
1198        if ($opts{botnick} ne $primnick) {
1199            sts($opts{botghostcmd}) if $opts{botghostcmd};
1200            sts("NICK $primnick");
1201        }
1202    }
1203    if ($rpreport%600==0 && $pausemode) { # warn every 10m
1204        chanmsg("WARNING: Cannot write database in PAUSE mode!");
1205    }
1206    # do not write in pause mode, and do not write if not yet connected. (would
1207    # log everyone out if the bot failed to connect. $lasttime = time() on
1208    # successful join to $opts{botchan}, initial value is 1). if fails to open
1209    # $opts{dbfile}, will not update $lasttime and so should have correct values
1210    # on next rpcheck().
1211    if ($lasttime != 1) {
1212        my $curtime=time();
1213        for my $k (keys(%rps)) {
1214            if ($rps{$k}{online} && exists $rps{$k}{nick} &&
1215                $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
1216                $rps{$k}{next} -= ($curtime - $lasttime);
1217                $rps{$k}{idled} += ($curtime - $lasttime);
1218                if ($rps{$k}{next} < 1) {
1219                    $rps{$k}{level}++;
1220                    if ($rps{$k}{level} > 60) {
1221                        $rps{$k}{next} = int(($opts{rpbase} *
1222                                             ($opts{rpstep}**60)) +
1223                                             (86400*($rps{$k}{level} - 60)));
1224                    }
1225                    else {
1226                        $rps{$k}{next} = int($opts{rpbase} *
1227                                             ($opts{rpstep}**$rps{$k}{level}));
1228                    }
1229                    chanmsg("$k, the $rps{$k}{class}, has attained level ".
1230                            "$rps{$k}{level}! Next level in ".
1231                            duration($rps{$k}{next}).".");
1232                    find_item($k);
1233                    challenge_opp($k);
1234                }
1235            }
1236            # attempt to make sure this is an actual user, and not just an
1237            # artifact of a bad PEVAL
1238        }
1239        if (!$pausemode && $rpreport%60==0) { writedb(); }
1240        $rpreport += $opts{self_clock};
1241        $lasttime = $curtime;
1242    }
1243}
1244
1245sub challenge_opp { # pit argument player against random player
1246    my $u = shift;
1247    if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
1248    my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
1249    return unless @opps;
1250    my $opp = $opps[int(rand(@opps))];
1251    $opp = $primnick if rand(@opps+1) < 1;
1252    my $mysum = itemsum($u,1);
1253    my $oppsum = itemsum($opp,1);
1254    my $myroll = int(rand($mysum));
1255    my $opproll = int(rand($oppsum));
1256    if ($myroll >= $opproll) {
1257        my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
1258        $gain = 7 if $gain < 7;
1259        $gain = int(($gain/100)*$rps{$u}{next});
1260        chanmsg(clog("$u [$myroll/$mysum] a defie $opp [$opproll/".
1261                     "$oppsum] en duel et a gagne! ".duration($gain)." est ".
1262                     "enleve du compteur de $u\ ."));
1263        $rps{$u}{next} -= $gain;
1264        chanmsg("$u atteint le prochain niveau dans ".duration($rps{$u}{next}).".");
1265        my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
1266                       $rps{$u}{alignment} eq "e" ? 20 :
1267                       35;
1268        if (rand($csfactor) < 1 && $opp ne $primnick) {
1269            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1270            chanmsg(clog("$u has dealt $opp a Critical Strike! ".
1271                         duration($gain)." is added to $opp\'s clock."));
1272            $rps{$opp}{next} += $gain;
1273            chanmsg("$opp atteint le prochain niveau dans ".duration($rps{$opp}{next}).
1274                    ".");
1275        }
1276        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
1277            my @items = ("Jouet","Arme de Precision","Bouffe","Arme","Casque (Rune 1)","Tenue (Rune 3)",
1278                         "Rune de Force","Rune de Precision","Accessoire (Rune 2)",
1279                         "Vehicule");
1280            my $type = $items[rand(@items)];
1281            if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
1282                chanmsg(clog("Durant cette bataille acharnee, $opp a perdu son objet niveau ".
1283                             int($rps{$opp}{item}{$type})." $type! $u le prends ".
1284                             "jettant son ancien objet ".
1285                             int($rps{$u}{item}{$type})." $type to $opp."));
1286                my $tempitem = $rps{$u}{item}{$type};
1287                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
1288                $rps{$opp}{item}{$type} = $tempitem;
1289            }
1290        }
1291    }
1292    else {
1293        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
1294        $gain = 7 if $gain < 7;
1295        $gain = int(($gain/100)*$rps{$u}{next});
1296        chanmsg(clog("$u [$myroll/$mysum] a defie $opp [$opproll/".
1297                     "$oppsum] en duel et a perdu! ".duration($gain)." est ".
1298                     "ajoute au compteur de $u\'s ."));
1299        $rps{$u}{next} += $gain;
1300        chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
1301    }
1302}
1303
1304sub team_battle { # choisit 3 joueurs contre 3 autres joueurs
1305    my @opp = grep { $rps{$_}{online} } keys(%rps);
1306    return if @opp < 6;
1307    splice(@opp,int(rand(@opp)),1) while @opp > 6;
1308    fisher_yates_shuffle(\@opp);
1309    my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
1310    my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
1311    my $gain = $rps{$opp[0]}{next};
1312    for my $p (1,2) {
1313        $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
1314    }
1315    $gain = int($gain*.20);
1316    my $myroll = int(rand($mysum));
1317    my $opproll = int(rand($oppsum));
1318    if ($myroll >= $opproll) {
1319        chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] ont defié ".
1320                     "l equipe de $opp[3], $opp[4], et $opp[5] [$opproll/".
1321                     "$oppsum] et ont gagne! ".duration($gain)." est enleve de ".
1322                     "leur compteur."));
1323        $rps{$opp[0]}{next} -= $gain;
1324        $rps{$opp[1]}{next} -= $gain;
1325        $rps{$opp[2]}{next} -= $gain;
1326    }
1327    else {
1328        chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] ont defie ".
1329                     "l equipe de $opp[3], $opp[4], et $opp[5] [$opproll/".
1330                     "$oppsum] et ont perdu! ".duration($gain)." est ajoute a ".
1331                     "leur compteur."));
1332        $rps{$opp[0]}{next} += $gain;
1333        $rps{$opp[1]}{next} += $gain;
1334        $rps{$opp[2]}{next} += $gain;
1335    }
1336}
1337
1338sub find_item { # find item for argument player
1339    my $u = shift;
1340    my @items = ("Jouet","Arme de Precision","Bouffe","Arme","Casque (Rune 1)","Tenue (Rune 3)",
1341                 "Rune de Force","Rune de Precision","Accessoire (Rune 2)","Vehicule");
1342    my $type = $items[rand(@items)];
1343    my $level = 1;
1344    my $ulevel;
1345    for my $num (1 .. int($rps{$u}{level}*1.5)) {
1346        if (rand(1.4**($num/4)) < 1) {
1347            $level = $num;
1348        }
1349    }
1350    if ($rps{$u}{level} >= 25 && rand(40) < 1) {
1351        $ulevel = 50+int(rand(25));
1352        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Casque (Rune 1)"})) {
1353            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1354                   "trouvez le Casque de niveau $ulevel de Hunnin Avherty Envodeux le Viking Nain ! ".
1355                   "Vous anticipez les mouvements de tout vos ennemis et vous en ".
1356                   "debarrassez aisement.",$rps{$u}{nick});
1357            $rps{$u}{item}{"Casque (Rune 1)"} = $ulevel."a";
1358            return;
1359        }
1360    }
1361    elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
1362        $ulevel = 50+int(rand(25));
1363        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{Jouet})) {
1364            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1365                   "trouvez le pistolet a retro propulsion plasmatique de SPOOK de niveau $ulevel ".
1366                   "Vous envoyez tous vos ennemis valdaguer ailleurs".
1367                   "voir si vous y etes.",
1368                   $rps{$u}{nick});
1369            $rps{$u}{item}{Jouet} = $ulevel."h";
1370            return;
1371        }
1372    }
1373    elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
1374        $ulevel = 75+int(rand(25));
1375        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Tenue (Rune 3)"})) {
1376            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1377                   "trouvez la Combinaison de Bionain Cameleon deniveau $ulevel".
1378                   "Plus rien ne vous atteint avec cette protection integrale ".
1379                   "(jusqu'a la coquille en titane pour les parties sensibles).",$rps{$u}{nick});
1380            $rps{$u}{item}{"Tenue (Rune 3)"} = $ulevel."b";
1381            return;
1382        }
1383    }
1384    elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
1385        $ulevel = 100+int(rand(25));
1386        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Arme de Precision"})) {
1387            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1388                   "trouvez la Patate Nucleaire de niveau $ulevel ".
1389                   "Grace a sa portee hors du commun, ".
1390                   "plus personne n echappe a votre puissance",$rps{$u}{nick});
1391            $rps{$u}{item}{"Arme de Precision"} = $ulevel."c";
1392            return;
1393        }
1394    }
1395    elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
1396        $ulevel = 150+int(rand(25));
1397        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Arme de CaC"})) {
1398            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1399                   "trouvez la calculette scientifique en or retro-eclairee TI-9239073195 de niveau $ulevel".
1400                   "Avec elle vous vous sentez capable de decouvrir la valeur exacte de Pi ".
1401                   "et donnez mal a la tete a vos ennemis faibles en math.",$rps{$u}{nick});
1402            $rps{$u}{item}{"Arme de CaC"} = $ulevel."d";
1403            return;
1404        }
1405    }
1406    elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
1407        $ulevel = 175+int(rand(26));
1408        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Arme de CaC"})) {
1409            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1410                   "trouvez le legendaire Mega giga super gros coup de pied au cul de niveau $ulevel ".
1411                   "Vous commencez a infligez la douleur supreme a tous les derrieres".
1412                   "de vos ennemis.",$rps{$u}{nick});
1413            $rps{$u}{item}{"Arme de CaC"} = $ulevel."e";
1414            return;
1415        }
1416    }
1417    elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
1418        $ulevel = 250+int(rand(51));
1419        if ($ulevel >= $level && $ulevel >
1420            int($rps{$u}{item}{"Vehicule"})) {
1421            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1422                   "trouvez la brouette spatio-temporelle edition limitee Einst-Nain lui meme de niveau $ulevel ".
1423                   "Avec ca vous pouvez attaquer et fuir avant meme ".
1424                   "que vos ennemis reagissent.",$rps{$u}{nick});
1425            $rps{$u}{item}{"Vehicule"} = $ulevel."f";
1426            return;
1427        }
1428    }
1429    elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
1430        $ulevel = 300+int(rand(51));
1431        if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{"Arme de CaC"})) {
1432            notice("La divine lumiere de Schlavbeuk est sur vous ! Vous ".
1433                   "trouvez Le glaive de Schlavbeuk de niveau $ulevel ".
1434                   "C est l ultime glaive : il a ete beni par un pretre dans le vomi sacre".
1435                   "de Schlavbeuk apres une autre soiree trop arrosee.",$rps{$u}{nick});
1436            $rps{$u}{item}{"Arme de CaC"} = $ulevel."g";
1437            return;
1438        }
1439    }
1440    if ($level > int($rps{$u}{item}{$type})) {
1441        notice("Vous trouvez un objet de type $type de niveau $level ! Votre precedent $type est seulement ".
1442               "niveau " Votre precedent $type est seulement ".
1443               "niveau ".int($rps{$u}{item}{$type}).", donc il semble que la Chance soit ".
1444               "avec vous!",$rps{$u}{nick});
1445        $rps{$u}{item}{$type} = $level;
1446    }
1447    else {
1448        notice("Vous trouvez un objet de type $type de niveau $level ! Votre $type actuel est niveau ".
1449               int($rps{$u}{item}{$type}).", donc il semble que la Chance ne soit pas avec vous. ".
1450               "Vous jetez le $type.",$rps{$u}{nick});
1451    }
1452}
1453
1454sub loaddb { # load the players database
1455    backup();
1456    my $l;
1457    %rps = ();
1458    if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
1459        sts("QUIT :loaddb() failed: $!");
1460    }
1461    while ($l=<RPS>) {
1462        chomp($l);
1463        next if $l =~ /^#/; # skip comments
1464        my @i = split("\t",$l);
1465        print Dumper(@i) if @i != 32;
1466        if (@i != 32) {
1467            sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
1468                "wrong fields (".scalar(@i).")");
1469            debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
1470                "fields (".scalar(@i).")",1);
1471        }
1472        if (!$sock) { # if not RELOADDB
1473            if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
1474        }
1475        ($rps{$i[0]}{pass},
1476        $rps{$i[0]}{isadmin},
1477        $rps{$i[0]}{level},
1478        $rps{$i[0]}{class},
1479        $rps{$i[0]}{next},
1480        $rps{$i[0]}{nick},
1481        $rps{$i[0]}{userhost},
1482        $rps{$i[0]}{online},
1483        $rps{$i[0]}{idled},
1484        $rps{$i[0]}{x},
1485        $rps{$i[0]}{y},
1486        $rps{$i[0]}{pen_mesg},
1487        $rps{$i[0]}{pen_nick},
1488        $rps{$i[0]}{pen_part},
1489        $rps{$i[0]}{pen_kick},
1490        $rps{$i[0]}{pen_quit},
1491        $rps{$i[0]}{pen_quest},
1492        $rps{$i[0]}{pen_logout},
1493        $rps{$i[0]}{created},
1494        $rps{$i[0]}{lastlogin},
1495        $rps{$i[0]}{item}{"Arme de Precision"},
1496        $rps{$i[0]}{item}{Bouffe},
1497        $rps{$i[0]}{item}{"Casque (Rune 1)"},
1498        $rps{$i[0]}{item}{"Vehicule"},
1499        $rps{$i[0]}{item}{"Rune de Force"},
1500        $rps{$i[0]}{item}{Jouet},
1501        $rps{$i[0]}{item}{"Rune de Precision"},
1502        $rps{$i[0]}{item}{"Accessoire (Rune 2)"},
1503        $rps{$i[0]}{item}{"Tenue (Rune 3)"},
1504        $rps{$i[0]}{item}{"Arme de CaC"},
1505        $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
1506    }
1507    close(RPS);
1508    debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
1509          scalar(keys(%prev_online))." previously online.");
1510}
1511
1512sub moveplayers {
1513    return unless $lasttime > 1;
1514    my $onlinecount = grep { $rps{$_}{online} } keys %rps;
1515    return unless $onlinecount;
1516    for (my $i=0;$i<$opts{self_clock};++$i) {
1517        # temporary hash to hold player positions, detect collisions
1518        my %positions = ();
1519        if ($quest{type} == 2 && @{$quest{questers}}) {
1520            my $allgo = 1; # have all users reached <p1|p2>?
1521            for (@{$quest{questers}}) {
1522                if ($quest{stage}==1) {
1523                    if ($rps{$_}{x} != $quest{p1}->[0] ||
1524                        $rps{$_}{y} != $quest{p1}->[1]) {
1525                        $allgo=0;
1526                        last();
1527                    }
1528                }
1529                else {
1530                    if ($rps{$_}{x} != $quest{p2}->[0] ||
1531                        $rps{$_}{y} != $quest{p2}->[1]) {
1532                        $allgo=0;
1533                        last();
1534                    }
1535                }
1536            }
1537            # all participants have reached point 1, now point 2
1538            if ($quest{stage}==1 && $allgo) {
1539                $quest{stage}=2;
1540                $allgo=0; # have not all reached p2 yet
1541            }
1542            elsif ($quest{stage} == 2 && $allgo) {
1543                chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", ".
1544                             "and $quest{questers}->[3] have completed their ".
1545                             "journey! 25% of their burden is eliminated."));
1546                for (@{$quest{questers}}) {
1547                    $rps{$_}{next} = int($rps{$_}{next} * .75);
1548                }
1549                undef(@{$quest{questers}});
1550                $quest{qtime} = time() + 21600; # next quest starts in 6 hours
1551                $quest{type} = 1; # probably not needed
1552                writequestfile();
1553            }
1554            else {
1555                my(%temp,$player);
1556                # load keys of %temp with online users
1557                ++@temp{grep { $rps{$_}{online} } keys(%rps)};
1558                # delete questers from list
1559                delete(@temp{@{$quest{questers}}});
1560                while ($player = each(%temp)) {
1561                    $rps{$player}{x} += int(rand(3))-1;
1562                    $rps{$player}{y} += int(rand(3))-1;
1563                    # if player goes over edge, wrap them back around
1564                    if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
1565                    if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
1566                    if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
1567                    if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
1568                   
1569                    if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1570                        !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1571                        if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1572                            !$rps{$player}{isadmin} && rand(100) < 1) {
1573                            chanmsg("$player encounters ".
1574                               $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1575                                    " and bows humbly.");
1576                        }
1577                        if (rand($onlinecount) < 1) {
1578                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1579                            collision_fight($player,
1580                                $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1581                        }
1582                    }
1583                    else {
1584                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1585                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1586                    }
1587                }
1588                for (@{$quest{questers}}) {
1589                    if ($quest{stage} == 1) {
1590                        if (rand(100) < 1) {
1591                            if ($rps{$_}{x} != $quest{p1}->[0]) {
1592                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
1593                                                1 : -1);
1594                            }
1595                            if ($rps{$_}{y} != $quest{p1}->[1]) {
1596                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
1597                                                1 : -1);
1598                            }
1599                        }
1600                    }
1601                    elsif ($quest{stage}==2) {
1602                        if (rand(100) < 1) {
1603                            if ($rps{$_}{x} != $quest{p2}->[0]) {
1604                                $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
1605                                                1 : -1);
1606                            }
1607                            if ($rps{$_}{y} != $quest{p2}->[1]) {
1608                                $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
1609                                                1 : -1);
1610                            }
1611                        }
1612                    }
1613                }
1614            }
1615        }
1616        else {
1617            for my $player (keys(%rps)) {
1618                next unless $rps{$player}{online};
1619                $rps{$player}{x} += int(rand(3))-1;
1620                $rps{$player}{y} += int(rand(3))-1;
1621                # if player goes over edge, wrap them back around
1622                if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
1623                if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
1624                if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
1625                if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
1626                if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1627                    !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1628                    if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1629                        !$rps{$player}{isadmin} && rand(100) < 1) {
1630                        chanmsg("$player encounters ".
1631                           $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1632                                " and bows humbly.");
1633                    }
1634                    if (rand($onlinecount) < 1) {
1635                        $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1636                        collision_fight($player,
1637                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1638                    }
1639                }
1640                else {
1641                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1642                    $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1643                }
1644            }
1645        }
1646    }
1647}
1648
1649sub mksalt { # generate a random salt for passwds
1650    join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
1651}
1652
1653sub chanmsg { # send a message to the channel
1654    my $msg = shift or return undef;
1655    if ($silentmode & 1) { return undef; }
1656    privmsg($msg, $opts{botchan}, shift);
1657}
1658
1659sub privmsg { # send a message to an arbitrary entity
1660    my $msg = shift or return undef;
1661    my $target = shift or return undef;
1662    my $force = shift;
1663    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1664        && !$force) {
1665        return undef;
1666    }
1667    while (length($msg)) {
1668        sts("PRIVMSG $target :".substr($msg,0,450),$force);
1669        substr($msg,0,450)="";
1670    }
1671}
1672
1673sub notice { # send a notice to an arbitrary entity
1674    my $msg = shift or return undef;
1675    my $target = shift or return undef;
1676    my $force = shift;
1677    if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1678        && !$force) {
1679        return undef;
1680    }
1681    while (length($msg)) {
1682        sts("NOTICE $target :".substr($msg,0,450),$force);
1683        substr($msg,0,450)="";
1684    }
1685}
1686
1687sub help { # print help message
1688    (my $prog = $0) =~ s/^.*\///;
1689
1690    print "
1691usage: $prog [OPTIONS]
1692  --help, -h           Print this message
1693  --verbose, -v        Print verbose messages
1694  --server, -s         Specify IRC server:port to connect to
1695  --botnick, -n        Bot's IRC nick
1696  --botuser, -u        Bot's username
1697  --botrlnm, -r        Bot's real name
1698  --botchan, -c        IRC channel to join
1699  --botident, -p       Specify identify-to-services command
1700  --botmodes, -m       Specify usermodes for the bot to set upon connect
1701  --botopcmd, -o       Specify command to send to server on successful connect
1702  --botghostcmd, -g    Specify command to send to server to regain primary
1703                       nickname when in use
1704  --doban              Advertisement ban on/off flag
1705  --okurl, -k          Bot will not ban for web addresses that contain these
1706                       strings
1707  --debug              Debug on/off flag
1708  --helpurl            URL to refer new users to
1709  --admincommurl       URL to refer admins to
1710
1711  Timing parameters:
1712  --rpbase             Base time to level up
1713  --rpstep             Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
1714  --rppenstep          PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
1715
1716";
1717}
1718
1719sub itemsum {
1720    my $user = shift;
1721    # is this for a battle? if so, good users get a 10% boost and evil users get
1722    # a 10% detriment
1723    my $battle = shift;
1724    return -1 unless defined $user;
1725    my $sum = 0;
1726    if ($user eq $primnick) {
1727        for my $u (keys(%rps)) {
1728            $sum = itemsum($u) if $sum < itemsum($u);
1729        }
1730        return $sum+1;
1731    }
1732    if (!exists($rps{$user})) { return -1; }
1733    $sum += int($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
1734    if ($battle) {
1735        return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
1736               $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
1737               $sum;
1738    }
1739    return $sum;
1740}
1741
1742sub daemonize() {
1743    # win32 doesn't daemonize (this way?)
1744    if ($^O eq "MSWin32") {
1745        print debug("Nevermind, this is Win32, no I'm not.")."\n";
1746        return;
1747    }
1748    use POSIX 'setsid';
1749    $SIG{CHLD} = sub { };
1750    fork() && exit(0); # kill parent
1751    POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
1752    $SIG{CHLD} = sub { };
1753    fork() && exit(0); # kill the parent as the process group leader
1754    $SIG{CHLD} = sub { };
1755    open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
1756    open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1757    open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1758    # write our PID to $opts{pidfile}, or return semi-silently on failure
1759    open(PIDFILE,">$opts{pidfile}") || do {
1760        debug("Error: failed opening pid file: $!");
1761        return;
1762    };
1763    print PIDFILE $$;
1764    close(PIDFILE);
1765}
1766
1767sub calamity { # suffer a little one
1768    my @players = grep { $rps{$_}{online} } keys(%rps);
1769    return unless @players;
1770    my $player = $players[rand(@players)];
1771    if (rand(10) < 1) {
1772        my @items = ("Arme de Precision","Bouffe","Arme","Tenue (Rune 3)","Rune de Precision",
1773                     "Accessoire (Rune 2)");
1774        my $type = $items[rand(@items)];
1775        if ($type eq "Arme de Precision") {
1776            chanmsg(clog("$player tombe, abimant son Arme de precision ".
1777                         "L $type de $player perd 10% de son efficacite."));
1778        }
1779        elsif ($type eq "Bouffe") {
1780            chanmsg(clog("$player glisse et salit sa bouffe ".
1781                         "bog! La $type de $player perd 10% de son ".
1782                         "efficacite."));
1783        }
1784        elsif ($type eq "Arme") {
1785            chanmsg(clog("$player a laisse son Arme de CaC dehors sous la pluie et celle ci rouille! ".
1786                         "L $type de $player perd 10% de son efficacite."));
1787        }
1788        elsif ($type eq "Tenue (Rune 3)") {
1789            chanmsg(clog("$player fout une touche de ketchup sur sa tenue en voulant".
1790                         "manger un hamburger! La $type de $player perd 10% de son".
1791                         "efficacite."));
1792        }
1793        elsif ($type eq "Accessoire (Rune 2)") {
1794            chanmsg(clog("Un lutin essaye de voler l accessoire de $player\'s  ".
1795                         "mais ne fait que l abimer! L $type de $player\'s perd 10% de son".
1796                         "efficacite."));
1797        }
1798        else {
1799            chanmsg(clog("$player a une fuite d'huile dans son vehicule ".
1800                         "Le $type de $player perd 10% de son ".
1801                         "efficacite."));
1802        }
1803        my $suffix="";
1804        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1805        $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * .9);
1806        $rps{$player}{item}{$type}.=$suffix;
1807    }
1808    else {
1809        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1810        if (!open(Q,$opts{eventsfile})) {
1811            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1812        }
1813        my($i,$actioned);
1814        while (my $line = <Q>) {
1815            chomp($line);
1816            if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
1817        }
1818        chanmsg(clog("$player $actioned. Cette terrible calamite l a ralenti ".
1819                     "pour ".duration($time)." pour le niveau ".
1820                     ($rps{$player}{level}+1)."."));
1821        $rps{$player}{next} += $time;
1822        chanmsg("$player atteint le prochain niveau dans ".duration($rps{$player}{next}).
1823                ".");
1824    }
1825}
1826
1827sub godsend { # bless the unworthy
1828    my @players = grep { $rps{$_}{online} } keys(%rps);
1829    return unless @players;
1830    my $player = $players[rand(@players)];
1831    if (rand(10) < 1) {
1832        my @items = ("Arme de Precision","Bouffe","Arme","Tenue (Rune 3)","Rune de Precision",
1833                     "Accessoire (Rune 2)");
1834        my $type = $items[rand(@items)];
1835        if ($type eq "Arme de Precision") {
1836            chanmsg(clog("$player\'s amulet was blessed by a passing cleric! ".
1837                         "$player\'s $type gains 10% effectiveness."));
1838        }
1839        elsif ($type eq "Bouffe") {
1840            chanmsg(clog("$player\'s Bouffe ate a bolt of lightning! ".
1841                         "$player\'s $type gains 10% effectiveness."));
1842        }
1843        elsif ($type eq "Arme") {
1844            chanmsg(clog("$player sharpened the edge of his "Arme de CaC"! ".
1845                         "$player\'s $type gains 10% effectiveness."));
1846        }
1847        elsif ($type eq "Tenue (Rune 3)") {
1848            chanmsg(clog("A magician cast a spell of Rigidity on $player\'s ".
1849                         ""Tenue (Rune 3)"! $player\'s $type gains 10% effectiveness."));
1850        }
1851        elsif ($type eq "Accessoire (Rune 2)") {
1852            chanmsg(clog("$player reinforced his shield with a dragon's ".
1853                         "scales! $player\'s $type gains 10% effectiveness."));
1854        }
1855        else {
1856            chanmsg(clog("The local wizard imbued $player\'s pants with a ".
1857                         "Spirit of Fortitude! $player\'s $type gains 10% ".
1858                         "effectiveness."));
1859        }
1860        my $suffix="";
1861        if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1862        $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * 1.1);
1863        $rps{$player}{item}{$type}.=$suffix;
1864    }
1865    else {
1866        my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1867        my $actioned;
1868        if (!open(Q,$opts{eventsfile})) {
1869            return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1870        }
1871        my $i;
1872        while (my $line = <Q>) {
1873            chomp($line);
1874            if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
1875                $actioned = $1;
1876            }
1877        }
1878        chanmsg(clog("$player $actioned! Ce merveilleux evenement ".
1879                     "l a booster de ".duration($time)." vers le niveau ".
1880                     ($rps{$player}{level}+1)."."));
1881        $rps{$player}{next} -= $time;
1882        chanmsg("$player atteint le prochain niveau dans ".duration($rps{$player}{next}).
1883                ".");
1884    }
1885}
1886
1887sub quest {
1888    @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
1889                                 time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
1890    if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
1891    while (@{$quest{questers}} > 4) {
1892        splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
1893    }
1894    if (!open(Q,$opts{eventsfile})) {
1895        return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1896    }
1897    my $i;
1898    while (my $line = <Q>) {
1899        chomp($line);
1900        if ($line =~ /^Q/ && rand(++$i) < 1) {
1901            if ($line =~ /^Q1 (.*)/) {
1902                $quest{text} = $1;
1903                $quest{type} = 1;
1904                $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
1905            }
1906            elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
1907                $quest{p1} = [$1,$2];
1908                $quest{p2} = [$3,$4];
1909                $quest{text} = $5;
1910                $quest{type} = 2;
1911                $quest{stage} = 1;
1912            }
1913        }
1914    }
1915    close(Q);
1916    if ($quest{type} == 1) {
1917        chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1918                "$quest{questers}->[3] a ete choisi par les dieux pour ".
1919                "$quest{text}. La quete se termine dans ".duration($quest{qtime}-time()).
1920                ".");   
1921    }
1922    elsif ($quest{type} == 2) {
1923        chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1924                "$quest{questers}->[3] a ete choisi par les dieux pour ".
1925                "$quest{text}. Il doit d abord atteindre [$quest{p1}->[0],".
1926                "$quest{p1}->[1]], puis [$quest{p2}->[0],$quest{p2}->[1]].".
1927                ($opts{mapurl}?" Regardez $opts{mapurl} pour voir le journal de leurs ".
1928                "aventures.":""));
1929    }
1930    writequestfile();
1931}
1932
1933sub questpencheck {
1934    my $k = shift;
1935    my ($quester,$player);
1936    for $quester (@{$quest{questers}}) {
1937        if ($quester eq $k) {
1938            chanmsg(clog("$k\'s prudence and self-regard has brought the ".
1939                         "wrath of the gods upon the realm. All your great ".
1940                         "wickedness makes you as it were heavy with lead, ".
1941                         "and to tend downwards with great weight and ".
1942                         "pressure towards hell. Therefore have you drawn ".
1943                         "yourselves 15 steps closer to that gaping maw."));
1944            for $player (grep { $rps{$_}{online} } keys %rps) {
1945                my $gain = int(15 * ($opts{rppenstep}**$rps{$player}{level}));
1946                $rps{$player}{pen_quest} += $gain;
1947                $rps{$player}{next} += $gain;
1948            }
1949            undef(@{$quest{questers}});
1950            $quest{qtime} = time() + 43200; # 12 hours
1951        }
1952    }
1953}
1954
1955sub clog {
1956    my $mesg = shift;
1957    open(B,">>$opts{modsfile}") or do {
1958        debug("Error: Cannot open $opts{modsfile}: $!");
1959        chanmsg("Error: Cannot open $opts{modsfile}: $!");
1960        return $mesg;
1961    };
1962    print B ts()."$mesg\n";
1963    close(B);
1964    return $mesg;
1965}
1966
1967sub backup() {
1968    if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
1969    if ($^O ne "MSWin32") {
1970        system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
1971    }
1972    else {
1973        system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
1974    }
1975}
1976
1977sub penalize {
1978    my $username = shift;
1979    return 0 if !defined($username);
1980    return 0 if !exists($rps{$username});
1981    my $type = shift;
1982    my $pen = 0;
1983    questpencheck($username);
1984    if ($type eq "quit") {
1985        $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
1986        if ($opts{limitpen} && $pen > $opts{limitpen}) {
1987            $pen = $opts{limitpen};
1988        }
1989        $rps{$username}{pen_quit}+=$pen;
1990        $rps{$username}{online}=0;
1991    }
1992    elsif ($type eq "nick") {
1993        my $newnick = shift;
1994        $pen = int(30 * ($opts{rppenstep}**$rps{$username}{level}));
1995        if ($opts{limitpen} && $pen > $opts{limitpen}) {
1996            $pen = $opts{limitpen};
1997        }
1998        $rps{$username}{pen_nick}+=$pen;
1999        $rps{$username}{nick} = substr($newnick,1);
2000        substr($rps{$username}{userhost},0,length($rps{$username}{nick})) =
2001            substr($newnick,1);
2002        notice("Penalty of ".duration($pen)." added to your timer for ".
2003               "nick change.",$rps{$username}{nick});
2004    }
2005    elsif ($type eq "privmsg" || $type eq "notice") {
2006        $pen = int(shift(@_) * ($opts{rppenstep}**$rps{$username}{level}));
2007        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2008            $pen = $opts{limitpen};
2009        }
2010        $rps{$username}{pen_mesg}+=$pen;
2011        notice("Penalty of ".duration($pen)." added to your timer for ".
2012               $type.".",$rps{$username}{nick});
2013    }
2014    elsif ($type eq "part") {
2015        $pen = int(200 * ($opts{rppenstep}**$rps{$username}{level}));
2016        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2017            $pen = $opts{limitpen};
2018        }
2019        $rps{$username}{pen_part}+=$pen;
2020        notice("Penalty of ".duration($pen)." added to your timer for ".
2021               "parting.",$rps{$username}{nick});
2022        $rps{$username}{online}=0;
2023    }
2024    elsif ($type eq "kick") {
2025        $pen = int(250 * ($opts{rppenstep}**$rps{$username}{level}));
2026        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2027            $pen = $opts{limitpen};
2028        }
2029        $rps{$username}{pen_kick}+=$pen;
2030        notice("Penalty of ".duration($pen)." added to your timer for ".
2031               "being kicked.",$rps{$username}{nick});
2032        $rps{$username}{online}=0;
2033    }
2034    elsif ($type eq "logout") {
2035        $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
2036        if ($opts{limitpen} && $pen > $opts{limitpen}) {
2037            $pen = $opts{limitpen};
2038        }
2039        $rps{$username}{pen_logout} += $pen;
2040        notice("Penalty of ".duration($pen)." added to your timer for ".
2041               "LOGOUT command.",$rps{$username}{nick});
2042        $rps{$username}{online}=0;
2043    }
2044    $rps{$username}{next} += $pen;
2045    return 1; # successfully penalized a user! woohoo!
2046}
2047
2048sub debug {
2049    (my $text = shift) =~ s/[\r\n]//g;
2050    my $die = shift;
2051    if ($opts{debug} || $opts{verbose}) {
2052        open(DBG,">>$opts{debugfile}") or do {
2053            chanmsg("Error: Cannot open debug file: $!");
2054            return;
2055        };
2056        print DBG ts()."$text\n";
2057        close(DBG);
2058    }
2059    if ($die) { die("$text\n"); }
2060    return $text;
2061}
2062
2063sub finduser {
2064    my $nick = shift;
2065    return undef if !defined($nick);
2066    for my $user (keys(%rps)) {
2067        next unless $rps{$user}{online};
2068        if ($rps{$user}{nick} eq $nick) { return $user; }
2069    }
2070    return undef;
2071}
2072
2073sub ha { # return 0/1 if username has access
2074    my $user = shift;
2075    if (!defined($user) || !exists($rps{$user})) {
2076        debug("Error: Attempted ha() for invalid username \"$user\"");
2077        return 0;
2078    }
2079    return $rps{$user}{isadmin};
2080}
2081
2082sub checksplits { # removed expired split hosts from the hash
2083    my $host;
2084    while ($host = each(%split)) {
2085        if (time()-$split{$host}{time} > $opts{splitwait}) {
2086            $rps{$split{$host}{account}}{online} = 0;
2087            delete($split{$host});
2088        }
2089    }
2090}
2091
2092sub collision_fight {
2093    my($u,$opp) = @_;
2094    my $mysum = itemsum($u,1);
2095    my $oppsum = itemsum($opp,1);
2096    my $myroll = int(rand($mysum));
2097    my $opproll = int(rand($oppsum));
2098    if ($myroll >= $opproll) {
2099        my $gain = int($rps{$opp}{level}/4);
2100        $gain = 7 if $gain < 7;
2101        $gain = int(($gain/100)*$rps{$u}{next});
2102        chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2103                     "] and taken them in combat! ".duration($gain)." is ".
2104                     "removed from $u\'s clock."));
2105        $rps{$u}{next} -= $gain;
2106        chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
2107        if (rand(35) < 1 && $opp ne $primnick) {
2108            $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2109            chanmsg(clog("$u has dealt $opp a Critical Strike! ".
2110                         duration($gain)." is added to $opp\'s clock."));
2111            $rps{$opp}{next} += $gain;
2112            chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
2113                    ".");
2114        }
2115        elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
2116            my @items = ("Jouet","Arme de Precision","Bouffe","Arme","Casque (Rune 1)","Tenue (Rune 3)",
2117                         "Rune de Force","Rune de Precision","Accessoire (Rune 2)",
2118                         "Vehicule");
2119            my $type = $items[rand(@items)];
2120            if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
2121                chanmsg("Durant la bataille acharnee, $opp a perdu son ".
2122                        int($rps{$opp}{item}{$type})." $type! $u le prend, ".
2123                        "et jette son ancien objet ".int($rps{$u}{item}{$type}).
2124                        " $type to $opp.");
2125                my $tempitem = $rps{$u}{item}{$type};
2126                $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
2127                $rps{$opp}{item}{$type} = $tempitem;
2128            }
2129        }
2130    }
2131    else {
2132        my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
2133        $gain = 7 if $gain < 7;
2134        $gain = int(($gain/100)*$rps{$u}{next});
2135        chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2136                     "] and been defeated in combat! ".duration($gain)." is ".
2137                     "added to $u\'s clock."));
2138        $rps{$u}{next} += $gain;
2139        chanmsg("$u atteint le prochain niveau dans ".duration($rps{$u}{next}).".");
2140    }
2141}
2142
2143sub writequestfile {
2144    return unless $opts{writequestfile};
2145    open(QF,">$opts{questfilename}") or do {
2146        chanmsg("Error: Cannot open $opts{questfilename}: $!");
2147        return;
2148    };
2149    # if no active quest, just empty questfile. otherwise, write it
2150    if (@{$quest{questers}}) {
2151        if ($quest{type}==1) {
2152            print QF "T $quest{text}\n".
2153                     "Y 1\n".
2154                     "S $quest{qtime}\n".
2155                     "P1 $quest{questers}->[0]\n".
2156                     "P2 $quest{questers}->[1]\n".
2157                     "P3 $quest{questers}->[2]\n".
2158                     "P4 $quest{questers}->[3]\n";
2159        }
2160        elsif ($quest{type}==2) {
2161            print QF "T $quest{text}\n".
2162                     "Y 2\n".
2163                     "S $quest{stage}\n".
2164                     "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
2165                        "$quest{p2}->[1]\n".
2166                     "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
2167                         "$rps{$quest{questers}->[0]}{y}\n".
2168                     "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
2169                         "$rps{$quest{questers}->[1]}{y}\n".
2170                     "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
2171                         "$rps{$quest{questers}->[2]}{y}\n".
2172                     "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
2173                         "$rps{$quest{questers}->[3]}{y}\n";
2174        }
2175    }
2176    close(QF);
2177}
2178
2179sub goodness {
2180    my @players = grep { $rps{$_}{alignment} eq "g" &&
2181                         $rps{$_}{online} } keys(%rps);
2182    return unless @players > 1;
2183    splice(@players,int(rand(@players)),1) while @players > 2;
2184    my $gain = 5 + int(rand(8));
2185    chanmsg(clog("$players[0] et $players[1] ne se sont pas laisses avoir par les pieges".
2186                 "des sadiques . Ensemble ils ont prié Dieu".
2187                 "et maintenant sa lumiere les guide. $gain\% ".
2188                 "est enleve de leur compteur."));
2189    $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
2190    $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
2191    chanmsg("$players[0] reaches next level in ".
2192            duration($rps{$players[0]}{next}).".");
2193    chanmsg("$players[1] reaches next level in ".
2194            duration($rps{$players[1]}{next}).".");
2195}
2196
2197sub evilness {
2198    my @evil = grep { $rps{$_}{alignment} eq "e" &&
2199                      $rps{$_}{online} } keys(%rps);
2200    return unless @evil;
2201    my $me = $evil[rand(@evil)];
2202    if (int(rand(2)) < 1) {
2203        # evil only steals from good :^(
2204        my @good = grep { $rps{$_}{alignment} eq "g" &&
2205                          $rps{$_}{online} } keys(%rps);
2206        my $target = $good[rand(@good)];
2207        my @items = ("Jouet","Arme de Precision","Bouffe","Arme","Casque (Rune 1)","Tenue (Rune 3)",
2208                     "Rune de Force","Rune de Precision","Accessoire (Rune 2)",
2209                     "Vehicule");
2210        my $type = $items[rand(@items)];
2211        if (int($rps{$target}{item}{$type}) > int($rps{$me}{item}{$type})) {
2212            my $tempitem = $rps{$me}{item}{$type};
2213            $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
2214            $rps{$target}{item}{$type} = $tempitem;
2215            chanmsg(clog("$me stole $target\'s level ".
2216                         int($rps{$me}{item}{$type})." $type while they were ".
2217                         "sleeping! $me leaves his old level ".
2218                         int($rps{$target}{item}{$type})." $type behind, ".
2219                         "which $target then takes."));
2220        }
2221        else {
2222            notice("Vous essayez de voler $target\'s $type, mais realisez ".
2223                   "que son niveau est plus bas que le votre. Vous retournez dans les".
2224                   "ombres.",$rps{$me}{nick});
2225        }
2226    }
2227    else { # being evil only pays about half of the time...
2228        my $gain = 1 + int(rand(5));
2229        chanmsg(clog("$me est oublie par Satan. ".
2230                     duration(int($rps{$me}{next} * ($gain/100)))." est ajoute ".
2231                     "a son compteur."));
2232        $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
2233        chanmsg("$me atteint le prochain niveau dans ".duration($rps{$me}{next}).".");
2234    }
2235}
2236
2237sub fisher_yates_shuffle {
2238    my $array = shift;
2239    my $i;
2240    for ($i = @$array; --$i; ) {
2241        my $j = int rand ($i+1);
2242        next if $i == $j;
2243        @$array[$i,$j] = @$array[$j,$i];
2244    }
2245}
2246
2247sub writedb {
2248    open(RPS,">$opts{dbfile}") or do {
2249        chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
2250        return 0;
2251    };
2252    print RPS join("\t","# username",
2253                        "pass",
2254                        "is admin",
2255                        "level",
2256                        "class",
2257                        "next ttl",
2258                        "nick",
2259                        "userhost",
2260                        "online",
2261                        "idled",
2262                        "x pos",
2263                        "y pos",
2264                        "pen_mesg",
2265                        "pen_nick",
2266                        "pen_part",
2267                        "pen_kick",
2268                        "pen_quit",
2269                        "pen_quest",
2270                        "pen_logout",
2271                        "created",
2272                        "last login",
2273                        "Arme de Precision",
2274                        "Bouffe",
2275                        "Casque (Rune 1)",
2276                        "boots",
2277                        "gloves",
2278                        "Jouet",
2279                        "leggings",
2280                        "Accessoire (Rune 2)",
2281                        "Tenue (Rune 3)",
2282                        "Arme",
2283                        "alignment")."\n";
2284    my $k;
2285    keys(%rps); # reset internal pointer
2286    while ($k=each(%rps)) {
2287        if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
2288            print RPS join("\t",$k,
2289                                $rps{$k}{pass},
2290                                $rps{$k}{isadmin},
2291                                $rps{$k}{level},
2292                                $rps{$k}{class},
2293                                $rps{$k}{next},
2294                                $rps{$k}{nick},
2295                                $rps{$k}{userhost},
2296                                $rps{$k}{online},
2297                                $rps{$k}{idled},
2298                                $rps{$k}{x},
2299                                $rps{$k}{y},
2300                                $rps{$k}{pen_mesg},
2301                                $rps{$k}{pen_nick},
2302                                $rps{$k}{pen_part},
2303                                $rps{$k}{pen_kick},
2304                                $rps{$k}{pen_quit},
2305                                $rps{$k}{pen_quest},
2306                                $rps{$k}{pen_logout},
2307                                $rps{$k}{created},
2308                                $rps{$k}{lastlogin},
2309                                $rps{$k}{item}{"Arme de Precision"},
2310                                $rps{$k}{item}{Bouffe},
2311                                $rps{$k}{item}{"Casque (Rune 1)"},
2312                                $rps{$k}{item}{"Vehicule"},
2313                                $rps{$k}{item}{"Rune de Force"},
2314                                $rps{$k}{item}{Jouet},
2315                                $rps{$k}{item}{"Rune de Precision"},
2316                                $rps{$k}{item}{"Accessoire (Rune 2)"},
2317                                $rps{$k}{item}{"Tenue (Rune 3)"},
2318                                $rps{$k}{item}{"Arme de CaC"},
2319                                $rps{$k}{alignment})."\n";
2320        }
2321    }
2322    close(RPS);
2323}
2324
2325sub readconfig {
2326    if (! -e ".irpg.conf") {
2327        debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
2328              "please.",1);
2329    }
2330    else {
2331        open(CONF,"<.irpg.conf") or do {
2332            debug("Failed to open config file .irpg.conf: $!",1);
2333        };
2334        my($line,$key,$val);
2335        while ($line=<CONF>) {
2336            next() if $line =~ /^#/; # skip comments
2337            $line =~ s/[\r\n]//g;
2338            $line =~ s/^\s+//g;
2339            next() if !length($line); # skip blank lines
2340            ($key,$val) = split(/\s+/,$line,2);
2341            $key = lc($key);
2342            if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
2343            elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
2344            if ($key eq "die") {
2345                die("Please edit the file .irpg.conf to setup your bot's ".
2346                    "options. Also, read the README file if you haven't ".
2347                    "yet.\n");
2348            }
2349            elsif ($key eq "server") { push(@{$opts{servers}},$val); }
2350            elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
2351            else { $opts{$key} = $val; }
2352        }
2353    }
2354}
Note: See TracBrowser for help on using the repository browser.