src/UserExtra.pl

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