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

Last change on this file since 1446 was 1444, checked in by Daimonos Tereutes, 15 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.