src/CommandStubs.pl

   1 #
   2 # User Command Extension Stubs
   3 #
   4
   5 if (&IsParam("useStrict")) { use strict; }
   6
   7 use vars qw(@W3Search_engines $W3Search_regex);
   8 @W3Search_engines = qw(AltaVista Dejanews Excite Gopher HotBot Infoseek
   9                         Lycos Magellan PLweb SFgate Simple Verity Google);
  10 $W3Search_regex = join '|', @W3Search_engines;
  11 $babel::lang_regex = "";        # lame fix.
  12
  13 ### PROPOSED COMMAND HOOK IMPLEMENTATION.
  14 # addCmdHook('TEXT_HOOK', $code_ref,
  15 #       (Forker         => 1,
  16 #       CheckModule     => 1,
  17 #       Identifier      => 'config_label',
  18 #       Help            => 'help_label',
  19 #       Cmdstats        => 'text_label',)
  20 #}
  21 ### EXAMPLE
  22 # addCmdHook('d?find', (
  23 #       CODEREF => \&debianFind(),
  24 #       CheckModule => 1,
  25 #       Forker => 1,            # if simple function.
  26 #       Identifier => "debian",
  27 #       Help => "dfind",
  28 #       Cmdstats => "Debian Search",) );
  29 ### NOTES:
  30 #   * viable solution?
  31 ###
  32
  33 sub addCmdHook {
  34     my ($ident, %hash) = @_;
  35
  36     &DEBUG("aCH: added $ident to command hooks.");
  37     $cmdhooks{$ident} = \%hash;
  38 }
  39
  40 # RUN IF ADDRESSED.
  41 sub parseCmdHook {
  42     my @args = split(' ', $message);
  43
  44     &shmFlush();
  45
  46     foreach (keys %cmdhooks) {
  47         my $ident = $_;
  48         &DEBUG("cmdhooks{$ident} => ...");
  49
  50         next unless ($args[0] =~ /^$ident$/i);
  51         shift(@args);   # just gotta do it.
  52
  53         &DEBUG("pCH: MATCHED!");
  54         my %hash = %{ $cmdhooks{$ident} };
  55
  56         ### DEBUG.
  57         foreach (keys %hash) {
  58             &DEBUG(" $ident->$_ => '$hash{$_}'.");
  59         }
  60
  61         ### IDENTIFIER.
  62         if (exists $hash{'Identifier'}) {
  63             return $noreply unless (&hasParam($hash{'Identifier'}));
  64         }
  65
  66         ### FORKER,IDENTIFIER,CODEREF.
  67         if (exists $hash{'Forker'}) {
  68             &Forker($hash{'Identifier'}, sub { \&{$hash{'CODEREF'}}(@args) } );
  69         }
  70
  71         ### CMDSTATS.
  72         if (exists $hash{'Cmdstats'}) {
  73             $cmdstats{$hash{'Cmdstats'}}++;
  74         }
  75
  76         return 1;
  77     }
  78
  79     &DEBUG("pCH: ended.");
  80     return 0;
  81 }
  82
  83 &addCmdHook('d?bugs', ('CODEREF' => 'debianBugs',
  84         'Forker' => 1, 'Identifier' => 'debianExtra',
  85         'Cmdstats' => 'Debian Bugs') );
  86 &addCmdHook('dauthor', ('CODEREF' => 'Debian::searchAuthor',
  87         'Forker' => 1, 'Identifier' => 'debian',
  88         'Cmdstats' => 'Debian Author Search', 'Help' => "dauthor" ) );
  89 &addCmdHook('(d|search)desc', ('CODEREF' => 'Debian::searchDesc',
  90         'Forker' => 1, 'Identifier' => 'debian',
  91         'Cmdstats' => 'Debian Desc Search', 'Help' => "ddesc" ) );
  92 &addCmdHook('dincoming', ('CODEREF' => 'Debian::generateIncoming',
  93         'Forker' => 1, 'Identifier' => 'debian' ) );
  94 &addCmdHook('dstats', ('CODEREF' => 'Debian::infoStats',
  95         'Forker' => 1, 'Identifier' => 'debian',
  96         'Cmdstats' => 'Debian Statistics' ) );
  97 &addCmdHook('d?contents', ('CODEREF' => 'Debian::searchContents',
  98         'Forker' => 1, 'Identifier' => 'debian',
  99         'Cmdstats' => 'Debian Contents Search', 'Help' => "contents" ) );
 100 &addCmdHook('d?find', ('CODEREF' => 'Debian::DebianFind',
 101         'Forker' => 1, 'Identifier' => 'debian',
 102         'Cmdstats' => 'Debian Search', 'Help' => "find" ) );
 103
 104
 105 sub Modules {
 106     if (!defined $message) {
 107         &WARN("Modules: message is undefined. should never happen.");
 108         return;
 109     }
 110
 111     # babel bot: Jonathan Feinberg++
 112     if (&IsParam("babelfish") and $message =~ m{
 113                 ^\s*
 114                 (?:babel(?:fish)?|x|xlate|translate)
 115                 \s+
 116                 (to|from)               # direction of translation (through)
 117                 \s+
 118                 ($babel::lang_regex)\w* # which language?
 119                 \s*
 120                 (.+)                    # The phrase to be translated
 121         }xoi) {
 122
 123         &Forker("babelfish", sub { &babel::babelfish(lc $1, lc $2, $3); } );
 124
 125         $cmdstats{'BabelFish'}++;
 126         return $noreply;
 127     }
 128
 129     # cookie (random). xk++
 130     if ($message =~ /^(cookie|random)(\s+(.*))?$/i) {
 131         return $noreply unless (&hasParam("cookie"));
 132
 133         my $arg = $3;
 134
 135         # lets find that secret cookie.
 136         my $target      = $talkchannel;
 137         $target         = $who          if ($msgType ne 'public');
 138
 139         my $cookiemsg   = &getRandom(keys %{$lang{'cookie'}});
 140         my ($key,$value);
 141         ### WILL CHEW TONS OF MEM.
 142         ### TODO: convert this to a Forker function!
 143         if ($arg) {
 144             my @list = &searchTable("factoids", "factoid_key", "factoid_value", $arg);
 145             $key  = &getRandom(@list);
 146             $val  = &getFactInfo("factoids", $key, "factoid_value");
 147         } else {
 148             ($key,$value) = &randKey("factoids","factoid_key,factoid_value");
 149         }
 150
 151         $cookiemsg      =~ s/##KEY/\002$key\002/;
 152         $cookiemsg      =~ s/##VALUE/$value/;
 153         $cookiemsg      =~ s/##WHO/$who/;
 154         $cookiemsg      =~ s/\$who/$who/;       # cheap fix.
 155         $cookiemsg      =~ s/(\S+)?\s*<\S+>/$1 /;
 156         $cookiemsg      =~ s/\s+/ /g;
 157
 158         if ($cookiemsg =~ s/^ACTION //i) {
 159             &action($target, $cookiemsg);
 160         } else {
 161             &msg($target, $cookiemsg);
 162         }
 163
 164         $cmdstats{'Random Cookie'}++;
 165         return $noreply;
 166     }
 167
 168     if (&IsParam("debian")) {
 169         my $debiancmd    = 'conflicts?|depends?|desc|file|info|provides?';
 170         $debiancmd      .= '|recommends?|suggests?|maint|maintainer';
 171         if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
 172             my $package = lc $3;
 173
 174             if (defined $package) {
 175                 &Forker("debian", sub { &Debian::infoPackages($1, $package); } );
 176             } else {
 177                 &help($1);
 178             }
 179
 180             return $noreply;
 181         }
 182     }
 183
 184     # Dict. xk++
 185     if ($message =~ /^dict(\s+(.*))?$/i) {
 186         return $noreply unless (&hasParam("dict"));
 187
 188         my $query = $2;
 189         $query =~ s/^[\s\t]+//;
 190         $query =~ s/[\s\t]+$//;
 191         $query =~ s/[\s\t]+/ /;
 192
 193         if (!defined $query) {
 194             &help("dict");
 195             return $noreply;
 196         }
 197
 198         if (length $query > 30) {
 199             &msg($who,"dictionary word is too long.");
 200             return $noreply;
 201         }
 202
 203         &Forker("dict", sub { &Dict::Dict($query); } );
 204
 205         $cmdstats{'Dict'}++;
 206         return $noreply;
 207     }
 208
 209     # Freshmeat. xk++
 210     if ($message =~ /^(fm|freshmeat)(\s+(.*))?$/i) {
 211         return $noreply unless (&hasParam("freshmeat"));
 212
 213         my $query = $3;
 214
 215         if (!defined $query) {
 216             &help("freshmeat");
 217             &msg($who, "I have \002".&countKeys("freshmeat")."\002 entries.");
 218             return $noreply;
 219         }
 220
 221         &loadMyModule($myModules{'freshmeat'});
 222         &Freshmeat::Freshmeat($query);
 223
 224         $cmdstats{'Freshmeat'}++;
 225         return $noreply;
 226     }
 227
 228     # google searching. Simon++
 229     if (&IsParam("wwwsearch") and $message =~ /^(?:search\s+)?($W3Search_regex)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
 230         return $noreply unless (&hasParam("wwwsearch"));
 231
 232         &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2,$param{'wwwsearch'}); } );
 233
 234         $cmdstats{'WWWSearch'}++;
 235         return $noreply;
 236     }
 237
 238     # insult server. patch thanks to michael@limit.org
 239     if ($message =~ /^insult(\s+(\S+))?$/) {
 240         return $noreply unless (&hasParam("insult"));
 241
 242         my $person      = $2;
 243         if (!defined $person) {
 244             &help("insult");
 245             return $noreply;
 246         }
 247
 248         &Forker("insult", sub { &Insult::Insult($person); } );
 249
 250         return $noreply;
 251     }
 252
 253     # Kernel. xk++
 254     if ($message =~ /^kernel$/i) {
 255         return $noreply unless (&hasParam("kernel"));
 256
 257         &Forker("kernel", sub { &Kernel::Kernel(); } );
 258
 259         $cmdstats{'Kernel'}++;
 260         return $noreply;
 261     }
 262
 263     # LART. originally by larne/cerb.
 264     if ($message =~ /^lart(\s+(.*))?$/i) {
 265         return $noreply unless (&hasParam("lart"));
 266         my ($target) = &fixString($2);
 267
 268         if (!defined $target) {
 269             &help("lart");
 270             return $noreply;
 271         }
 272         my $extra = 0;
 273
 274         my $chan = $talkchannel;
 275         if ($msgType eq 'private') {
 276             if ($target =~ /^($mask{chan})\s+(.*)$/) {
 277                 $chan   = $1;
 278                 $target = $2;
 279                 $extra  = 1;
 280             } else {
 281                 &msg($who, "error: invalid format or missing arguments.");
 282                 &help("lart");
 283                 return $noreply;
 284             }
 285         }
 286
 287         my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.lart");
 288         if (defined $line) {
 289             if ($target =~ /^(me|you|itself|\Q$ident\E)$/i) {
 290                 $line =~ s/WHO/$who/g;
 291             } else {
 292                 $line =~ s/WHO/$target/g;
 293             }
 294             $line .= ", courtesy of $who" if ($extra);
 295
 296             &action($chan, $line);
 297         } else {
 298             &status("lart: error reading file?");
 299         }
 300
 301         return $noreply;
 302     }
 303
 304     # Search factoid extensions by 'author'. xk++
 305     if ($message =~ /^listauth(\s+(\S+))?$/i) {
 306         return $noreply unless (&hasParam("search"));
 307
 308         my $query = $2;
 309
 310         if (!defined $query) {
 311             &help("listauth");
 312             return $noreply;
 313         }
 314
 315         &loadMyModule($myModules{'factoids'});
 316         &performStrictReply( &CmdListAuth($query) );
 317         return $noreply;
 318     }
 319
 320     # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
 321     if ($message =~ /^list(\S+)( (.*))?$/i) {
 322         return $noreply unless (&hasParam("search"));
 323
 324         my $thiscmd     = lc($1);
 325         my $args        = $3;
 326
 327         $thiscmd =~ s/^vals$/values/;
 328         return $noreply if ($thiscmd ne "keys" && $thiscmd ne "values");
 329
 330         # Usage:
 331         if (!defined $args) {
 332             &help("list". $thiscmd);
 333             return $noreply;
 334         }
 335
 336         if (length $args == 1) {
 337             &msg($who,"search string is too short.");
 338             return $noreply;
 339         }
 340
 341         &Forker("search", sub { &Search::Search($thiscmd, $args); } );
 342
 343         $cmdstats{'Factoid Search'}++;
 344         return $noreply;
 345     }
 346
 347     # Nickometer. Adam Spiers++
 348     if ($message =~ /^(?:lame|nick)ometer(?: for)? (\S+)/i) {
 349         return $noreply unless (&hasParam("nickometer"));
 350
 351         my $term = (lc $1 eq 'me') ? $who : $1;
 352         $term =~ s/\?+\s*//;
 353
 354         &loadMyModule($myModules{'nickometer'});
 355         my $percentage = &nickometer($term);
 356
 357         if ($percentage =~ /NaN/) {
 358             $percentage = "off the scale";
 359         } else {
 360             $percentage = sprintf("%0.4f", $percentage);
 361             $percentage =~ s/\.?0+$//;
 362             $percentage .= '%';
 363         }
 364
 365         if ($msgType eq 'public') {
 366             &say("'$term' is $percentage lame, $who");
 367         } else {
 368             &msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who");
 369         }
 370
 371         return $noreply;
 372     }
 373
 374     # Quotes. mu++
 375     if ($message =~ /^quote(\s+(\S+))?$/i) {
 376         return $noreply unless (&hasParam("quote"));
 377
 378         my $query = $2;
 379
 380         if ($query eq "") {
 381             &help("quote");
 382             return $noreply;
 383         }
 384
 385         &Forker("quote", sub { &Quote::Quote($query); } );
 386
 387         $cmdstats{'Quote'}++;
 388         return $noreply;
 389     }
 390
 391     # rootWarn. xk++
 392     if ($message =~ /^rootWarn$/i) {
 393         return $noreply unless (&hasParam("rootWarn"));
 394
 395         &loadMyModule($myModules{'rootwarn'});
 396         &performStrictReply( &CmdrootWarn() );
 397         return $noreply;
 398     }
 399
 400     # seen.
 401     if ($message =~ /^seen(\s+(\S+))?$/) {
 402         return $noreply unless (&hasParam("seen"));
 403
 404         my $person = $2;
 405         if (!defined $person) {
 406             &help("seen");
 407
 408             my $i = &countKeys("seen");
 409             &msg($who,"there ". &fixPlural("is",$i) ." \002$i\002 ".
 410                 "seen ". &fixPlural("entry",$i) ." that I know of.");
 411
 412             return $noreply;
 413         }
 414
 415         my @seen;
 416         $person =~ s/\?*$//;
 417
 418         &seenFlush();   # very evil hack. oh well, better safe than sorry.
 419
 420         ### TODO: Support &dbGetRowInfo(); like in &FactInfo();
 421         my $select = "nick,time,channel,host,message";
 422         if ($person eq "random") {
 423             @seen = &randKey("seen", $select);
 424         } else {
 425             @seen = &dbGet("seen", "nick", $person, $select);
 426         }
 427
 428         if (scalar @seen < 2) {
 429             foreach (@seen) {
 430                 &DEBUG("seen: _ => '$_'.");
 431             }
 432             &performReply("i haven't seen '$person'");
 433             return $noreply;
 434         }
 435
 436         # valid seen.
 437         my $reply;
 438         ### TODO: multi channel support. may require &IsNick() to return
 439         ###     all channels or something.
 440         my @chans = &GetNickInChans($seen[0]);
 441         if (scalar @chans) {
 442             $reply = "$seen[0] is currently on";
 443
 444             foreach (@chans) {
 445                 $reply .= " ".$_;
 446                 next unless (exists $userstats{lc $seen[0]}{'Join'});
 447                 $reply .= " (".&Time2String(time() - $userstats{lc $seen[0]}{'Join'}).")";
 448             }
 449
 450             if (&IsParam("seenStats")) {
 451                 my $i;
 452                 $i = $userstats{lc $seen[0]}{'Count'};
 453                 $reply .= ".  Has said a total of \002$i\002 messages" if (defined $i);
 454                 $i = $userstats{lc $seen[0]}{'Time'};
 455                 $reply .= ".  Is idling for ".&Time2String(time() - $i) if (defined $i);
 456             }
 457         } else {
 458             my $howlong = &Time2String(time() - $seen[1]);
 459             $reply = "$seen[0] <$seen[3]> was last seen on IRC ".
 460                         "in channel $seen[2], $howlong ago, ".
 461                         "saying\002:\002 '$seen[4]'.";
 462         }
 463
 464         &performStrictReply($reply);
 465         return $noreply;
 466     }
 467
 468     # slashdot headlines: from Chris Tessone.
 469     if ($message =~ /^slashdot$/i) {
 470         return $noreply unless (&hasParam("slashdot"));
 471
 472         &Forker("slashdot", sub { &Slashdot::Slashdot() });
 473
 474         $cmdstats{'Slashdot'}++;
 475         return $noreply;
 476     }
 477
 478     # Topic management. xk++
 479     # may want to add a flag(??) for topic in the near future. -xk
 480     if ($message =~ /^topic(\s+(.*))?$/i) {
 481         return $noreply unless (&hasParam("topic"));
 482
 483         my $chan        = $talkchannel;
 484         my @args        = split(/ /, $2);
 485
 486         if (!scalar @args) {
 487             &msg($who,"Try 'help topic'");
 488             return $noreply;
 489         }
 490
 491         $chan           = lc(shift @args) if ($msgType eq 'private');
 492         my $thiscmd     = shift @args;
 493
 494         # topic over public:
 495         if ($msgType eq 'public' && $thiscmd =~ /^#/) {
 496             &msg($who, "error: channel argument is not required.");
 497             &msg($who, "\002Usage\002: topic <CMD>");
 498             return $noreply;
 499         }
 500
 501         # topic over private:
 502         if ($msgType eq 'private' && $chan !~ /^#/) {
 503             &msg($who, "error: channel argument is required.");
 504             &msg($who, "\002Usage\002: topic #channel <CMD>");
 505             return $noreply;
 506         }
 507
 508         if (&validChan($chan) == 0) {
 509             &msg($who,"error: invalid channel \002$chan\002");
 510             return $noreply;
 511         }
 512
 513         # for semi-outsiders.
 514         if (!&IsNickInChan($who,$chan)) {
 515             &msg($who, "Failed. You ($who) are not in $chan, hey?");
 516             return $noreply;
 517         }
 518
 519         # now lets do it.
 520         &loadMyModule($myModules{'topic'});
 521         &Topic($chan, $thiscmd, join(' ', @args));
 522         $cmdstats{'Topic'}++;
 523         return $noreply;
 524     }
 525
 526     # Countdown.
 527     if ($message =~ /^countdown(\s+(\S+))?$/i) {
 528         return $noreply unless (&hasParam("countdown"));
 529
 530         my $query = $2;
 531
 532         &loadMyModule($myModules{'countdown'});
 533         &Countdown($query);
 534
 535         $cmdstats{'Countdown'}++;
 536
 537         return $noreply;
 538     }
 539
 540     # User Information Services. requested by Flugh.
 541     if ($message =~ /^u(ser)?info(\s+(.*))?$/i) {
 542         return $noreply unless (&hasParam("userinfo"));
 543         &loadMyModule($myModules{'userinfo'});
 544
 545         my $arg = $3;
 546         if (!defined $arg or $arg eq "") {
 547             &help("userinfo");
 548             return $noreply;
 549         }
 550
 551         if ($arg =~ /^set(\s+(.*))?$/i) {
 552             $arg = $2;
 553             if (!defined $arg) {
 554                 &help("userinfo set");
 555                 return $noreply;
 556             }
 557
 558             &UserInfoSet(split /\s+/, $arg, 2);
 559         } elsif ($arg =~ /^unset(\s+(.*))?$/i) {
 560             $arg = $2;
 561             if (!defined $arg) {
 562                 &help("userinfo unset");
 563                 return $noreply;
 564             }
 565
 566             &UserInfoSet($arg, "");
 567         } else {
 568             &UserInfoGet($arg);
 569         }
 570
 571         $cmdstats{'UIS'}++;
 572         return $noreply;
 573     }
 574
 575     # Uptime. xk++
 576     if ($message =~ /^uptime$/i) {
 577         return $noreply unless (&hasParam("uptime"));
 578
 579         my $count = 1;
 580         &msg($who, "- Uptime for $ident -");
 581         &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $bot_version");
 582         foreach (&uptimeGetInfo()) {
 583             /^(\d+)\.\d+ (.*)/;
 584             my $time = &Time2String($1);
 585             my $info = $2;
 586
 587             &msg($who, "$count: $time $2");
 588             $count++;
 589         }
 590
 591         $cmdstats{'Uptime'}++;
 592         return $noreply;
 593     }
 594
 595     # wingate.
 596     if ($message =~ /^wingate$/i) {
 597         return $noreply unless (&hasParam("wingate"));
 598
 599         my $reply = "Wingate statistics: scanned \002"
 600                         .scalar(keys %wingate)."\002 hosts";
 601         my $queue = scalar(keys %wingateToDo);
 602         if ($queue) {
 603             $reply .= ".  I have \002$queue\002 hosts in the queue";
 604             $reply .= ".  Started the scan ".&Time2String(time() - $wingaterun)." ago";
 605         }
 606
 607         &performStrictReply("$reply.");
 608
 609         return $noreply;
 610     }
 611
 612     # convert.
 613     if ($message =~ /^convert(\s+(.*))?$/i) {
 614         return $noreply unless (&hasParam("units"));
 615
 616         my $str = $2;
 617         if (!defined $str) {
 618             &help("convert");
 619             return $noreply;
 620         }
 621
 622         my ($from,$to);
 623         ($from,$to) = ($1,$2) if ($str =~ /^(.*) to (.*)$/);
 624         ($from,$to) = ($2,$1) if ($str =~ /^(.*) from (.*)$/);
 625         if (!defined $from or !defined $to or $to eq "" or $from eq "") {
 626             &msg($who, "Invalid format!");
 627             &help("convert");
 628             return $noreply;
 629         }
 630
 631         &Forker("units", sub { &Units::convertUnits($from, $to); } );
 632
 633         return $noreply;
 634     }
 635
 636     # do nothing and let the other routines have a go
 637     return '';
 638 }
 639
 640 1;