blootbot/src/UserExtra.pl

   1 #
   2 # UserExtra.pl: User Commands, Public.
   3 #       Author: dms
   4 #      Version: v0.2b (20000707)
   5 #      Created: 20000107
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 use vars qw($message $arg $qWord $verb $lobotomized);
  11 use vars qw(%channels %chanstats %cmdstats);
  12
  13 ###
  14 ### Start of command hooks for UserExtra.
  15 ###
  16
  17 &addCmdHook("main", 'chan(stats|info)', ('CODEREF' => 'chaninfo', ) );
  18 &addCmdHook("main", 'cmd(stats|info)', ('CODEREF' => 'cmdstats', ) );
  19 &addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo',
  20         'Cmdstats' => 'Factoid Info', Module => 'factoids', ) );
  21 &addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats',
  22         'Cmdstats' => 'Factoid Statistics', Help => "factstats",
  23         Forker => 1, 'Identifier' => 'factoids', ) );
  24 &addCmdHook("main", 'help', ('CODEREF' => 'help',
  25         'Cmdstats' => 'Help', ) );
  26
  27 &status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks.");
  28
  29 ###
  30 ### Start of commands for hooks.
  31 ###
  32
  33 sub chaninfo {
  34     my $chan = lc shift(@_);
  35     my $mode;
  36
  37     if ($chan eq "") {          # all channels.
  38         my $count       = 0;
  39         my $i           = keys %channels;
  40         my $reply       = "i am on \002$i\002 ".&fixPlural("channel",$i);
  41         my @array;
  42
  43         ### line 1.
  44         foreach (sort keys %channels) {
  45             if (/^\s*$/ or / /) {
  46                 &status("chanstats: fe channels: chan == NULL.");
  47                 &ircCheck();
  48                 next;
  49             }
  50             push(@array, "$_ (".scalar(keys %{$channels{$_}{''}}).")");
  51         }
  52         &performStrictReply($reply.": ".join(' ', @array));
  53
  54         ### line 2.
  55         foreach $chan (keys %channels) {
  56             # crappy debugging...
  57             # TODO: use $mask{chan} instead?
  58             if ($chan =~ / /) {
  59                 &ERROR("bad channel: chan => '$chan'.");
  60             }
  61             $count += scalar(keys %{$channels{$chan}{''}});
  62         }
  63         &performStrictReply(
  64                 "i've cached \002$count\002 ".&fixPlural("user",$count).
  65                 " distributed over \002".scalar(keys %channels)."\002 ".
  66                 &fixPlural("channel",scalar(keys %channels))."."
  67         );
  68
  69         return $noreply;
  70     }
  71
  72     # channel specific.
  73
  74     if (&validChan($chan) == 0) {
  75         &msg($who,"error: invalid channel \002$chan\002");
  76         return $noreply;
  77     }
  78
  79     # Step 1:
  80     my @array;
  81     foreach (sort keys %{$chanstats{$chan}}) {
  82         my $int = $chanstats{$chan}{$_};
  83         next unless ($int);
  84
  85         push(@array, "\002$int\002 ". &fixPlural($_,$int));
  86     }
  87     my $reply = "On \002$chan\002, there ".
  88                 &fixPlural("has",scalar(@array)). " been ".
  89                 &IJoin(@array);
  90
  91     # Step 1b: check channel inconstencies.
  92     $chanstats{$chan}{'Join'}           ||= 0;
  93     $chanstats{$chan}{'SignOff'}        ||= 0;
  94     $chanstats{$chan}{'Part'}           ||= 0;
  95
  96     my $delta_stats = $chanstats{$chan}{'Join'}
  97                 - $chanstats{$chan}{'SignOff'}
  98                 - $chanstats{$chan}{'Part'};
  99
 100     if ($delta_stats) {
 101         my $total = scalar(keys %{$channels{$chan}{''}});
 102         &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total).");
 103
 104         if ($delta_stats > $total) {
 105             &ERROR("chaninfo: delta_stats exceeds total users.");
 106         }
 107     }
 108
 109     # Step 2:
 110     undef @array;
 111     my $type;
 112     foreach ("v","o","") {
 113         my $int = scalar(keys %{$channels{$chan}{$_}});
 114         next unless ($int);
 115
 116         $type = "Voice" if ($_ eq "v");
 117         $type = "Opped" if ($_ eq "o");
 118         $type = "Total" if ($_ eq "");
 119
 120         push(@array,"\002$int\002 $type");
 121     }
 122     $reply .= ".  At the moment, ". &IJoin(@array);
 123
 124     # Step 3:
 125     ### TODO: what's wrong with the following?
 126     my %new = map { $userstats{$_}{'Count'} => $_ } keys %userstats;
 127     my($count) = (sort { $b <=> $a } keys %new)[0];
 128     if ($count) {
 129         $reply .= ".  \002$new{$count}\002 has said the most with a total of \002$count\002 messages";
 130     }
 131     &performStrictReply("$reply.");
 132 }
 133
 134 # Command statistics.
 135 sub cmdstats {
 136     my @array;
 137
 138     if (!scalar(keys %cmdstats)) {
 139         &performReply("no-one has run any commands yet");
 140         return $noreply;
 141     }
 142
 143     my %countstats;
 144     foreach (keys %cmdstats) {
 145         $countstats{$cmdstats{$_}}{$_} = 1;
 146     }
 147
 148     foreach (sort {$b <=> $a} keys %countstats) {
 149         my $int = $_;
 150         next unless ($int);
 151
 152         foreach (keys %{$countstats{$int}}) {
 153             push(@array, "\002$int\002 of $_");
 154         }
 155     }
 156     &performStrictReply("command usage include ". &IJoin(@array).".");
 157 }
 158
 159 # Factoid extension info. xk++
 160 sub factinfo {
 161     my $faqtoid = lc shift(@_);
 162     my $query   = "";
 163
 164     if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) {
 165         &msg($who,"error: individual factoid info queries not supported as yet.");
 166         &msg($who,"it's possible that the factoid mistakenly begins with '-'.");
 167         return $noreply;
 168
 169         $query   = lc $1;
 170         $faqtoid = lc $3;
 171     }
 172
 173     &CmdFactInfo($faqtoid, $query);
 174 }
 175
 176 sub factstats {
 177     my $type = shift(@_);
 178
 179     &Forker("factoids", sub {
 180         &performStrictReply( &CmdFactStats($type) );
 181     } );
 182 }
 183
 184 sub userCommands {
 185     # conversion: ascii.
 186     if ($message =~ /^(asci*|chr) (\d+)$/) {
 187         return '' unless (&IsParam("allowConv"));
 188
 189         $arg = $2;
 190         if ($arg < 32) {
 191             $arg += 64;
 192             $result = "^".chr($arg);
 193         } else {
 194             $result = chr($2);
 195         }
 196         $result = "NULL"        if ($arg == 0);
 197
 198         &performReply( sprintf("ascii %s is '%s'", $arg, $result) );
 199         return $noreply;
 200     }
 201
 202     # conversion: ord.
 203     if ($message =~ /^ord (.)$/) {
 204         return '' unless (&IsParam("allowConv"));
 205
 206         $arg = $1;
 207         if (ord($arg) < 32) {
 208             $arg = chr(ord($arg) + 64);
 209             if ($arg eq chr(64)) {
 210                 $arg = 'NULL';
 211             } else {
 212                 $arg = '^'.$arg;
 213             }
 214         }
 215
 216         &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) );
 217         return $noreply;
 218     }
 219
 220     # hex.
 221     if ($message =~ /^hex(\s+(.*))?$/i) {
 222         my $arg = $2;
 223
 224         if (!defined $arg) {
 225             &help("hex");
 226             return $noreply;
 227         }
 228
 229         if (length $arg > 80) {
 230             &msg($who, "Too long.");
 231             return $noreply;
 232         }
 233
 234         my $retval;
 235         foreach (split //, $arg) {
 236             $retval .= sprintf(" %X", ord($_));
 237         }
 238
 239         &performStrictReply("$arg is$retval");
 240
 241         return $noreply;
 242     }
 243
 244     # crypt.
 245     if ($message =~ /^crypt\s+(\S+)\s*(?:,| )\s*(\S+)/) {
 246         # word salt.
 247         &performStrictReply(crypt($1, $2));
 248         return $noreply;
 249     }
 250
 251
 252     # karma.
 253     if ($message =~ /^karma(\s+(\S+))?\??$/i) {
 254         return '' unless (&IsParam("karma"));
 255
 256         my $target = lc $2 || lc $who;
 257
 258         my $karma = &dbGet("karma", "nick",$target,"karma") || 0;
 259         if ($karma != 0) {
 260             &performStrictReply("$target has karma of $karma");
 261         } else {
 262             &performStrictReply("$target has neutral karma");
 263         }
 264
 265         return $noreply;
 266     }
 267
 268     # ignorelist.
 269     if ($message =~ /^ignorelist$/i) {
 270         &status("$who asked for the ignore list");
 271
 272         my $time = time();
 273         my $count = scalar(keys %ignoreList);
 274         my $counter = 0;
 275         my @array;
 276
 277         if ($count == 0) {
 278             &performStrictReply("no one in the ignore list!!!");
 279             return $noreply;
 280         }
 281
 282         foreach (sort keys %ignoreList) {
 283             my $str;
 284
 285             if ($ignoreList{$_} != 1) { # temporary ignore.
 286                 my $expire = $ignoreList{$_} - $time;
 287                 if (defined $expire and $expire < 0) {
 288                     &status("ignorelist: deleting $_.");
 289                     delete $ignoreList{$_};
 290                 } else {
 291                     $str = "$_ (". &Time2String($expire) .")";
 292                 }
 293             } else {
 294                 $str = $_;
 295             }
 296
 297             push(@array,$str);
 298             $counter++;
 299             if (scalar @array >= 8 or $counter == $count) {
 300                 &msg($who, &formListReply(0, "Ignore list ", @array) );
 301                 @array = ();
 302             }
 303         }
 304
 305         return $noreply;
 306     }
 307
 308     # ispell.
 309     if ($message =~ /^spell(\s+(.*))?$/) {
 310         return '' unless (&IsParam("spell"));
 311         my $query = $2;
 312
 313         if ($query eq "") {
 314             &help("spell");
 315             return $noreply;
 316         }
 317
 318         if (! -x "/usr/bin/spell") {
 319             &msg($who, "no binary found.");
 320             return $noreply;
 321         }
 322
 323         if (!&validExec($query)) {
 324             &msg($who,"argument appears to be fuzzy.");
 325             return $noreply;
 326         }
 327
 328         my $reply = "I can't find alternate spellings for '$query'";
 329
 330         foreach (`echo '$query' | ispell -a -S`) {
 331             chop;
 332             last if !length;            # end of query.
 333
 334             if (/^\@/) {                # intro line.
 335                 next;
 336             } elsif (/^\*/) {           # possibly correct.
 337                 $reply = "'$query' may be spelled correctly";
 338                 last;
 339             } elsif (/^\&/) {           # possible correction(s).
 340                 s/^\& (\S+) \d+ \d+: //;
 341                 my @array = split(/,? /);
 342
 343                 $reply = "possible spellings for $query: @array";
 344                 last;
 345             } elsif (/^\+/) {
 346                 &DEBUG("spell: '+' found => '$_'.");
 347                 last;
 348             } else {
 349                 &DEBUG("spell: unknown: '$_'.");
 350             }
 351         }
 352
 353         &performStrictReply($reply);
 354
 355         return $noreply;
 356     }
 357
 358     # nslookup.
 359     if ($message =~ /^(dns|nslookup)(\s+(\S+))?$/i) {
 360         return '' unless (&IsParam("allowDNS"));
 361
 362         if ($3 eq "") {
 363             &help("nslookup");
 364             return $noreply;
 365         }
 366
 367         &status("DNS Lookup: $3");
 368         &loadMyModule($myModules{'allowDNS'});
 369         &DNS($3);
 370         return $noreply;
 371     }
 372
 373     # cycle.
 374     if ($message =~ /^(cycle)(\s+(\S+))?$/i) {
 375         return $noreply unless (&hasFlag("o"));
 376         my $chan = lc $3;
 377
 378         if ($chan eq "") {
 379             if ($msgType =~ /public/) {
 380                 $chan = $talkchannel;
 381                 &DEBUG("cycle: setting chan to '$chan'.");
 382             } else {
 383                 &help("cycle");
 384                 return $noreply;
 385             }
 386         }
 387
 388         if (&validChan($chan) == 0) {
 389             &msg($who,"error: invalid channel \002$chan\002");
 390             return $noreply;
 391         }
 392
 393         &msg($chan, "I'm coming back. (courtesy of $who)");
 394         &part($chan);
 395 ###     &ScheduleThis(5, "getNickInUse") if (@_);
 396         &status("Schedule rejoin in 5secs to $chan by $who.");
 397         $conn->schedule(5, sub { &joinchan($chan); });
 398
 399         return $noreply;
 400     }
 401
 402     # redir.
 403     if ($message =~ /^redir(\s+(.*))?/i) {
 404         return $noreply unless (&hasFlag("o"));
 405         my $factoid = $2;
 406
 407         if (!defined $factoid) {
 408             &help("redir");
 409             return $noreply;
 410         }
 411
 412         my $val  = &getFactInfo($factoid, "factoid_value");
 413         if (!defined $val or $val eq "") {
 414             &msg($who, "error: '$factoid' does not exist.");
 415             return $noreply;
 416         }
 417         &DEBUG("val => '$val'.");
 418         my @list = &searchTable("factoids", "factoid_key",
 419                                         "factoid_value", "^$val\$");
 420
 421         if (scalar @list == 1) {
 422             &msg($who, "hrm... '$factoid' is unique.");
 423             return $noreply;
 424         }
 425         if (scalar @list > 5) {
 426             &msg($who, "A bit too many factoids to be redirected, hey?");
 427             return $noreply;
 428         }
 429
 430         my @redir;
 431         &status("Redirect '$factoid' (". ($#list) .")...");
 432         for (@list) {
 433             next if (/^\Q$factoid\E$/i);
 434
 435             &status("  Redirecting '$_'.");
 436             my $was = &getFactoid($_);
 437             &DEBUG("  was '$was'.");
 438             push(@redir,$_);
 439             &setFactInfo($_, "factoid_value", "<REPLY> see $factoid");
 440         }
 441         &status("Done.");
 442
 443         &msg($who, &formListReply(0, "'$factoid' is redirected to by '", @redir));
 444
 445         return $noreply;
 446     }
 447
 448     # rot13 it.
 449     if ($message =~ /^rot13(\s+(.*))?/i) {
 450         my $reply = $2;
 451
 452         if ($reply eq "") {
 453             &help("rot13");
 454             return $noreply;
 455         }
 456
 457         $reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
 458         &performStrictReply($reply);
 459
 460         return $noreply;
 461     }
 462
 463     # ircstats.
 464     if ($message =~ /^ircstats$/i) {
 465         my $count       = $ircstats{'ConnectCount'};
 466         my $format_time = &Time2String(time() - $ircstats{'ConnectTime'});
 467         my $reply;
 468
 469         foreach (keys %ircstats) {
 470             &DEBUG("ircstats: $_ => '$ircstats{$_}'.");
 471         }
 472
 473         ### RECONNECT COUNT.
 474         if ($count == 1) {      # good.
 475             $reply = "I'm connected to $ircstats{'Server'} and have been so".
 476                 " for $format_time";
 477         } else {
 478             $reply = "Currently I'm hooked up to $ircstats{'Server'} but only".
 479                 " for $format_time.  ".
 480                 "I had to reconnect \002$count\002 times.";
 481         }
 482
 483         ### REASON.
 484         my $reason = $ircstats{'DisconnectReason'};
 485         if (defined $reason) {
 486             $reply .= "  I was last disconnected for '$reason'.";
 487         }
 488
 489         &performStrictReply($reply);
 490
 491         return $noreply;
 492     }
 493
 494     # status.
 495     if ($message =~ /^statu?s$/i) {
 496         my $startString = scalar(localtime $^T);
 497         my $upString    = &Time2String(time() - $^T);
 498         my $count       = &countKeys("factoids");
 499
 500         &performStrictReply(
 501         "Since $startString, there have been".
 502           " \002$count{'Update'}\002 ".
 503                 &fixPlural("modification", $count{'Update'}).
 504           " and \002$count{'Question'}\002 ".
 505                 &fixPlural("question",$count{'Question'}).
 506           " and \002$count{'Dunno'}\002 ".
 507                 &fixPlural("dunno",$count{'Dunno'}).
 508           " and \002$count{'Moron'}\002 ".
 509                 &fixPlural("moron",$count{'Moron'}).
 510           ".  I have been awake for $upString this session, and ".
 511           "currently reference \002$count\002 factoids.  ".
 512           "I'm using about \002$memusage\002 ".
 513           "kB of memory."
 514         );
 515
 516         return $noreply;
 517     }
 518
 519     # tell.
 520     if ($message =~ /^(tell|explain)(\s+(.*))?$/) {
 521         return '' unless (&IsParam("allowTelling"));
 522
 523         my $args = $3;
 524         if (!defined $args) {
 525             &help("tell");
 526             return $noreply;
 527         }
 528
 529         my ($target, $tell_obj) = ('','');
 530         my $reply;
 531         ### is this fixed elsewhere?
 532         $args =~ s/\s+/ /g;             # fix up spaces.
 533         $args =~ s/^\s+|\s+$//g;        # again.
 534
 535         # this one catches most of them
 536         if ($args =~ /^(\S+) about (.*)$/i) {
 537             $target     = lc $1;
 538             $tell_obj   = $2;
 539
 540             $tell_obj   = $who  if ($tell_obj =~ /^(me|myself)$/i);
 541             $query      = $tell_obj;
 542         } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) {
 543             # i'm sure this could all be nicely collapsed
 544             $target     = lc $1;
 545             $tell_obj   = $4;
 546             $query      = $tell_obj;
 547
 548         } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) {
 549             $target     = lc $1;
 550             $qWord      = $2;
 551             $tell_obj   = $3;
 552             $verb       = $4;
 553             $query      = "$qWord $verb $tell_obj";
 554
 555         } elsif ($args =~ /^(.*?) to (\S+)$/i) {
 556             $target     = lc $3;
 557             $tell_obj   = $2;
 558             $query      = $tell_obj;
 559         }
 560
 561         # check target type. Deny channel targets.
 562         if ($target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/) {
 563             &msg($who,"No, $who, I won't. (target invalid?)");
 564             return $noreply;
 565         }
 566
 567         $target = $talkchannel  if ($target =~ /^us$/i);
 568         $target = $who          if ($target =~ /^(me|myself)$/i);
 569
 570         &status("target: $target query: $query");
 571
 572         # "intrusive".
 573         if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
 574             &msg($who, "No, $target is not in any of my chans.");
 575             return $noreply;
 576         }
 577
 578         ### TODO: don't "tell" if sender is not in target's channel.
 579
 580         # self.
 581         if ($target eq $ident) {        # lc?
 582             &msg($who, "Isn't that a bit silly?");
 583             return $noreply;
 584         }
 585
 586         # ...
 587         my $result = &doQuestion($tell_obj);
 588         return $noreply if ($result eq $noreply);
 589
 590         # no such factoid.
 591         if ($result eq "") {
 592             &msg($who, "i dunno what is '$tell_obj'.");
 593             return $noreply;
 594         }
 595
 596         # success.
 597         &status("tell: <$who> telling $target about $tell_obj.");
 598         if ($who ne $target) {
 599             &msg($who, "told $target about $tell_obj ($result)");
 600             $reply = "$who wants you to know: $result";
 601         } else {
 602             $reply = "telling yourself: $result";
 603         }
 604
 605         &msg($target, $reply);
 606
 607         return $noreply;
 608     }
 609
 610     # wantNick. xk++
 611     if ($message =~ /^wantNick$/i) {
 612         if ($param{'ircNick'} eq $ident) {
 613             &msg($who, "I hope you're right. I'll try anyway.");
 614         }
 615
 616         my $str = "attempting to change nick to $param{'ircNick'}";
 617         &status($str);
 618         &msg($who, $str);
 619
 620         &nick($param{'ircNick'});
 621         return $noreply;
 622     }
 623
 624     # what else...
 625 }
 626
 627 1;