PERL 20
QWIZ PERL By juggle on 27th November 2018 05:33:30 AM
  1. #!/usr/bin/perl
  2.  
  3. #=--------------------------------------=
  4. #  Quizbot - QuizBot.pl
  5. #  Copyright (C) Ed Halley and other authors.
  6. #
  7. #  This program is free software. You may use, modify, and distribute it
  8. #  under the terms of the Perl Artistic license, avialible on the world
  9. #  wide web at:
  10. #  http://www.perl.com/pub/a/language/misc/Artistic.html
  11. #  and included in the file LICENSE.
  12. #
  13. # $Id: $
  14. #
  15. #=--------------------------------------=
  16.  
  17. # Configuration Section; Change the following
  18. # variables to suit you.
  19.  
  20. # This is the bots default nickname, and how it refers to itself online.
  21. # Change it to what you want your bots nick to be.
  22. $botname = 'Trubia';
  23.  
  24. # actually the irc username sent to the server (ident
  25. # depends on your identd install). set to $botname by
  26. # default.
  27. $ident = $botname;
  28.  
  29. # This is the bots 'real name' shown in /whois on IRC.
  30. $realname = 'Trivia Bot';
  31.  
  32. # These are the usermodes the bot sets on itself.
  33. # +i-d is a good default.
  34. $botusermode = '+i-d';
  35.  
  36. # This password is used for nickserv/authserv login
  37. # currently this is under construction.
  38. #$sPassword  = 'xyzpasswordpdq';
  39.  
  40. # This is the channel the bot will join and play trivia in
  41. $botchan = '#bibletrivia';
  42.  
  43. # The modes the bot will set in the channel.
  44. # (TODO currently does not work, need to check when
  45. #      we get ops to do this)
  46. $botchanmode = '+nt';
  47.  
  48. # The bot will respond to commands in channel that begin with this character
  49. $cmdchar = '!';
  50.  
  51. # The bot will occationally tell people to visit here
  52. # for information about your channel.
  53. $homeurl = 'http://afternet.org/';
  54.  
  55. # The bot will kickban anyone who says anything matching the following
  56. # regex:
  57. $sCurses = '\b(bitch|cunt)';
  58.  
  59. # End of the configuration section. Edit code below
  60. # only if you are making code modifications.
  61.  
  62. #----------------------------------------------------------------------------
  63.  
  64. $botnick = $botname;
  65. $oldbotnick = '';
  66. $botwantnick = $botnick;
  67.  
  68. if ($ARGV[0] eq 'test') {
  69.         $botchan .= $botchan.'-test';
  70.         &DEBUGMSG("Test BOT using $botchan.");
  71. }
  72.  
  73. $serverfile = lc($botname . '.servers.txt');
  74. $playerfile = lc($botname . '.players.txt');
  75. $suggestionfile = lc($botname . '.suggestions.txt');
  76.  
  77. $nBackupSpan = (60*60*24*1);
  78.  
  79. # Thes arnt used anymore, see botname.servers.txt
  80. $ircserver = 'irc.aizawlchat.com';
  81. $ircport = '6667';
  82. @servers = (
  83.         'leaf.aizawlchat.com:6667',
  84.         );
  85.  
  86. #----------------------------------------------------------------------------
  87. use FindBin;
  88. use lib $FindBin::Bin;
  89.  
  90. require irc;
  91. require prose;
  92.  
  93. require qwizgame;
  94. require qwizplayer;
  95. require qwizmail;
  96. require qwizvote;
  97.  
  98. use POSIX;
  99.  
  100. #----------------------------------------------------------------------------
  101.  
  102. # channel police:
  103.  
  104.         $bDebug = 1;
  105.         $bDebug = 1 if ($botchan =~ /test/i);
  106.  
  107.         $bKickComics = 1;
  108.         $bKickGuests = 1;
  109.         $bKickCurses = 1;
  110.  
  111.         $nTimeIdleWarning = (60*10);
  112.         $nTimeIdleKick = (60*25);
  113.  
  114.         $joinsseen = 0;
  115.         $userjoins = 0;
  116.         $bankicks = 0;
  117.         $kicksseen = 0;
  118.  
  119.         $tWhenLastReported      =       0;
  120.         $nAntiFloodReport       =       10;
  121.  
  122.         $tCurseProbation = (60*60);
  123.  
  124. #----------------------------------------------------------------------------
  125.  
  126. # channel status;
  127.  
  128.         $bQuit                  =       0;
  129.         $sForceTopic            =       '';
  130.         $bX2                    =       0;
  131.         $bNickServ              =       0;
  132.         $bChanServ              =       1;
  133.         $bIRCop                 =       0;
  134.         $bServerOverride        =       0;
  135.         $bNickChange    =       1;
  136.  
  137.         @modequeue              =       ();
  138.  
  139. #----------------------------------------------------------------------------
  140.         %send_timer = ();
  141.         $connected = 0;
  142.  
  143.  
  144. sub initializebot()
  145. {
  146.         &DEBUGMSG("Initializing bot.");
  147.  
  148.         &DEBUGMSG(readservers($serverfile) . " servers on file");
  149.  
  150.         initializegame();
  151.  
  152.         &DEBUGMSG(readplayers() . " players on file");
  153.         %send_timer = ();
  154. }
  155.  
  156. sub savebot
  157. {
  158.         savegame();
  159.         &writeplayers();
  160. }
  161.  
  162. $irc_housekeeping = 0;
  163. sub initbot
  164. {
  165.     ircsendline(S, "MODE $botnick $botusermode");
  166.     ircsendline(S, "JOIN $botchan");
  167.  
  168.     $irc_housekeeping = time();
  169.    
  170.     # uh. cant do this unless we have ops, so
  171.     # lets do it WHEN we get ops maybe?
  172.     #ircsendline(S, "MODE $botchan $botchanmode");
  173.  
  174.     # these are things we might want to do after connecting..
  175.     #if ($bIRCop) { &OPER("$botnick $sPassword"); }
  176.     #if ($bX2) { &PRIVMSG('authserv', "$botchan LOGIN $botnick $sPassword"); }
  177.     #if ($bX2) { &PRIVMSG('x3', "up #core"); }
  178.     #if ($bNickServ) { &PRIVMSG('nickserv', "IDENTIFY $sPassword"); }
  179.     #if ($bNickServ) { &PRIVMSG('x3', "IDENTIFY $botchan $sPassword"); }
  180.     #if ($bChanServ) { &PRIVMSG('authserv', "auth $botnick $sPassword"); }
  181. }
  182.  
  183.  
  184. sub refreshbot
  185. {
  186.         if($irc_housekeeping + 30 < time()) {
  187.             &DEBUGMSG("DEBUG: Running refreshbot housekeeping");
  188.             if($botnick ne $botwantnick) {
  189.                 #$botnick = $botwantnick;
  190.                 ircsendline(S, "NICK $botwantnick");
  191.             }
  192.             $irc_housekeeping = time();
  193.         }
  194. }
  195.  
  196. sub quitbot
  197. {
  198.         foreach $nick (keys %active)
  199.         {
  200.                 &deactivateplayer($nick);
  201.         }
  202.         &QUIT();
  203.         $bQuit = 1;
  204. }
  205.  
  206. #sub checknick
  207. #{
  208. #       if ($botnick = $botname)
  209. #       {
  210. #               $bNickChange = 1;
  211. #       }
  212. #       else {$bNickChange = 0;}
  213. #}
  214.  
  215. sub terminatebot
  216. {
  217.         savebot();
  218.         &DEBUGMSG("Terminated bot.");
  219. }
  220.  
  221. #----------------------------------------------------------------------------
  222.  
  223. sub readservers
  224. {
  225.         local($filename) = @_;
  226.         if (!open(INFO, $filename))
  227.         {
  228.                 &DEBUGMSG("Cannot read $filename.");
  229.                 return 0;
  230.         }
  231.  
  232.         @servers = ();
  233.         my $count = 0;
  234.  
  235.         while (!eof(INFO))
  236.         {
  237.                 $serversline = <INFO>;
  238.                 $serversline =~ s/\n//;
  239.                 $serversline =~ s/\r//;
  240.  
  241.                 if ($serversline =~ /^\s*\#/)
  242.                         { next; }
  243.  
  244.                 push(@servers, $serversline);
  245.                 $count++;
  246.         }
  247.  
  248.         close(INFO);
  249.         $count;
  250. }
  251.  
  252. #----------------------------------------------------------------------------
  253.  
  254. #
  255. # main loop
  256. #
  257.  
  258. sub main
  259. {
  260.         if ($bDebug != 0)
  261.         {
  262.                 &DEBUGMSG("(----DEBUGGING DIAGNOSTICS ENABLED----)");
  263.         }
  264.  
  265.         initializebot();
  266.  
  267.         $retrytime = 0;
  268.         SERVERLOOP: while (!$bQuit)
  269.         {
  270.                 savebot();
  271.  
  272.                 $retrytime += 1;
  273.  
  274.                 # pick $ircserver from a list, retry another server if fails to connect
  275.                 # this can be overridden with a /msg bot /server command,
  276.                 # but the bot still falls back to the list if that server fails
  277.                 #
  278.                 if (($retrytime % 3) == 0)
  279.                 {
  280.                         my ($head) = splice(@servers, 0, 1);
  281.                         push(@servers, $head);
  282.                         $bServerOverride = 0;
  283.                         $retrytime = 0;
  284.                 }
  285.                 if ($bServerOverride == 0)
  286.                 {
  287.                         ($ircserver, $ircport) = split(/:/, $servers[0]);
  288.                         $bServerOverride = 0;
  289.                 }
  290.  
  291.                 my $l = localtime();
  292.                 &DEBUGMSG("Trying $ircserver... ($l)");
  293.  
  294.                 %active = ();
  295.                 %authed = ();
  296.                 %present = ();
  297.  
  298.                 # bind socket, connect.
  299.                 {
  300.                         $sockaddr = 'S n a4 x8';
  301.                         ($name, $aliases, $proto) = getprotobyname('tcp');
  302.                         ($name, $aliases, $port) = getservbyname('6667', 'tcp');
  303.                         ($name, $aliases, $type, $len, $thataddr) = gethostbyname($ircserver);
  304.                         $this = pack($sockaddr, 2, 0, $thisaddr);
  305.                         $that = pack($sockaddr, 2, $ircport, $thataddr);
  306.                         socket(S, 2, 1, $proto) || do { &DEBUGMSG("$! at socket() - retrying"); sleep(20); next SERVERLOOP; };
  307.                         bind(S, $this) || do { &DEBUGMSG("$! at bind() - retrying"); sleep(20); next SERVERLOOP; };
  308.                         &DEBUGMSG("Connecting to $ircserver...");
  309.                         connect(S, $that) || do { &DEBUGMSG("$! at connect() - retrying"); sleep(20); next SERVERLOOP; };
  310.                         &DEBUGMSG("Connected.");
  311.                         $f = fileno(S);
  312.                         # turn on output autoflushing:
  313.                         select(S); $| = 1; select(STDOUT);
  314.                         $connected = 1;
  315.                 }
  316.  
  317.                 $conntime = time();
  318.  
  319.                 # establish IRC session
  320.                 {
  321.                         $botnick = $botwantnick;
  322.                         ircsendline(S, "NICK $botnick");
  323.                     # login on connect stuff.
  324.                         ircsendline(S, "PASS /".$botnick."/".$sPassword);
  325.                         ircsendline(S, "USER $ident zero zero :$realname");
  326.  
  327.                         while ($connected)
  328.                         {
  329.                                 $_ = ircreadline(S, 1);
  330.                                 if(!defined($_) ) {
  331.                                     #TODO read timed out - check if we should give up
  332.                                     next;
  333.                                 }
  334.                                 if($_ eq EOF)
  335.                                 {
  336.                                     &DEBUGMSG("Error from socket, terminating reg loop");
  337.                                     $connected = 0;
  338.                                     last;
  339.                                 }
  340.                                 elsif ($_ eq '') {
  341.                                     # empty line, ignore
  342.                                     next;
  343.                                 }
  344.                                 elsif (/^PING (\S+)/i) {
  345.                                     &r_pong($1); next;
  346.                                 }
  347.                                 elsif (/:(\S+)\s+001\s+/) { # :Welcome to network.
  348.                                         if (lc($1) ne lc($ircserver)) {
  349.                                                 &DEBUGMSG("Server name shift: $ircserver -> $1");
  350.                                                 $ircserver = $1;
  351.                                         }
  352.                                 }
  353.  
  354.                                 #:SVC-EU.AfterNET.Services 433 * triviabot :Nickname is already in use.
  355.                                 elsif (/:(\S+)\s+433\s+\S+\s+(\S+)/) {# :Nickname is already in use.
  356.                                         $botnick = $2 . "_";
  357.                                         ircsendline(S, "NICK $botnick");
  358.  
  359.                                         #if ($botnick ne $botwantnick)
  360.                                         #{
  361.                                         #        my @r = ('A', 'B', 'C', 'D', 'E', 'F');
  362.                                         #        my $t = $r[int(rand()*($#r+1))];
  363.                                         #        $botnick = $botwantnick . $t;
  364.                                         #        ircsendline(S,"NICK $botnick");
  365.                                         #}
  366.                                         #else
  367.                                         #{
  368.                                         #    $botnick .= '_';
  369.                                         #    ircsendline(S, "NICK $botnick");
  370.                                         #}
  371.                                 }
  372.                                  elsif (/:(\S+)\s+(376|422)\s+/)  {
  373.                                     last;
  374.                                 } # :End of MOTD
  375.                         }
  376.                         if($connected) {
  377.                            &DEBUGMSG("Connected to $ircserver.");
  378.                         }
  379.                 }
  380.                 if(!$connected) {
  381.                     last;
  382.                 }
  383.  
  384.                 $retrytime = 0;
  385.  
  386.                 # get back into the channel
  387.                 {
  388.                         initbot();
  389.                         #&CHANACTION("is connecting from $ircserver:$ircport.");
  390.                         # need to sleep while x3 gives us permission
  391.                         #sleep 4;
  392.                 }
  393.  
  394.                 $chantime = time();
  395.  
  396.                 &nextstate();
  397.  
  398.                 # server loop
  399.                 #{
  400.                         while (1)
  401.                         {
  402.                                 $_ = ircreadline(S, 0);
  403.                                 if(!defined($_)) {
  404.                                     next;
  405.                                 }
  406.                                 elsif($_ eq EOF) {
  407.                                     &DEBUGMSG("DEBUG: Error from socket, exiting loop.");
  408.                                     $connected = 0;
  409.                                     last;
  410.                                 }
  411.                                 elsif ($_ eq '') {
  412.                                     next;
  413.                                 }
  414.                                 elsif ($_ =~ /\000/) {
  415.                                     &DEBUGMSG("-------------null on line\!");
  416.                                     next;
  417.                                 }
  418.  
  419.                                 elsif (/^PING (\S+)/i) {
  420.                                     &r_pong($1);
  421.                                     next;
  422.                                 }
  423.  
  424.                                 elsif (/^:(\S+)\!(\S+) PRIVMSG (\#\S+) :$cmdchar(.+)/i) {
  425.                                     &r_command($1,$2,$4,1); next;
  426.                                 }
  427.                                 elsif (/^:(\S+)\!(\S+) PRIVMSG $botnick :[$cmdchar]?(.+)/i) {
  428.                                     &r_command($1,$2,$3,0); next;
  429.                                 }
  430.  
  431.                                 elsif (/^:(\S+)\!(\S+) PRIVMSG (\#\S+) :(.+)/i) {
  432.                                     &r_say($1,$2,$4); next;
  433.                                 }
  434.  
  435.                                 elsif (/^:(\S+)\!(\S+) PRIVMSG $botnick :$__ctcp(.+)$__ctcp/i) {
  436.                                     &r_ctcpquery($1,$2,$3); next;
  437.                                 }
  438.                                 elsif (/^:(\S+)\!(\S+) PRIVMSG (\#\S+) :$__ctcp(.+)$__ctcp/i) {
  439.                                     &r_ctcpquery($1,$2,$4); next;
  440.                                 }
  441.                                 elsif (/^:(\S+)\!(\S+) NOTICE $botnick :$__ctcp(.+)$__ctcp/i) {
  442.                                     &r_ctcpreply($1,$2,$3); next;
  443.                                 }
  444.  
  445.                                 elsif (/^:(\S+)\!(\S+) JOIN :(\S+)/i) {
  446.                                     &r_join($1,$2); next;
  447.                                 }
  448.                                 elsif (/^:(\S+) 353 [^:]*:(.+)$/i) {# 353 RPL_NAMREPLY
  449.                                     &r_names($2); next;
  450.                                 }
  451.                                 elsif (/^:(\S+) 302 (\S+) :(.+?)\=(\+|\-)?(\S+)$/i) {# 302 RPL_USERHOST
  452.                                     &r_join($3,$5); next;
  453.                                 }
  454.                                 elsif (/^:(\S+) (\S+) (\S+) :(\S+)\=(\+|\-)(\S+)/i) {
  455.                                     &r_join($4,$6); next;
  456.                                 }
  457.  
  458.                                 elsif (/^:(\S+)\!(\S+) NICK :(\S+)/i) {
  459.                                     if (lc($1) ne lc($3)) {
  460.                                         #If Its me. upbate my botnick
  461.                                         if(lc($1) eq lc($botnick)) {
  462.                                             $botnick = $3;
  463.                                         }
  464.                                         else {
  465.                                             # shouldn't we just follow them??
  466.                                             &r_part($1);
  467.                                             &DEVOICE($3);
  468.                                             &r_join($3,$2);
  469.                                         }
  470.                                     }
  471.                                     next;
  472.                                 }
  473.                                 elsif (/^:(\S+)\!(\S+) PART (\S+)/i) {
  474.                                     &r_part($1); next;
  475.                                 }
  476.                                 elsif (/^:(\S+)\!(\S+) KICK (\S+) (\S+)/i) {
  477.                                     &r_part($4); next;
  478.                                 }
  479.                                 elsif (/^:(\S+)\!(\S+) QUIT/i) {
  480.                                     &r_part($1); next;
  481.                                 }
  482.  
  483.                                 elsif (/:(\S+) 433 (\S+) (\S+)/) {# :Nickname is already in use.
  484.                                         # Nick change failed. Were back where we were.
  485.                                         $botnick = $2;
  486.  
  487.                                         #if ($botnick ne $botwantnick)
  488.                                         #{
  489.                                         #        my @r = ('A', 'B', 'C', 'D', 'E', 'F');
  490.                                         #        my $t = $r[int(rand()*($#r+1))];
  491.                                         #        $botnick = $botwantnick . $t;
  492.                                         #        ircsendline(S, "NICK $botnick");
  493.                                         #}
  494.                                         next;
  495.                                 }
  496.  
  497.                                 elsif (/^:\S+ TOPIC/i) {
  498.                                     next;
  499.                                 }
  500.                                 elsif (/^:\S+ MODE/i) {
  501.                                     next;
  502.                                 }
  503.                                 elsif (/^:\S+ 482/) {# 482 ERR_CHANOPRIVSNEEDED
  504.                                     next;
  505.                                 }
  506.  
  507.                                 # Server notices (user notices caught above)
  508.                                 if (/^:\S+ NOTICE/i) {
  509.                                     next;
  510.                                 }
  511.                                 &DEBUGMSG("Line didn't match a rule, ignoring");
  512.                         }
  513.                         continue
  514.                         {
  515.                                 #
  516.                                 # check the queue of bans to free
  517.                                 #
  518.  
  519.                                 my $now = time();
  520.  
  521.                                 # do basic housekeeping such as
  522.                                 # fixing wanted channels and nicks
  523.                                 refreshbot();
  524.  
  525.                                 while (defined($bans[0]))
  526.                                 {
  527.                                         my @ban = split(/:/, $bans[0]);
  528.                                         if ($ban[0] > $now) { last; }
  529.  
  530.                                         &DEBUGMSG("unbanning ($ban[1])");
  531.                                         &UNBAN($ban[1]);
  532.                                         splice(@bans, 0, 1);
  533.                                 }
  534.  
  535.                                 #
  536.                                 # run the game
  537.                                 #
  538.  
  539.                                 pumpgame();
  540.                         }
  541.                 #}
  542.                 if(!$connected) {
  543.                     last;
  544.                 }
  545.         }
  546.  
  547.         terminatebot();
  548. }
  549.  
  550. #----------------------------------------------------------------------------
  551.  
  552. sub isauthed
  553. {
  554.         local($nick) = @_;
  555.         $nick = lc($nick);
  556.         if (defined($authed{$nick}))
  557.                 { return 1; }
  558.         my @player = getplayer($nick);
  559.         if ($player[$sAuthPassword] eq '')
  560.                 { return 1; }
  561.         return 0;
  562. }
  563.  
  564. sub isreportokay
  565. {
  566.         my $now = time();
  567.  
  568.         if ($tWhenLastReported + $nAntiFloodReport > $now) { return 0; }
  569.  
  570.         $tWhenLastReported = $now;
  571.         return 1;
  572. }
  573.  
  574. sub qwizkick
  575. {
  576.         local($nick, $by, $reason) = @_;
  577.  
  578.         &KICK($nick, $reason);
  579.         &DEBUGMSG("** Kicked $nick out, $by ($reason)");
  580.  
  581.         $player[$nTimesKicked]++;
  582.         setplayer(@player);
  583.         deactivateplayer($player[$sNick]);
  584. }
  585.  
  586. sub qwizban
  587. {
  588.         local($nick, $host, $by, $reason, $duration) = @_;
  589.  
  590.         $duration = 5*60*60 if (!defined($duration));
  591.  
  592.         &DEBUGMSG("** Ban+Kicked $nick!$host out, $by ($reason)");
  593.  
  594.         my $found = 0;
  595.         my $added = 0;
  596.         my $expires = $duration + time();
  597.         foreach $b (0 .. $#bans)
  598.         {
  599.                 my @ban = split(/:/, $bans[$b]);
  600.                 if ($ban[1] =~ /\Q$host\E/)
  601.                 {
  602.                         &DEBUGMSG("** $host already in ban queue");
  603.                         $found = 1;
  604.                         last;
  605.                 }
  606.                 if ($ban[0] >= $duration)
  607.                 {
  608.                         splice(@bans, $b, 0, "$expires:*\!$host");
  609.                         $added = 1;
  610.                         last;
  611.                 }
  612.         }
  613.         if (!$found)
  614.                 { &BAN($nick, $host, "$reason (" . describetimespan($duration) . " ban)"); }
  615.         if (!$added)
  616.                 { push(@bans, "$expires:*\!$host"); }
  617.  
  618.         deactivateplayer($nick);
  619. }
  620.  
  621. sub idlecheck
  622. {
  623.         foreach $nick (keys %active)
  624.         {
  625.                 my @player = getplayer($nick);
  626.                 if ($player[$sFlags] =~ /[dio]/) { next; }
  627.  
  628.                 my $a = (time() - $player[$tWhenMet]);
  629.                 my $t = (time() - $player[$tWhenLastSaid]);
  630.                 my $klimit = $nTimeIdleKick;
  631.                 my $wlimit = $nTimeIdleWarning;
  632.                 if ($a < ($klimit * 2) || ($player[$sFlags] !~ /f/))
  633.                 {
  634.                         $klimit = $klimit / 3;
  635.                         $wlimit = $wlimit / 3;
  636.                 }
  637.  
  638.                 # decreasing order of warning: kick, second warning, first warning
  639.                 # (ensures you don't get lagged out and all three happen at once)
  640.                 #
  641.                 if ($t >= $klimit)
  642.                 {
  643.                         &DEBUGMSG("banning ($nick, $present{lc($nick)}, $botnick, \"Play, or chat, or leave, but don\'t idle in $botchan; thanks.\", 15)");
  644.                         &qwizban($nick, $present{lc($nick)}, $botnick, "Play, or chat, or leave, but don't idle in $botchan; thanks.", 15);
  645.                 }
  646.                 elsif ($t >= (($wlimit+$klimit)/2) && ($warned{lc($nick)} < 2))
  647.                 {
  648.                         &DEBUGMSG("warning ($nick, \"$botchan does not allow idling; please participate in the channel, or leave it.\")");
  649.                         $warned{lc($nick)} = 2;
  650.                         &NOTICE($nick, "$botchan does not allow idling; please participate in the channel, or leave it.");
  651.                         # noticeplayersbyflag('o', '', "Player $nick was just given their first idle warning.");
  652.                 }
  653.                 elsif ($t >= $wlimit && !defined($warned{lc($nick)}))
  654.                 {
  655.                         &DEBUGMSG("warning ($nick, \"$botnick and your fellow players would like you to contribute in $botchan.\")");
  656.                         $warned{lc($nick)} = 1;
  657.                         &NOTICE($nick, "$botnick and your fellow players would like you to contribute in $botchan.");
  658.                         noticeplayersbyflag('o', '', "Player $nick was just given their second idle warning.");
  659.                 }
  660.         }
  661. }
  662.  
  663. #----------------------------------------------------------------------------
  664.  
  665. sub r_join
  666. {
  667.         local($nick, $host) = @_;
  668.  
  669.         if ($nick eq '' || $host eq '')
  670.         {
  671.                 return;
  672.         }
  673.  
  674.         $joinsseen = $joinsseen + 1;
  675.         $lastjoin = $nick;
  676.  
  677.         $present{lc($nick)} = $host;
  678.  
  679.         &activateplayer($nick, $host);
  680.  
  681.         if (isactive($nick))
  682.         {
  683.                 my @player = getplayer($nick);
  684.                 $player[$tWhenLastSaid] = time();
  685.                 setplayer(@player);
  686.  
  687.                 if (isgmailwaiting($nick))
  688.                 {
  689.                         &NOTICE($nick, "You have game mail waiting.  Use !gmail to read it.");
  690.                 }
  691.         }
  692. }
  693.  
  694. sub r_names
  695. {
  696.         local($nicklist) = @_;
  697.  
  698.         my @nicks = split(/\s/, $nicklist);
  699.         my @users = ();
  700.         foreach $i (0 .. $#nicks)
  701.         {
  702.                 my $nick = $nicks[$i];
  703.                 if($nick =~ /^[+@]*([][A-Za-z0-9|^{}`_-]+)$/) {
  704.                     my $user = $1;
  705.                     if(lc($user) eq lc($botnick)) {
  706.                         next; # ignore ourselves
  707.                     }
  708.                     #my ($user) = ($nick =~ /^[@+-]?(\S+)/);
  709.                     #if ($user eq '') {
  710.                     #    next;
  711.                     #}
  712.                     &DEBUGMSG("Found user $nick = $user in names reply");
  713.                     push (@users, $user);
  714.                 }
  715.                 else {
  716.                     &DEBUGMSG("'$nick' didn't match names parser");
  717.                 }
  718.         }
  719.  
  720.         while ($#users >= 0)
  721.         {
  722.                 my $a = shift(@users);
  723.                 my @player = getplayer($a);
  724.                 r_join($a, 'unknownhost');
  725.                 if ($player[$sFlags] =~ /[ox]/)
  726.                 {
  727. #                       &USERHOST($a);
  728.                 }
  729.         }
  730. }
  731.  
  732. sub r_part
  733. {
  734.         local($nick) = @_;
  735.  
  736.         &deactivateplayer($nick);
  737.  
  738.         delete $present{lc($nick)};
  739.         delete $active{lc($nick)};
  740.         delete $authed{lc($nick)};
  741.  
  742.         if ($bX2 && lc($nick) eq 'X2')
  743.         {
  744.                 foreach $p (keys %authed)
  745.                 {
  746.                         my @player = getplayer($p);
  747.                         if ($player[$sFlags] =~ /o/) { &OPS($p); }
  748.                 }
  749.         }
  750. }
  751.  
  752. sub r_say
  753. {
  754.         local($cmdnick,$cmdhost,$said) = @_;
  755.  
  756.         if ($said eq '+') { return; }
  757.  
  758.         ircmention($cmdnick,$cmdhost);
  759.  
  760.         if ($cmdchan eq $botnick)
  761.                 { $cmdchan = $cmdnick; }
  762.  
  763.         $said =~ s/\n//;
  764.         $said =~ s/\r//;
  765.  
  766.         if (!isactive($cmdnick))
  767.         {
  768.                 &DEBUGMSG("in r_say() activating $cmdnick ($cmdhost)");
  769.                 activateplayer($cmdnick, $cmdhost);
  770.                 if (!isactive($cmdnick)) {
  771.                     &DEBUGMSG("$cmdnick still not active though!!");
  772.                     return;
  773.                 }
  774.         }
  775.  
  776.         my @player = getplayer($cmdnick);
  777.  
  778.         if ($player[$sFlags] =~ /[*d]/)
  779.                 { return; }
  780.  
  781.         #
  782.         # recognize game answers
  783.         #
  784.  
  785.         my $now = time();
  786.  
  787.         if ($bKickComics)
  788.         {
  789.                 if (($said =~ /^\# Appears as /) || ($said =~ /^\(#/))
  790.                 {
  791.                         &PRIVMSG($cmdnick,
  792.                                 "Comic Chat will not work with $botnick. Switch to Text Mode, and come back to $botchan. " .
  793.                                 "To use Text Mode, look under the View menu for Plain Text.  Or, click the button on your toolbar labeled Text View.");
  794.                         &PRIVMSG($cmdnick,
  795.                                 "The operators of $botchan suggest using mIRC instead of MSCHAT.  See www.mirc.com for that shareware product.");
  796.                         &KICK($cmdnick, " Come back in Text Mode. (See your private message to learn how.) ");
  797.                         return;
  798.                 }
  799.         }
  800.  
  801.         if ($bKickGuests)
  802.         {
  803.                 if ($cmdnick =~ /^Guest\d+/i)
  804.                 {
  805.                         &PRIVMSG($cmdnick,
  806.                                 "Guest nicknames will not work with $botnick. Choose a unique nickname, and come back to $botchan. " .
  807.                                 "To set a nickname, try typing /nick newname, or see your IRC program's online help about nicks.");
  808.                         &KICK($cmdnick, " Come back with a personal nickname. (See your private message to learn how.) ");
  809.                         return;
  810.                 }
  811.         }
  812.  
  813.         if ($bKickCurses)
  814.         {
  815.                 #if (($player[$tWhenMet] + $tCurseProbation) > $now)
  816.                 #{
  817.                         if (($said =~ /$sCurses/i) ||
  818.                             ($cmdnick =~ /$sCurses/i) ||
  819.                                 ($cmdhost =~ /$sCurses/i))
  820.                         {
  821.                                 qwizban($cmdnick, $cmdhost, $botnick, "No profanity in #quiztime please.", 60);
  822.                                 deactivateplayer($cmdnick);
  823.                                 return;
  824.                         }
  825.                 #}
  826.         }
  827.  
  828.         gamesaid($cmdnick, $said, @player);
  829.  
  830.         #
  831.         # all game processing of what they said is done; we can mangle $said now
  832.         #
  833.  
  834.         @player = getplayer($cmdnick); # again!
  835.  
  836.         $said =~ s/\://g;
  837.         $said =~ s/\t//g;
  838.         $said =~ s/\º//g;
  839.         $said =~ s/\|//g;
  840.         $said =~ s/[^\x20-\x7F]/\-/g;
  841.         my $t = ($now - $player[$tWhenLastSaid]);
  842.         if ($said eq $player[$sLastSaid] && $t < 10)
  843.         {
  844.                 $player[$nTimesSaid]++;
  845.         }
  846.         else
  847.         {
  848.                 $player[$nTimesSaid] = 1;
  849.         }
  850.         $player[$sLastSaid] = $said;
  851.         $player[$tWhenLastSaid] = time();
  852.         setplayer(@player);
  853.  
  854.         if ($player[$sFlags] =~ /[fo]/)
  855.                 { return; }
  856.  
  857.         if ($player[$nTimesSaid] > 2)
  858.         {
  859.                 &NOTICE($player[$sNick], "You talk too much, and you're not being very entertaining.");
  860.         }
  861.         if ($player[$nTimesSaid] > 3)
  862.         {
  863.                 qwizkick($cmdnick, $botnick, "I warned you, dumbass.");
  864.                 deactivateplayer($player[$sNick]);
  865.         }
  866.         if ($player[$nTimesSaid] > 4)
  867.         {
  868.                 qwizban($player[$sNick], $player[$sMask], $botnick, "Stop spamming now.");
  869.                 deactivateplayer($player[$sNick]);
  870.         }
  871. }
  872.  
  873. sub r_command
  874. {
  875.         local($cmdnick,$cmdhost,$rcommand,$ispublic) = @_;
  876.  
  877.         ircmention($cmdnick,$cmdhost);
  878.  
  879.         if ($cmdchan eq $botnick)
  880.                 { $cmdchan = $cmdnick; }
  881.  
  882.         $rcommand =~ s/\n//;
  883.         $rcommand =~ s/\r//;
  884.  
  885.         @commandfields = split (/ /, $rcommand);
  886.         $thecommand = lc($commandfields[0]);
  887.        
  888.         &DEBUGMSG("thecommand: $thecommand");
  889.         &DEBUGMSG("$cmdnick  isactive:" . isactive($cmdnick) ." present: " . ircispresent($cmdnick));
  890.         #if (!isactive($cmdnick) && ircispresent($cmdnick) && $thecommand ne 'mask' && $thecommand ne 'help')
  891.         if (!isactive($cmdnick) && $thecommand ne 'mask' && $thecommand ne 'help')
  892.  
  893.         {
  894.              &DEBUGMSG("Activating PLAYER in activate!");
  895.                 activateplayer($cmdnick, $cmdhost);
  896.                 if (!isactive($cmdnick)) {
  897.                     &DEBUGMSG("Tried to activiate $cmdnick ($cmdhost) but it still isnt, so cant do command $thecommand");
  898.                     return;
  899.                 }
  900.         }
  901.  
  902.         my @player = getplayer($cmdnick);
  903.  
  904.         my $isop = (($player[$sFlags] =~ /[ox]/)? 1 : 0);
  905.  
  906.         #
  907.         # non-ops can't whisper commands
  908.         #
  909.         if ($isop == 0 && $ispublic == 0 && $thecommand !~ /^(add|gmail|auth|setpass)$/) {
  910.             &DEBUGMSG("Non-op $cmdnick tried to do $thecommand, but they can't (because they arnt an op).");
  911.             return;
  912.         }
  913.  
  914.         #
  915.         # until the bot is stable, no commands from non-ops
  916.         #
  917.         my $now = time();
  918.         if ($chantime + (60) > $now && $isop == 0) {
  919.             &DEBUGMSG("Channel not yet stable... now = $now chantime = $chantime : commands not allowed");
  920.             return;
  921.         }
  922.  
  923.         #
  924.         # blacklisted folks and bots have NO commands
  925.         #
  926.         if ($player[$sFlags] =~ /[*d]/)
  927.                 { return; }
  928.  
  929.         #
  930.         # auth command -------------------------------------------------------------
  931.         #
  932.         if ($thecommand eq 'auth')
  933.         {
  934.                 &DEBUGMSG("In the authbit!!!");
  935.                 #if (!ircispresent($cmdnick))
  936.                 #       { return; }
  937.                 if ($ispublic != 0 || $commandfields[1] eq '')
  938.                 {
  939.                         &NOTICE($cmdnick, "To enter your password for authorization, you need to /msg $botnick auth <yourpassword>");
  940.                         &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  941.                         return;
  942.                 }
  943.  
  944.                 my $pw = $commandfields[1];
  945.                 $pw =~ tr/a-zA-Z0-9_\\\`\|\^\[\]\{\}\-//cd;
  946.  
  947.                 if ($pw ne $player[$sAuthPassword])
  948.                 {
  949.                         &NOTICE($cmdnick, "That is not the correct password.  Authorization failed.");
  950.                         &DEBUGMSG("!! nick $cmdnick failed AUTH!");
  951.                         $authfails{lc($cmdnick)}++;
  952.                         if ($authfails{lc($cmdnick)} >= 3)
  953.                         {
  954.                                 qwizban($cmdnick, $cmdhost, $botnick, "Authorization failed.", 15);
  955.                                 return;
  956.                         }
  957.                         &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  958.                         return;
  959.                 }
  960.  
  961.                 &NOTICE($cmdnick, "Authorization successful.");
  962.                 &DEBUGMSG("!! $cmdnick AUTHed successfully!");
  963.  
  964.                 delete $authfails{lc($cmdnick)};
  965.                 $authed{lc($cmdnick)} = $cmdhost;
  966.  
  967.                 authplayer($cmdnick);
  968.  
  969.                 return;
  970.         }
  971.         if ($thecommand eq 'setpass')
  972.         {
  973.                 #if (!ircispresent($cmdnick))
  974.                 #       { return; }
  975.                 if ($ispublic != 0 || $commandfields[1] eq '')
  976.                 {
  977.                         &NOTICE($cmdnick, "To set your password, you need to /msg $botnick setpass <yourpassword>");
  978.                         &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  979.                         return;
  980.                 }
  981.  
  982.                 if (!isauthed($cmdnick))
  983.                 {
  984.                         &NOTICE($cmdnick, "You are not authorized to set your password.  You must first enter your old password.");
  985.                         &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  986.                         return;
  987.                 }
  988.  
  989.                 my $pw = $commandfields[1];
  990.                 $pw =~ tr/a-zA-Z0-9_\\\`\|\^\[\]\{\}\-//cd;
  991.  
  992.                 if (length($pw) < 3 || lc($pw) eq lc($cmdnick))
  993.                 {
  994.                         &NOTICE($cmdnick, "That password is not secure enough. Use more letters or digits, or pick another word.");
  995.                         &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  996.                         return;
  997.                 }
  998.  
  999.                 &NOTICE($cmdnick, "Your password has been updated to <$pw>.");
  1000.                 &NOTICE($cmdnick, "Do NOT type your password in the channel where others may see it. See !help auth");
  1001.                 &DEBUGMSG("!! $cmdnick SETPASSed successfully!");
  1002.  
  1003.                 $player[$sAuthPassword] = $pw;
  1004.                 setplayer(@player);
  1005.                 $authed{lc($cmdnick)} = $cmdhost;
  1006.  
  1007.                 authplayer($cmdnick);
  1008.  
  1009.                 return;
  1010.         }
  1011.         if ($thecommand eq 'zappass' && isplayer($commandfields[1]) && $player[$sFlags] =~ /x/)
  1012.         {
  1013.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1014.  
  1015.                 my $nick = $commandfields[1];
  1016.                 @player = getplayer($nick);
  1017.                 delete $authed{lc($nick)};
  1018.                 $player[$sAuthPassword] = $newplayer[$sAuthPassword];
  1019.                 setplayer(@player);
  1020.  
  1021.                 &NOTICE($cmdnick, "$nick has had their password zapped.");
  1022.  
  1023.                 return;
  1024.         }
  1025.  
  1026.         #
  1027.         # asl command -------------------------------------------------------------
  1028.         #
  1029.         if (($thecommand eq 'asl') || ($thecommand eq 'a/s/l'))
  1030.         {
  1031.                 if ($commandfields[2] eq '' && isplayer($commandfields[1]))
  1032.                 {
  1033.                         @target = getplayer($commandfields[1]);
  1034.                         if ($target[$sPersonalStats] eq $newplayer[$sPersonalStats])
  1035.                                 { &NOTICE($cmdnick, "$target[$sNick] has not recorded age/sex/location."); }
  1036.                         else
  1037.                                 { &NOTICE($cmdnick, "$target[$sNick] has $target[$sPersonalStats] saved."); }
  1038.                         return;
  1039.                 }
  1040.  
  1041.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1042.  
  1043.                 my ($age,$sex,$loc) = ($rcommand =~ /asl\s+(\S*)\s*[\/\|\\]+\s*(\S*)\s*[\/\|\\]+\s*(.*)\s*$/i );
  1044.                 if (!defined($loc))
  1045.                 {
  1046.                         &NOTICE($cmdnick, "Please see !help website for details on how to use !asl.");
  1047.                         return;
  1048.                 }
  1049.  
  1050.                 if (($age < 7 || $age > 77) && ($age ne '-'))
  1051.                 {
  1052.                         &NOTICE($cmdnick, "$botnick suspects your age ($age) is not accurate.");
  1053.                         &NOTICE($cmdnick, "Please see !help website for details on how to use !asl.");
  1054.                         &NOTICE($cmdnick, "See an operator if you think this message is in error.");
  1055.                         return;
  1056.                 }
  1057.  
  1058.                 if ($sex =~ /female|f|she|g|w/i) { $sex = 'F'; }
  1059.                 if ($sex =~ /male|m|he|b/i) { $sex = 'M'; }
  1060.                 if ($sex ne 'F' && $sex ne 'M' && $sex ne '-')
  1061.                 {
  1062.                         &NOTICE($cmdnick, "$botnick suspects your sexual gender ($sex) is not accurate.");
  1063.                         &NOTICE($cmdnick, "Please see !help website for details on how to use !asl.");
  1064.                         &NOTICE($cmdnick, "See an operator if you think this message is in error.");
  1065.                         return;
  1066.                 }
  1067.                 $sex = lc($sex);
  1068.  
  1069.                 if ($loc ne '-' && $loc !~ /^[a-zA-Z,'. ]+$/)
  1070.                 {
  1071.                         &NOTICE($cmdnick, "$botnick suspects your location ($loc) is not accurate.");
  1072.                         &NOTICE($cmdnick, "Please see !help website for details on how to use !asl.");
  1073.                         &NOTICE($cmdnick, "See an operator if you think this message is in error.");
  1074.                         return;
  1075.                 }
  1076.  
  1077.                 if ($age eq '-' && $sex eq '-' && $loc eq '-')
  1078.                 {
  1079.                         $player[$sPersonalStats] = $newplayer[$sPersonalStats];
  1080.                         setplayer(@player);
  1081.                         &NOTICE($cmdnick, "Your personal stats have been cleared.");
  1082.                         return;
  1083.                 }
  1084.  
  1085.                 $player[$sPersonalStats] = "($age/$sex/$loc)";
  1086.                 $player[$sNick] = $cmdnick;
  1087.                 setplayer(@player);
  1088.                 &NOTICE($cmdnick, "Your personal stats are saved as $player[$sPersonalStats].");
  1089.                 return;
  1090.         }
  1091.         if ($thecommand eq 'url')
  1092.         {
  1093.                 if (isplayer($commandfields[1]))
  1094.                 {
  1095.                         @target = getplayer($commandfields[1]);
  1096.                         if ($target[$sPersonalURL] eq $newplayer[$sPersonalURL])
  1097.                         {
  1098.                                 &NOTICE($cmdnick, "$target[$sNick] has not recorded a network address.");
  1099.                         }
  1100.                         else
  1101.                         {
  1102.                                 my ($first,$sep,$last) = ($target[$sPersonalURL] =~ m{^([a-z0-9_.]+)([@/])([a-z0-9_./~\-]*)$}i );
  1103.                                 my $protocol = '';
  1104.                                 if ($sep eq '@') { $protocol = 'mailto:'; }
  1105.                                 if ($sep eq '/') { $protocol = 'http://'; }
  1106.                                 &NOTICE($cmdnick, "$target[$sNick] has $protocol$target[$sPersonalURL] saved.");
  1107.                         }
  1108.                         return;
  1109.                 }
  1110.  
  1111.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1112.  
  1113.                 if ($commandfields[1] eq '-')
  1114.                 {
  1115.                         $player[$sPersonalURL] = $commandfields[1];
  1116.                         setplayer(@player);
  1117.                         &NOTICE($cmdnick, "Your personal network address has been cleared.");
  1118.                         return;
  1119.                 }
  1120.  
  1121.                 my ($protocol,$first,$sep,$last) = ($commandfields[1] =~ m{^(http://|mailto:)?([a-z0-9_.\-]+)([@/]?)([a-z0-9_./~\-]*)$}i );
  1122.                 if (!defined($first) || !defined($last))
  1123.                 {
  1124.                         &NOTICE($cmdnick, "Please see !help website for details on how to use !url.");
  1125.                         return;
  1126.                 }
  1127.                 if ($sep eq '@') { $protocol = 'mailto:'; }
  1128.                 if ($sep eq '/') { $protocol = 'http://'; }
  1129.                 if ($protocol eq 'http://') { $sep = '/'; }
  1130.  
  1131.                 $player[$sPersonalURL] = "$first$sep$last";
  1132.                 $player[$sNick] = $cmdnick;
  1133.                 setplayer(@player);
  1134.                 &NOTICE($cmdnick, "Your personal network address is saved as $protocol$player[$sPersonalURL].");
  1135.                 return;
  1136.         }
  1137.  
  1138.         #
  1139.         # blacklist command -------------------------------------------------------------
  1140.         #
  1141.         if (($thecommand eq 'ban' || $thecommand eq 'blacklist') && $player[$sFlags] =~ /b/)
  1142.         {
  1143.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1144.  
  1145.                 if (lc($commandfields[1]) eq 'all') # refreshes any blacklist bans
  1146.                 {
  1147.                         foreach $nick (keys %players)
  1148.                         {
  1149.                                 my @target = getplayer($nick);
  1150.                                 if ($target[$sFlags] =~ /\*/)
  1151.                                         { qwizban($target[$sNick], $target[$sMask], $cmdnick, "Banned."); }
  1152.                         }
  1153.                         return;
  1154.                 }
  1155.  
  1156.                 if ($thecommand eq 'blacklist' && isplayer($commandfields[1]) && $player[$sFlags] =~ /x/)
  1157.                 {
  1158.                         my @target = getplayer($commandfields[1]);
  1159.  
  1160.                         &NOTICE($cmdnick, "The identity $commandfields[1] has been permanently blacklisted.");
  1161.                         if (isactive($commandfields[1]))
  1162.                                 { &NOTICE($commandfields[1], "You have been blacklisted, and are no longer welcome to play in $botchan."); }
  1163.                 }
  1164.  
  1165.                 &modeplayer($cmdnick, $commandfields[1], '*', '');
  1166.                 return;
  1167.         }
  1168.         if (($thecommand eq 'unban' || $thecommand eq 'unblacklist') && $player[$sFlags] =~ /b/)
  1169.         {
  1170.                 &modeplayer($cmdnick, $commandfields[1], '', '*');
  1171.                 return;
  1172.         }
  1173.  
  1174.         #
  1175.         # friend command -------------------------------------------------------------
  1176.         #
  1177.         if ($thecommand eq 'friend' && $player[$sFlags] =~ /o/ && isplayer($commandfields[1]))
  1178.         {
  1179.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1180.  
  1181.                 my @target = getplayer($commandfields[1]);
  1182.                 if ($target[$sFlags] =~ /[fo]/)
  1183.                 {
  1184.                         &NOTICE($cmdnick, "That player is already a friend of the channel.");
  1185.                         return;
  1186.                 }
  1187.                 my $nTimeAdjust = (60*60*24);
  1188.                 my $now = time();
  1189.                 if ($player[$sFlags] !~ /[ox]/ &&
  1190.                     ($target[$tWhenMet] + $nTimeAdjust) > $now)
  1191.                 {
  1192.                         &NOTICE($cmdnick,
  1193.                                 "That player has not yet had time to get to know people. " .
  1194.                                 "Try !friend again in " .
  1195.                                 describetimespan($target[$tWhenMet] + $nTimeAdjust - $now) .
  1196.                                 ".");
  1197.                         return;
  1198.                 }
  1199.                 if ($player[$sFlags] !~ /[ox]/ &&
  1200.                     $target[$sMask] eq $player[$sMask])
  1201.                 {
  1202.                         &NOTICE($cmdnick, "Sorry, you cannot befriend yourself.");
  1203.                         return;
  1204.                 }
  1205.  
  1206.                 &modeplayer($cmdnick, $commandfields[1], 'f', '');
  1207.                 if (isactive($commandfields[1]))
  1208.                 {
  1209.                         $player[$nBonusPoints]++;
  1210.                         &NOTICE($commandfields[1],
  1211.                                 "You've been named an honorary friend of the channel by $cmdnick; see !help.");
  1212.                         &NOTICE($commandfields[1],
  1213.                                 "You've been given one TriviaBuck which you can spend to !join a team or for other special purchases.");
  1214.                 }
  1215.                 return;
  1216.         }
  1217.  
  1218.         #
  1219.         # gmail command
  1220.         #
  1221.         if ($thecommand eq 'gmail' && $commandfields[1] eq '')
  1222.         {
  1223.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1224.  
  1225.                 # read waiting mail
  1226.                 if (isgmailwaiting($cmdnick) == 0)
  1227.                 {
  1228.                         &NOTICE($cmdnick, "No gmail is waiting for you.");
  1229.                 }
  1230.                 else
  1231.                 {
  1232.                         delivergmail($cmdnick);
  1233.                 }
  1234.         }
  1235.         elsif ($thecommand eq 'gmail')
  1236.         {
  1237.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1238.  
  1239.                 if ($player[$nRank] == 0)
  1240.                 {
  1241.                         &NOTICE($cmdnick, "You must earn at least rank " . $rankname{1} . " to send gmail to someone.");
  1242.                         return;
  1243.                 }
  1244.                 if ($commandfields[1] =~ /^[@*]$/ && $player[$sFlags] !~ /o/)
  1245.                 {
  1246.                         &NOTICE($cmdnick, "Only channel operators can send bulk gmail.");
  1247.                         return;
  1248.                 }
  1249.                 if ($commandfields[1] !~ /^[@*]$/ && !isplayer($commandfields[1]))
  1250.                 {
  1251.                         &NOTICE($cmdnick, "No record of a player named $commandfields[1].");
  1252.                         &NOTICE($cmdnick, "Usage:  !gmail <PlayerName> <message to be sent>");
  1253.                         return;
  1254.                 }
  1255.                 if ($commandfields[2] eq '')
  1256.                 {
  1257.                         &NOTICE($cmdnick, "Cannot send blank gmail.");
  1258.                         &NOTICE($cmdnick, "Usage:  !gmail <PlayerName> <message to be sent>");
  1259.                         return;
  1260.                 }
  1261.  
  1262.                 my($message) = ($rcommand =~ /^\S+\s+\S+\s+(\S+.*)$/);
  1263.                 postgmail($commandfields[1], $cmdnick, $message);
  1264.                 &NOTICE($cmdnick, "Sent g-mail.");
  1265.         }
  1266.  
  1267.         #
  1268.         # help command -------------------------------------------------------------
  1269.         #
  1270.         if ($thecommand eq 'help')
  1271.         {
  1272.                 if (!isreportokay()) { &NOTICE($cmdnick, "Please wait a few moments and try again."); return; }
  1273.  
  1274.                 SWITCH:
  1275.                 {
  1276.                 ($commandfields[1] =~ /best|top/) && do
  1277.                         {
  1278.                                 &NOTICE($cmdnick, "Recognized best stat boards:");
  1279.                                 &NOTICE($cmdnick, "  !best wins          (shows most wins ever)");
  1280.                                 &NOTICE($cmdnick, "  !best season-wins   (shows most wins this season) (default)");
  1281.                                 &NOTICE($cmdnick, "  !best streak        (shows best wins-in-a-row ever)");
  1282.                                 &NOTICE($cmdnick, "  !best season-streak (shows best wins-in-a-row this season)");
  1283.                                 &NOTICE($cmdnick, "  !best added         (shows most questions added)");
  1284.                                 &NOTICE($cmdnick, "  !best TriviaBucks    (shows most TriviaBucks earned)");
  1285.                                 &NOTICE($cmdnick, "  !best second        (shows most second-place finishes)");
  1286.                                 return;
  1287.                         };
  1288.  
  1289.                 ($commandfields[1] =~ /bonus|QuizBucK|buck/) && do
  1290.                         {
  1291.                                 &NOTICE($cmdnick, "Some of the many Bonus Quiz Types");
  1292.                                 &NOTICE($cmdnick, "  BLIND      (Type a long answer before anyone shows even a single hint, and get a bonus!)");
  1293.                                 &NOTICE($cmdnick, "  BOUNTY     (When someone's on a streak, break their streak with a right answer!)");
  1294.                                 &NOTICE($cmdnick, "  MIRROR     (The $botnick asks the question backwards. Answer gets a bonus. Backwards answers get two!)");
  1295.                                 &NOTICE($cmdnick, "  CATCALL    (Guess the category before someone answers the question, for a bonus!)");
  1296.                                 &NOTICE($cmdnick, "  WIPEOUT    (If your team answers all $quizperperiod in a period, all the teammies present get a bonus!)");
  1297.                                 &NOTICE($cmdnick, "Watch out for dreaded MINEFIELD rounds: you can lose QuizBucKs for being too fast on the trigger!");
  1298.                                 &NOTICE($cmdnick, "TriviaBucks can be spent like money on !category commands or as !enter entry fees for challenge rounds.");
  1299.                                 return;
  1300.                         };
  1301.  
  1302.                 ($commandfields[1] =~ /auth|pass/) && do
  1303.                         {
  1304.                                 &NOTICE($cmdnick, "To use many game commands, you must be authorized.  You can set your own password to protect your score.");
  1305.                                 &NOTICE($cmdnick, "To set a password, send a private message to $botnick:  ");
  1306.                                 &NOTICE($cmdnick, irccolor("  /msg $botnick setpass <anypassword>", 4));
  1307.                                 &NOTICE($cmdnick, "To show your authorization, send a private message to $botnick:");
  1308.                                 &NOTICE($cmdnick, irccolor("  /msg $botnick auth <anypassword>", 4));
  1309.                                 &NOTICE($cmdnick, "Never tell other players your password for $botchan\'s $botnick.");
  1310.                                 return;
  1311.                         };
  1312.  
  1313.                 ($commandfields[1] =~ /gmail|mail/) && do
  1314.                         {
  1315.                                 &NOTICE($cmdnick, "Reading Game Mail:");
  1316.                                 &NOTICE($cmdnick, "  !gmail");
  1317.                                 if ($player[$nRank] > 0)
  1318.                                 {
  1319.                                         &NOTICE($cmdnick, "Sending Game Mail:  (either one)");
  1320.                                         &NOTICE($cmdnick, "  !gmail " . irccolor("Nickname",3) . " " . irccolor("Message to send.", 12));
  1321.                                         &NOTICE($cmdnick, "  /msg $botnick gmail " . irccolor("Nickname",3) . " " . irccolor("Message to send.", 12));
  1322.                                 }
  1323.                                 &NOTICE($cmdnick, "Game mail is deleted when it's read, or in a week if not read.");
  1324.                                 return;
  1325.                         };
  1326.  
  1327.                 ($commandfields[1] =~ /category|categories/) && do
  1328.                         {
  1329.                                 &NOTICE($cmdnick, "Currently defined question categories:");
  1330.  
  1331.                                 my @themelist = (sort keys %themes);
  1332.                                 my $line = '   ';
  1333.                                 while ($#themelist >= 0)
  1334.                                 {
  1335.                                         $line .= join('   ', splice(@themelist, 0, 15));
  1336.                                         &NOTICE($cmdnick, $line);
  1337.                                         $line = '   ';
  1338.                                 }
  1339.  
  1340.                                 if ($player[$sFlags] =~ /f/)
  1341.                                         { &NOTICE($cmdnick, $__kolor . "3  !category <categoryname> (to choose next period's category)"); }
  1342.                                 return;
  1343.                         };
  1344.  
  1345.                 ($commandfields[1] =~ /mode|mode/) && do
  1346.                         {
  1347.                                 &NOTICE($cmdnick, "Recognized modes: a b f i k m n o q t z");
  1348.                                 &NOTICE($cmdnick, "  +a   (player can !accept reviewed questions)");
  1349.                                 &NOTICE($cmdnick, "  +b   (player can !ban and !unban troublemakers)");
  1350.                                 &NOTICE($cmdnick, "  +f   (player is (channel friend), not auto-kicked for swearing, can !friend, !category)");
  1351.                                 &NOTICE($cmdnick, "  +i   (player can !invite, not auto-kicked for idle)");
  1352.                                 &NOTICE($cmdnick, "  +k   (player can !kick troublemakers or get !idle reports)");
  1353.                                 &NOTICE($cmdnick, "  +m   (player can !mask to adjust other players' host masks)");
  1354.                                 &NOTICE($cmdnick, "  +n   (player can !next to end the current question)");
  1355.                                 &NOTICE($cmdnick, "  +o   (player is (channel operator), can !op / !deop, can !mode other players)");
  1356.                                 &NOTICE($cmdnick, "  +q   (player can !quit or !reconnect the $botnick)");
  1357.                                 &NOTICE($cmdnick, "  +t   (player can !topic to override auto channel topics)");
  1358.                                 &NOTICE($cmdnick, "  +z   (player can !zero season scores)");
  1359.                                 &NOTICE($cmdnick, "Example: !mode +a-tz SaSp1998");
  1360.                                 return;
  1361.                         };
  1362.  
  1363.                 ($commandfields[1] =~ /command/) && do
  1364.                         {
  1365.                                 if ($player[$sFlags] =~ /[a-z]/)
  1366.                                         { &NOTICE($cmdnick, "Commands available to you:" . $__kolor . "3 (privileged commands)"); }
  1367.                                 else
  1368.                                         { &NOTICE($cmdnick, "Available commands:"); }
  1369.  
  1370.                                 &NOTICE($cmdnick, "  !add    (to submit new questions)");
  1371.                                 if ($player[$sFlags] =~ /b/) { &NOTICE($cmdnick, $__kolor . "3  !ban      (to kick and blacklist players)"); }
  1372.                                 if ($player[$sFlags] =~ /f/) { &NOTICE($cmdnick, $__kolor . "3  !category (to choose next period's category)"); }
  1373.                                 &NOTICE($cmdnick, "  !fix      (to mark the question for a spelling or fact fix)");
  1374.                                 if ($player[$sFlags] =~ /f/) { &NOTICE($cmdnick, $__kolor . "3  !friend   (to make a friend of the channel)"); }
  1375.                                 &NOTICE($cmdnick, "  !hint     (to begin showing hints)");
  1376.                                 if ($player[$sFlags] =~ /[bk]/) { &NOTICE($cmdnick, $__kolor . "3  !idle     (to see idle times of players)"); }
  1377.                                 if ($player[$sFlags] =~ /i/) { &NOTICE($cmdnick, $__kolor . "3  !invite   (to invite players)"); }
  1378.                                 if ($bTeams) { &NOTICE($cmdnick, "  !join     (to join a team)"); }
  1379.                                 if ($player[$sFlags] =~ /k/) { &NOTICE($cmdnick, $__kolor . "3  !kick     (to kick players)"); }
  1380.                                 if ($player[$sFlags] =~ /m/) { &NOTICE($cmdnick, $__kolor . "3  !mask     (to adjust players' host masks)"); }
  1381.                                 if ($player[$sFlags] =~ /n/) { &NOTICE($cmdnick, $__kolor . "3  !next     (to end the current question)"); }
  1382.                                 if ($player[$sFlags] =~ /o/) { &NOTICE($cmdnick, $__kolor . "3  !mode     (to adjust players' $botnick mode flags)"); }
  1383.                                 &NOTICE($cmdnick, "  !ping     (to request a latency ping)");
  1384.                                 if ($player[$sFlags] =~ /q/) { &NOTICE($cmdnick, $__kolor . "3  !quit     (to shut down $botnick)"); }
  1385.                                 &NOTICE($cmdnick, "  !repeat   (to repeat current question)");
  1386.                                 &NOTICE($cmdnick, "  !rules    (to show game rules)");
  1387.                                 &NOTICE($cmdnick, "  !server   (to show best irc server)");
  1388.                                 &NOTICE($cmdnick, "  !seen     (to show when your friend was on)");
  1389.                                 &NOTICE($cmdnick, "  !stats    (to show your stats)");
  1390.                                 &NOTICE($cmdnick, "  !suggest  (to make a suggestion)");
  1391.                                 if ($player[$sFlags] =~ /t/) { &NOTICE($cmdnick, $__kolor . "3  !teams on/off (enable or disable teams)"); }
  1392.                                 if ($player[$sFlags] =~ /a/) { &NOTICE($cmdnick, $__kolor . "3  !topic    (to override topics)"); }
  1393.                                 if ($player[$sFlags] =~ /z/) { &NOTICE($cmdnick, $__kolor . "3  !zero     (to zero season scores)"); }
  1394.                                 return;
  1395.                         };
  1396.  
  1397.                 ($commandfields[1] =~ /web/) && do
  1398.                         {
  1399.                                 &NOTICE($cmdnick, "Visit the $botchan website at $homeurl");
  1400.                                 if ($player[$nRank] > 0)
  1401.                                 {
  1402.                                         &NOTICE($cmdnick, "To add yourself to the 'friends' page, do !asl " .
  1403.                                                 irccolor("your age",3) . "/" .
  1404.                                                 irccolor("male or female",3) . "/" .
  1405.                                                 irccolor("city or country",3));
  1406.                                         &NOTICE($cmdnick, "You can omit any of the three that you wish with -, for example, !asl 31/m/-");
  1407.                                         &NOTICE($cmdnick,
  1408.                                                 "Please be honest about any age/sex/location you provide. " .
  1409.                                                 "Any 'jokes' will get removed, and you may even be suspended from the game for profanity.");
  1410.                                 }
  1411.                                 return;
  1412.                         };
  1413.                 }
  1414.  
  1415.                 &NOTICE($cmdnick, "To play, just watch for $botnick to ask questions, and type in the answer.");
  1416.                 &NOTICE($cmdnick, "Some useful commands to get you started:");
  1417.                 &NOTICE($cmdnick, "   !hint     (shows some letters of the answer, helping you guess)");
  1418.                 &NOTICE($cmdnick, "   !repeat   (if you missed the question)");
  1419.                 &NOTICE($cmdnick, "   !stats    (to see your stats and scores)");
  1420.  
  1421.                 &NOTICE($cmdnick, "More help is on the following topics, do !help <topic> for more information.");
  1422.                 &NOTICE($cmdnick, "   auth   best   categories   commands   gmail   website");
  1423.  
  1424.                 return;
  1425.         }
  1426.  
  1427.         #
  1428.         # idle command -------------------------------------------------------------
  1429.         #
  1430.         if ($thecommand eq 'idle' && $player[$sFlags] =~ /[bk]/)
  1431.         {
  1432.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1433.  
  1434.                 my %idles = ();
  1435.                 foreach $nick (keys %active)
  1436.                 {
  1437.                         if (!isactive($nick)) { next; }
  1438.                         @player = getplayer($nick);
  1439.                         if ($player[$sFlags] =~ /d/) { next; }
  1440.                         $idles{$player[$sNick]} = (time() - $player[$tWhenLastSaid]);
  1441.                 }
  1442.  
  1443.                 my @sorted = (sort { $idles{$b} <=> $idles{$a} } keys %idles);
  1444.  
  1445.                 foreach $nick (@sorted)
  1446.                 {
  1447.                         my $k = 3;
  1448.  
  1449.                         if ($idles{$nick} < 60) { last; }
  1450.  
  1451.                         if ($idles{$nick} >= $nTimeIdleWarning) { $k = 8; }
  1452.                         if ($idles{$nick} >= $nTimeIdleKick) { $k = 4; }
  1453.                         &NOTICE($cmdnick, qwizcolor("$nick idle for " . describetimespan($idles{$nick}), $k));
  1454.                 }
  1455.                 return;
  1456.         }
  1457.         if ($thecommand eq 'deidle' && $player[$sFlags] =~ /[bk]/ && isactive($commandfields[1]))
  1458.         {
  1459.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1460.  
  1461.                 @player = getplayer($commandfields[1]);
  1462.                 $player[$tWhenLastSaid] = time();
  1463.                 setplayer(@player);
  1464.                 delete $idles{$player[$sNick]};
  1465.                 return;
  1466.         }
  1467.  
  1468.         #
  1469.         # invite command -------------------------------------------------------------
  1470.         #
  1471.         if ($thecommand eq 'invite' && $player[$sFlags] =~ /i/)
  1472.         {
  1473.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1474.  
  1475.                 my $i = 0;
  1476.                 for $n (1 .. $#commandfields)
  1477.                 {
  1478.                         if (isactive($commandfields[$n]))
  1479.                         {
  1480.                                 &NOTICE($cmdnick, "$commandfields[$n] is already here.");
  1481.                                 next;
  1482.                         }
  1483.  
  1484.                         if (isplayer($commandfields[$n]))
  1485.                         {
  1486.                                 my @player = getplayer($commandfields[$n]);
  1487.                                 if ($bTeams > 0 && $player[$nTeam] != 1)
  1488.                                 {
  1489.                                         &NOTICE($commandfields[$n], "Team $teamname[$player[$nTeam]] needs you!");
  1490.                                 }
  1491.                                 else
  1492.                                 {
  1493.                                         &NOTICE($commandfields[$n], "You know the answers to these questions! We need you.");
  1494.                                 }
  1495.                         }
  1496.  
  1497.                         $i++;
  1498.                         ircsendline(S, "INVITE $commandfields[$n] $botchan");
  1499.                 }
  1500.                 &NOTICE($cmdnick, "Invited $i players to $botchan.\n");
  1501.                 return;
  1502.         }
  1503.  
  1504.         #
  1505.         # kick command -------------------------------------------------------------
  1506.         #
  1507.         if ($thecommand eq 'kick' && $player[$sFlags] =~ /k/)
  1508.         {
  1509.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1510.  
  1511.                 qwizkick($commandfields[1], $cmdnick, '');
  1512.                 deactivateplayer($commandfields[1]);
  1513.                 return;
  1514.         }
  1515.  
  1516.         #
  1517.         # mask command -------------------------------------------------------------
  1518.         #
  1519.         if ($thecommand eq 'mask')
  1520.         {
  1521.                 #
  1522.                 # !mask
  1523.                 #
  1524.                 if ((!defined($commandfields[1])) ||
  1525.                     (($commandfields[1] eq $sPassword) && ($player[$sFlags] =~ /o/)))
  1526.                 {
  1527.                         if ($player[$sFlags] =~ /[^fi]/ && $commandfields[1] ne $sPassword)
  1528.                         {
  1529.                                 &NOTICE($cmdnick, "Sorry, you can't adjust your mask yourself; please speak with another operator to get recognized.");
  1530.                                 if ($player[$sFlags] =~ /m/)
  1531.                                         { &NOTICE($cmdnick, "Usage: !mask PlayerName theirident@*.theirhost.net"); }
  1532.                                 return;
  1533.                         }
  1534.  
  1535.                         my $mask = ircmaskfromhost($cmdhost);
  1536.  
  1537.                         $player[$sMask] = $mask;
  1538.                         setplayer(@player);
  1539.                         writeplayers();
  1540.                         &USERHOST($cmdnick);
  1541.                         &NOTICE($cmdnick, "I set your mask to $player[$sMask] and attempted to rejoin you. If this fails, speak with an operator.");
  1542.                         return;
  1543.                 }
  1544.  
  1545.                 #
  1546.                 # !mask me@*.host.net
  1547.                 #
  1548.                 if ($commandfields[1] =~ /^[^@]+\@[^@]+$/ &&
  1549.                     isplayer($cmdnick) &&
  1550.                         !isactive($cmdnick))
  1551.                 {
  1552.                         if ($player[$sFlags] =~ /[^fi]/ && $commandfields[2] ne $sPassword)
  1553.                         {
  1554.                                 &NOTICE($cmdnick, "Sorry, you can't adjust your mask yourself; please speak with another operator to get recognized.");
  1555.                                 return;
  1556.                         }
  1557.  
  1558.                         $player[$sMask] = $commandfields[1];
  1559.                         setplayer(@player);
  1560.                         writeplayers();
  1561.                         &USERHOST($cmdnick);
  1562.                         &NOTICE($cmdnick, "I set your mask to $player[$sMask] and attempted to rejoin you. If this fails, speak with an operator.");
  1563.                         return;
  1564.                 }
  1565.  
  1566.                 #
  1567.                 # !mask PlayerName them@*.host.net
  1568.                 #
  1569.                 if (isactive($cmdnick) && $player[$sFlags] =~ /m/ &&
  1570.                     isplayer($commandfields[1]) &&
  1571.                         $commandfields[2] =~ /^[^@]+\@[^@]+$/)
  1572.                 {
  1573.                         if (isactive($commandfields[1]))
  1574.                                 { &deactivateplayer($commandfields[1]); }
  1575.  
  1576.                         @player = getplayer($commandfields[1]);
  1577.  
  1578.                         my $mask = $commandfields[2];
  1579.  
  1580.                         $player[$sMask] = $commandfields[2];
  1581.                         setplayer(@player);
  1582.                         writeplayers();
  1583.                         &USERHOST($commandfields[1]);
  1584.                         &NOTICE($cmdnick, "I set $commandfields[1]'s mask to $player[$sMask] and attempted to rejoin them.");
  1585.                         return;
  1586.                 }
  1587.  
  1588.                 &NOTICE($cmdnick, "Usage: !mask");
  1589.                 &NOTICE($cmdnick, "   or: !mask myident@*.myhost.net");
  1590.                 if ($player[$sFlags] =~ /m/)
  1591.                         { &NOTICE($cmdnick, "   or: !mask PlayerName theirident@*.theirhost.net"); }
  1592.                 return;
  1593.         }
  1594.  
  1595.         #
  1596.         # mode command -------------------------------------------------------------
  1597.         #
  1598.         if ($thecommand eq 'mode' && $player[$sFlags] =~ /o/)
  1599.         {
  1600.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1601.  
  1602.                 if ($commandfields[1] &&
  1603.                         $commandfields[1] =~ /^[+-]/ &&
  1604.                         $commandfields[2] &&
  1605.                     isplayer($commandfields[2]))
  1606.                 {
  1607.                         my @target = getplayer($commandfields[1]);
  1608.                         my $warn = '';
  1609.                         my $add = '';
  1610.                         my $remove = '';
  1611.                         my @flags = split(/(\+|\-)/, $commandfields[1]);
  1612.                         my $ball;
  1613.                         foreach $a (@flags)
  1614.                         {
  1615.                                 if ($a eq '+' || $a eq '-') { $ball = $a; next;}
  1616.                                 $a =~ s/[^a-z]//gi;
  1617.                                 if ($ball eq '+') { $add .= $a; } else { $remove .= $a; }
  1618.                         }
  1619.  
  1620.                         # those without +x cannot add modes they don't have, themselves.
  1621.                         if ($player[$sFlags] !~ /x/)
  1622.                         {
  1623.                                 my %flags = ();
  1624.                                 for $a (0 .. (length($add)-1))
  1625.                                 {
  1626.                                         $ball = substr($add,$a,1);
  1627.                                         if ($player[$sFlags] =~ /$ball/)
  1628.                                                 { $flags{$ball} = 1; }
  1629.                                         else
  1630.                                                 { $warn = "(Cannot add modes to yourself or others, that you don't have.)"; }
  1631.                                 }
  1632.  
  1633.                                 $add = join('', (sort keys %flags));
  1634.                         }
  1635.  
  1636.                         &modeplayer($cmdnick, $commandfields[2], $add, $remove);
  1637.                         if ($warn ne '')
  1638.                                 { &NOTICE($cmdnick, $warn); }
  1639.                 }
  1640.                 elsif ($commandfields[1] ne '' &&
  1641.                        isplayer($commandfields[1]) &&
  1642.                            $commandfields[2] eq '')
  1643.                 {
  1644.                         @player = getplayer($commandfields[1]);
  1645.                         my $a = $__kolor . "3" . $__bold . $__bold . "$player[$sNick] is mode +$player[$sFlags]";
  1646.                         &NOTICE($cmdnick, $a);
  1647.                 }
  1648.                 else
  1649.                 {
  1650.                         &NOTICE($cmdnick, "Usage: !mode +|-<modes> <nick>");
  1651.                 }
  1652.                 return;
  1653.         }
  1654.  
  1655.         #
  1656.         # op command -------------------------------------------------------------
  1657.         #
  1658.         if ($thecommand eq 'op' && $player[$sFlags] =~ /o/)
  1659.         {
  1660.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1661.  
  1662.                 &OPS($cmdnick);
  1663.                 return;
  1664.         }
  1665.         if ($thecommand eq 'deop' && $player[$sFlags] =~ /o/)
  1666.         {
  1667.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1668.  
  1669.                 &DEOPS($cmdnick);
  1670.                 return;
  1671.         }
  1672.  
  1673.         #
  1674.         # ping command -------------------------------------------------------------
  1675.         #
  1676.         if ($thecommand eq 'ping')
  1677.         {
  1678.                 &PING($cmdnick);
  1679.                 return;
  1680.         }
  1681.  
  1682.         #
  1683.         # quit command -------------------------------------------------------------
  1684.         #
  1685.         if ($thecommand eq 'quit')
  1686.         {
  1687.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1688.  
  1689.                 if ($player[$sFlags] =~ /q/)
  1690.                 {
  1691.                         quitbot();
  1692.                 }
  1693.                 return;
  1694.         }
  1695.         if ($thecommand eq 'die')
  1696.         {
  1697.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1698.  
  1699.                 if ($player[$sFlags] =~ /q/)
  1700.                 {
  1701.                         $bDieRound = 1;
  1702.                         &NOTICE($cmdnick, "The bot will quit after this round.");
  1703.                 }
  1704.                 return;
  1705.         }
  1706.  
  1707.         #
  1708.         # remotes command -------------------------------------------------------------
  1709.         #
  1710.         if ($thecommand eq 'remotes')
  1711.         {
  1712.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1713.  
  1714.                 if ($player[$sFlags] =~ /r/)
  1715.                 {
  1716.                         foreach $who (keys %mentions)
  1717.                         {
  1718.                                 &NOTICE($cmdnick, "$who " . describetimespan($now - $mentions{$who}));
  1719.                         }
  1720.                 }
  1721.                 return;
  1722.         }
  1723.  
  1724.         #
  1725.         # server command -------------------------------------------------------------
  1726.         #
  1727.         if ($thecommand eq 'server')
  1728.         {
  1729.                 &NOTICE($cmdnick, "Try cutting and pasting this command for the best speed:  /server $ircserver:$ircport");
  1730.                 &NOTICE($cmdnick, "Don't forget to /join $botchan");
  1731.                 return;
  1732.         }
  1733.  
  1734.         #
  1735.         # seen command -------------------------------------------------------------
  1736.         #
  1737.         if ($thecommand eq 'seen' && $commandfields[1])
  1738.         {
  1739.                 my $who = $commandfields[1];
  1740.                 if (isplayer($who))
  1741.                 {
  1742.                         my @player = getplayer($who);
  1743.                         if (isactive($who))
  1744.                         {
  1745.                                 &NOTICE($cmdnick, "It looks like $player[$sNick] is still here.");
  1746.                         }
  1747.                         else
  1748.                         {
  1749.                                 my $span = time() - int($player[$tWhenSeen]);
  1750.                                 $span = describetimespan($span);
  1751.                                 &NOTICE($cmdnick, "I last saw $player[$sNick] $span ago.");
  1752.                         }
  1753.                 }
  1754.                 else
  1755.                 {
  1756.                         &NOTICE($cmdnick, "I have no record of a player named $who.\n");
  1757.                 }
  1758.                 return;
  1759.         }
  1760.  
  1761.         #
  1762.         # suggest command -------------------------------------------------------------
  1763.         #
  1764.         if ($thecommand eq 'suggest')
  1765.         {
  1766.                 $rcommand =~ s/^suggest\s*//i;
  1767.  
  1768.                 if ($rcommand !~ /\S/)
  1769.                 {
  1770.                         &NOTICE($cmdnick, "Usage: !suggest <suggestion>");
  1771.                         &NOTICE($cmdnick, "   or: /msg $botnick suggest <suggestion> (for privacy)");
  1772.                         return;
  1773.                 }
  1774.  
  1775.                 #
  1776.                 # save submission to the submission file
  1777.                 #
  1778.                 if (!open(INFO, ">>$suggestionfile"))
  1779.                 {
  1780.                         if ($nick ne '')
  1781.                         {
  1782.                                 &NOTICE($nick, "Unable to save your suggestion. Try again later.\n");
  1783.                         }
  1784.                         return;
  1785.                 }
  1786.                 my $a = localtime(time());
  1787.                 print INFO "$player[$sNick] | $a | $rcommand\n";
  1788.                 close(INFO);
  1789.  
  1790.                 &NOTICE($cmdnick, "Suggestion accepted for consideration. Thank you!\n");
  1791.                 return;
  1792.         }
  1793.  
  1794.         #
  1795.         # save command -------------------------------------------------------------
  1796.         #
  1797.         if ($thecommand eq 'save' && $player[$sFlags] =~ /s/)
  1798.         {
  1799.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1800.  
  1801.                 savebot();
  1802.                 &NOTICE($cmdnick, "Saved everything.");
  1803.                 return;
  1804.         }
  1805.  
  1806.         #
  1807.         # wizard spoof command -------------------------------------------------------------
  1808.         # !<nick> !command arguments
  1809.         # /msg Bot <nick> command arguments
  1810.         #
  1811.         if (($player[$sFlags] =~ /w/) &&
  1812.             ($player[$sFlags] =~ /x/) &&
  1813.             ($thecommand =~ /^\<(\S+)\>$/))
  1814.         {
  1815.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1816.  
  1817.                 if (isactive($1))
  1818.                 {
  1819.                         $targetplayer = $1;
  1820.                         &DEBUGMSG("** Wizard forcing $targetplayer; whole command is \'$rcommand\'.");
  1821.                         $rcommand =~ /^\<.*\>\s+(.+)$/;
  1822.                         &NOTICE($cmdnick, "Forcing $targetplayer to '$1'.");
  1823.                         r_command($targetplayer,'',$1,1);
  1824.                 }
  1825.                 else
  1826.                 {
  1827.                         &NOTICE($cmdnick, "No active player named $1.");
  1828.                 }
  1829.                 return;
  1830.         }
  1831.  
  1832.         #
  1833.         # wizard say command -------------------------------------------------------------
  1834.         # !/say action
  1835.         # /msg Bot /say action
  1836.         #
  1837.         if (($player[$sFlags] =~ /w/) &&
  1838.             ($thecommand eq '/say') &&
  1839.                 $commandfields[1] ne '')
  1840.         {
  1841.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1842.  
  1843.                 $rcommand =~ /\/say\s+(.+)$/;
  1844.                 &CHANMSG($1);
  1845.                 return;
  1846.         }
  1847.  
  1848.         #
  1849.         # wizard msg command -------------------------------------------------------------
  1850.         # !/msg nick action
  1851.         # /msg Bot /msg nick action
  1852.         #
  1853.         if (($player[$sFlags] =~ /w/) &&
  1854.             ($thecommand eq '/msg') &&
  1855.                 $commandfields[1] ne '' &&
  1856.                 $commandfields[2] ne '')
  1857.         {
  1858.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1859.  
  1860.                 $rcommand =~ /\/msg\s+(\S+)\s+(.+)$/;
  1861.                 &PRIVMSG($1, $2);
  1862.                 return;
  1863.         }
  1864.  
  1865.         #
  1866.         # wizard action command -------------------------------------------------------------
  1867.         # !/me action
  1868.         # /msg Bot /me action
  1869.         #
  1870.         if (($player[$sFlags] =~ /w/) &&
  1871.             ($thecommand eq '/me') &&
  1872.                 $commandfields[1] ne '')
  1873.         {
  1874.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1875.  
  1876.                 $rcommand =~ /\/me\s+(.+)$/;
  1877.                 &CHANACTION($1);
  1878.                 return;
  1879.         }
  1880.  
  1881.         #
  1882.         # wizard nick command -------------------------------------------------------------
  1883.         # !/nick name
  1884.         # /msg Bot /nick name
  1885.         #
  1886.         if (($player[$sFlags] =~ /w/) &&
  1887.             ($player[$sFlags] =~ /x/) &&
  1888.             ($thecommand eq '/nick') &&
  1889.                 $commandfields[1] ne '')
  1890.         {
  1891.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1892.  
  1893.                 ($botnick) = ($botnick =~ /\/nick\s+(\S+)\s*.*$/);
  1894.                 #$botnick =~ /\/nick\s+(\S+)\s*.*$/);
  1895.                 $botwantnick = $botnick;
  1896.                 ircsendline(S, "NICK $botnick");
  1897.                 return;
  1898.         }
  1899.  
  1900.         #
  1901.         # wizard server command -------------------------------------------------------------
  1902.         # !/server name
  1903.         # /msg Bot /server name
  1904.         #
  1905.         if (($player[$sFlags] =~ /w/) &&
  1906.             ($player[$sFlags] =~ /x/) &&
  1907.             ($thecommand eq '/server'))
  1908.         {
  1909.                 if (!isauthed($cmdnick)) { &NOTICE($cmdnick, "Not authorized. See !help auth"); return; }
  1910.  
  1911.                 my ($serv,$port);
  1912.                 if ($commandfields[1] ne '')
  1913.                 {
  1914.                         ($serv,$port) = split(/:/, $commandfields[1]);
  1915.                 }
  1916.                 else
  1917.                 {
  1918.                         my ($head) = splice(@servers, 0, 1);
  1919.                         push(@servers, $head);
  1920.                         ($serv,$port) = split(/:/, $servers[0]);
  1921.                 }
  1922.                 $serv = $ircserver if !defined($serv);
  1923.                 $port = $ircport if !defined($port);
  1924.  
  1925.                 $ircserver = $serv;
  1926.                 $ircport = $port;
  1927.                 $bQuit = 0;
  1928.                 $bServerOverride = 1;
  1929.                 &QUIT("Reconnecting; expecting to move to $ircserver:$ircport)");
  1930.                 return;
  1931.         }
  1932.  
  1933.         #
  1934.         # not a bot-related command, maybe a game command
  1935.         #
  1936.  
  1937.         gamecommand($cmdnick, $cmdhost, $rcommand, $ispublic);
  1938. }
  1939.  
  1940. #----------------------------------------------------------------------------
  1941.  
  1942. sub qwizcolor #($string,$fg,$bg)
  1943. {
  1944.         local($string, $fg, $bg) = @_;
  1945.         $fg = 1 if !defined($fg);
  1946.         $bg = 14 if !defined($bg);
  1947.         if ($bg == 14 && $bTeams == 0)
  1948.                 { $bg = 11; }
  1949.  
  1950.         # IRC color codes are [^K]digits or [^K]digits,digits
  1951.         # If $string starts with digits, we insert two [^B] bold toggles.
  1952.         # This should have no visual impact on most IRC clients.
  1953.  
  1954.         if (substr($string,0,1) =~ /[0-9]/)
  1955.                 { return $__kolor . "$fg,$bg" . $__bold . $__bold . $string . $__kolor; }
  1956.  
  1957.         return $__kolor . "$fg,$bg" . $string . $__kolor;
  1958. }
  1959.  
  1960. #----------------------------------------------------------------------------
  1961.  
  1962. main();

Pastebin is for source code and general debugging text.

Login or Register to edit, delete and keep track of your pastes and more.

Raw Paste

Login or Register to edit or fork this paste. It's free.