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