src/CommandStubs.pl

   1 #
   2 # User Command Extension Stubs
   3 # WARN: this file does not reload on HUP.
   4 #
   5
   6 #use strict; # TODO: sub { \&{ $hash{'CODEREF'} }($flatarg) };
   7
   8 use vars qw($who $msgType $conn $chan $message $ident $talkchannel
   9         $bot_version $bot_data_dir);
  10 use vars qw(@vernick @vernicktodo);
  11 use vars qw(%channels %cache %mask %userstats %myModules %cmdstats
  12         %cmdhooks %lang %ver);
  13 # TODO: FIX THE FOLLOWING:
  14 use vars qw($total $x $type $i $good %wingateToDo);
  15
  16 ### COMMAND HOOK IMPLEMENTATION.
  17 # addCmdHook('TEXT_HOOK',
  18 #       (CODEREF        => 'Blah',
  19 #       Forker          => 1,
  20 #       Module          => 'blah.pl'            # preload module.
  21 #       Identifier      => 'config_label',      # change to Config?
  22 #       Help            => 'help_label',
  23 #       Cmdstats        => 'text_label',)
  24 #}
  25 ###
  26
  27 sub addCmdHook {
  28     my ( $ident, %hash ) = @_;
  29
  30     if ( exists $cmdhooks{$ident} ) {
  31         &WARN("aCH: \$cmdhooks{$ident} already exists.");
  32         return;
  33     }
  34
  35     &VERB( "aCH: added $ident", 2 );    # use $hash{'Identifier'}?
  36     ### hrm... prevent warnings?
  37     $cmdhooks{$ident} = \%hash;
  38 }
  39
  40 # RUN IF ADDRESSED.
  41 sub parseCmdHook {
  42     my ($line) = @_;
  43     $line =~ s/^\s+|\s+$//g;        # again.
  44     $line =~ /^(\S+)(\s+(.*))?$/;
  45     my $cmd     = $1;               # command name is whitespaceless.
  46     my $flatarg = $3;
  47     my @args = split( /\s+/, $flatarg || '' );
  48     my $done = 0;
  49
  50     &shmFlush();
  51
  52     if ( !defined %cmdhooks ) {
  53         &WARN('%cmdhooks does not exist.');
  54         return 0;
  55     }
  56
  57     if ( !defined $cmd ) {
  58         &WARN('cstubs: cmd == NULL.');
  59         return 0;
  60     }
  61
  62     foreach ( keys %cmdhooks ) {
  63
  64         # rename to something else! like $id or $label?
  65         my $ident = $_;
  66
  67         next unless ( $cmd =~ /^$ident$/i );
  68
  69         if ($done) {
  70             &WARN("pCH: Multiple hook match: $ident");
  71             next;
  72         }
  73
  74         &status("cmdhooks: $cmd matched '$ident' '$flatarg'");
  75         my %hash = %{ $cmdhooks{$ident} };
  76
  77         if ( !scalar keys %hash ) {
  78             &WARN('CmdHook: hash is NULL?');
  79             return 1;
  80         }
  81
  82         if ( $hash{NoArgs} and $flatarg ) {
  83             &DEBUG("cmd $ident does not take args ('$flatarg'); skipping.");
  84             next;
  85         }
  86
  87         if ( !exists $hash{CODEREF} ) {
  88             &ERROR("CODEREF undefined for $cmd or $ident.");
  89             return 1;
  90         }
  91
  92         ### DEBUG.
  93         foreach ( keys %hash ) {
  94             &VERB( " $cmd->$_ => '$hash{$_}'.", 2 );
  95         }
  96
  97         ### HELP.
  98         if ( exists $hash{'Help'} and !scalar(@args) ) {
  99             &help( $hash{'Help'} );
 100             return 1;
 101         }
 102
 103         ### IDENTIFIER.
 104         if ( exists $hash{'Identifier'} ) {
 105             return 1 unless ( &IsChanConfOrWarn( $hash{'Identifier'} ) );
 106         }
 107
 108         ### USER FLAGS.
 109         if ( exists $hash{'UserFlag'} ) {
 110             return 1 unless ( &hasFlag( $hash{'UserFlag'} ) );
 111         }
 112
 113         ### FORKER,IDENTIFIER,CODEREF.
 114         if ( ( $$ == $bot_pid ) && exists $hash{'Forker'} ) {
 115             if ( exists $hash{'ArrayArgs'} ) {
 116                 &Forker( $hash{'Identifier'},
 117                     sub { \&{ $hash{'CODEREF'} }(@args) } );
 118             }
 119             else {
 120                 &Forker( $hash{'Identifier'},
 121                     sub { \&{ $hash{'CODEREF'} }($flatarg) } );
 122             }
 123
 124         }
 125         else {
 126             if ( exists $hash{'Module'} ) {
 127                 &loadMyModule( $hash{'Module'} );
 128             }
 129
 130             # check if CODEREF exists.
 131             if ( !defined &{ $hash{'CODEREF'} } ) {
 132                 &WARN("coderef $hash{'CODEREF'} does not exist.");
 133                 if ( defined $who ) {
 134                     &msg( $who, "coderef does not exist for $ident." );
 135                 }
 136
 137                 return 1;
 138             }
 139
 140             if ( exists $hash{'ArrayArgs'} ) {
 141                 &{ $hash{'CODEREF'} }(@args);
 142             }
 143             else {
 144                 &{ $hash{'CODEREF'} }($flatarg);
 145             }
 146         }
 147
 148         ### CMDSTATS.
 149         if ( exists $hash{'Cmdstats'} ) {
 150             $cmdstats{ $hash{'Cmdstats'} }++;
 151         }
 152
 153         &VERB( 'hooks: End of command.', 2 );
 154
 155         $done = 1;
 156     }
 157
 158     return 1 if ($done);
 159     return 0;
 160 }
 161
 162 sub Modules {
 163     if ( !defined $message ) {
 164         &WARN('Modules: message is undefined. should never happen.');
 165         return;
 166     }
 167
 168     my $debiancmd = 'conflicts?|depends?|desc|file|(?:d)?info|provides?';
 169     $debiancmd .= '|recommends?|suggests?|maint|maintainer';
 170
 171     if ( $message =~ /^($debiancmd)(\s+(.*))?$/i ) {
 172         return unless ( &IsChanConfOrWarn('Debian') );
 173         my $package = lc $3;
 174
 175         if ( defined $package ) {
 176             &Forker( 'Debian', sub { &Debian::infoPackages( $1, $package ); } );
 177         }
 178         else {
 179             &help($1);
 180         }
 181
 182         return;
 183     }
 184
 185     # google searching. Simon++
 186     my $w3search_regex = 'google';
 187     if ( $message =~
 188         /^(?:search\s+)?($w3search_regex)\s+(?:for\s+)?['"]?(.*?)["']?\s*\?*$/i
 189       )
 190     {
 191         return unless ( &IsChanConfOrWarn('W3Search') );
 192
 193         &Forker( 'W3Search', sub { &W3Search::W3Search( $1, $2 ); } );
 194
 195         $cmdstats{'W3Search'}++;
 196         return;
 197     }
 198
 199     # text counters. (eg: hehstats)
 200     my $itc;
 201     $itc = &getChanConf('ircTextCounters');
 202     $itc = &findChanConf('ircTextCounters') unless ($itc);
 203     return if ( $itc && &do_text_counters($itc) == 1 );
 204
 205     # end of text counters.
 206
 207     # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
 208     if ( $message =~ /^list(\S+)(\s+(.*))?$/i ) {
 209         return unless ( &IsChanConfOrWarn('Search') );
 210
 211         my $thiscmd = lc $1;
 212         my $args = $3 || '';
 213
 214         $thiscmd =~ s/^vals$/values/;
 215         return if ( $thiscmd ne 'keys' && $thiscmd ne 'values' );
 216
 217         # Usage:
 218         if ( !defined $args or $args =~ /^\s*$/ ) {
 219             &help( 'list' . $thiscmd );
 220             return;
 221         }
 222
 223         # suggested by asuffield and \broken.
 224         if ( $args =~ /^["']/ and $args =~ /["']$/ ) {
 225             &DEBUG('list*: removed quotes.');
 226             $args =~ s/^["']|["']$//g;
 227         }
 228
 229         if ( length $args < 2 && &IsFlag('o') ne 'o' ) {
 230             &msg( $who, 'search string is too short.' );
 231             return;
 232         }
 233
 234         &Forker( 'Search', sub { &Search::Search( $thiscmd, $args ); } );
 235
 236         $cmdstats{'Factoid Search'}++;
 237         return;
 238     }
 239
 240     # Topic management. xk++
 241     # may want to add a userflags for topic. -xk
 242     if ( $message =~ /^topic(\s+(.*))?$/i ) {
 243         return unless ( &IsChanConfOrWarn('Topic') );
 244
 245         my $chan = $talkchannel;
 246         my @args = split / /, $2 || '';
 247
 248         if ( !scalar @args ) {
 249             &msg( $who, "Try 'help topic'" );
 250             return;
 251         }
 252
 253         $chan = lc( shift @args ) if ( $msgType eq 'private' );
 254         my $thiscmd = shift @args;
 255
 256         # topic over public:
 257         if ( $msgType eq 'public' && $thiscmd =~ /^#/ ) {
 258             &msg( $who, 'error: channel argument is not required.' );
 259             &msg( $who, "\002Usage\002: topic <CMD>" );
 260             return;
 261         }
 262
 263         # topic over private:
 264         if ( $msgType eq 'private' && $chan !~ /^#/ ) {
 265             &msg( $who, 'error: channel argument is required.' );
 266             &msg( $who, "\002Usage\002: topic #channel <CMD>" );
 267             return;
 268         }
 269
 270         if ( &validChan($chan) == 0 ) {
 271             &msg( $who, "error: invalid channel \002$chan\002" );
 272             return;
 273         }
 274
 275         # for semi-outsiders.
 276         if ( !&IsNickInChan( $who, $chan ) ) {
 277             &msg( $who, "Failed. You ($who) are not in $chan, hey?" );
 278             return;
 279         }
 280
 281         # now lets do it.
 282         &loadMyModule('Topic');
 283         &Topic( $chan, $thiscmd, join( ' ', @args ) );
 284         $cmdstats{'Topic'}++;
 285         return;
 286     }
 287
 288     # wingate.
 289     if ( $message =~ /^wingate$/i ) {
 290         return unless ( &IsChanConfOrWarn('Wingate') );
 291
 292         my $reply =
 293             "Wingate statistics: scanned \002"
 294           . scalar( keys %wingateToDo )
 295           . "\002 hosts";
 296         my $queue = scalar( keys %wingateToDo );
 297         if ($queue) {
 298             $reply .= ".  I have \002$queue\002 hosts in the queue";
 299             $reply .=
 300               '.  Started the scan '
 301               . &Time2String( time() - $wingaterun ) . ' ago';
 302         }
 303
 304         &performStrictReply("$reply.");
 305
 306         return;
 307     }
 308
 309     # do nothing and let the other routines have a go
 310     return 'CONTINUE';
 311 }
 312
 313 # Uptime. xk++
 314 sub uptime {
 315     my $count = 1;
 316     &msg( $who, "- Uptime for $ident -" );
 317     &msg( $who,
 318         'Now: ' . &Time2String( &uptimeNow() ) . " running $bot_version" );
 319
 320     foreach ( &uptimeGetInfo() ) {
 321         /^(\d+)\.\d+ (.*)/;
 322         my $time = &Time2String($1);
 323         my $info = $2;
 324
 325         &msg( $who, "$count: $time $2" );
 326         $count++;
 327     }
 328 }
 329
 330 # seen.
 331 sub seen {
 332     my ($person) = lc shift;
 333     $person =~ s/\?*$//;
 334
 335     if ( !defined $person or $person =~ /^$/ ) {
 336         &help('seen');
 337
 338         my $i = &countKeys('seen');
 339         &msg( $who,
 340                 'there '
 341               . &fixPlural( 'is', $i )
 342               . " \002$i\002 " . 'seen '
 343               . &fixPlural( 'entry', $i )
 344               . ' that I know of.' );
 345
 346         return;
 347     }
 348
 349     my @seen;
 350
 351     &seenFlush();    # very evil hack. oh well, better safe than sorry.
 352
 353     # TODO: convert to &sqlSelectRowHash();
 354     my $select = 'nick,time,channel,host,message';
 355     if ( $person eq 'random' ) {
 356         @seen = &randKey( 'seen', $select );
 357     }
 358     else {
 359         @seen = &sqlSelect( 'seen', $select, { nick => $person } );
 360     }
 361
 362     if ( scalar @seen < 2 ) {
 363         foreach (@seen) {
 364             &DEBUG("seen: _ => '$_'.");
 365         }
 366         &performReply("i haven't seen '$person'");
 367         return;
 368     }
 369
 370     # valid seen.
 371     my $reply;
 372     ### TODO: multi channel support. may require &IsNick() to return
 373     ### all channels or something.
 374
 375     my @chans = &getNickInChans( $seen[0] );
 376     if ( scalar @chans ) {
 377         $reply = "$seen[0] is currently on";
 378
 379         foreach (@chans) {
 380             $reply .= ' ' . $_;
 381             next unless ( exists $userstats{ lc $seen[0] }{'Join'} );
 382             $reply .= ' ('
 383               . &Time2String( time() - $userstats{ lc $seen[0] }{'Join'} )
 384               . ')';
 385         }
 386
 387         if ( &IsChanConf('seenStats') > 0 ) {
 388             my $i;
 389             $i = $userstats{ lc $seen[0] }{'Count'};
 390             $reply .= ". Has said a total of \002$i\002 messages"
 391               if ( defined $i );
 392             $i = $userstats{ lc $seen[0] }{'Time'};
 393             $reply .= '. Is idling for ' . &Time2String( time() - $i )
 394               if ( defined $i );
 395         }
 396         $reply .= ", last said\002:\002 '$seen[4]'.";
 397     }
 398     else {
 399         my $howlong = &Time2String( time() - $seen[1] );
 400         $reply =
 401             "$seen[0] <$seen[3]> was last seen on IRC "
 402           . "in channel $seen[2], $howlong ago, "
 403           . "saying\002:\002 '$seen[4]'.";
 404     }
 405
 406     &performStrictReply($reply);
 407     return;
 408 }
 409
 410 # User Information Services. requested by Flugh.
 411 sub userinfo {
 412     my ($arg) = join( ' ', @_ );
 413
 414     if ( $arg =~ /^set(\s+(.*))?$/i ) {
 415         $arg = $2;
 416         if ( !defined $arg ) {
 417             &help('userinfo set');
 418             return;
 419         }
 420
 421         &UserInfoSet( split /\s+/, $arg, 2 );
 422     }
 423     elsif ( $arg =~ /^unset(\s+(.*))?$/i ) {
 424         $arg = $2;
 425         if ( !defined $arg ) {
 426             &help('userinfo unset');
 427             return;
 428         }
 429
 430         &UserInfoSet( $arg, '' );
 431     }
 432     else {
 433         &UserInfoGet($arg);
 434     }
 435 }
 436
 437 # cookie (random). xk++
 438 sub cookie {
 439     my ($arg) = @_;
 440
 441     # lets find that secret cookie.
 442     my $target = ( $msgType ne 'public' ) ? $who : $talkchannel;
 443     my $cookiemsg = &getRandom( keys %{ $lang{'cookie'} } );
 444     my ( $key, $value );
 445
 446     ### WILL CHEW TONS OF MEM.
 447     ### TODO: convert this to a Forker function!
 448     if ($arg) {
 449         my @list =
 450           &searchTable( 'factoids', 'factoid_key', 'factoid_value', $arg );
 451         $key = &getRandom(@list);
 452         $value = &getFactInfo( $key, 'factoid_value' );
 453     }
 454     else {
 455         ( $key, $value ) = &randKey( 'factoids', 'factoid_key,factoid_value' );
 456     }
 457
 458     for ($cookiemsg) {
 459         s/##KEY/\002$key\002/;
 460         s/##VALUE/$value/;
 461         s/##WHO/$who/;
 462         s/\$who/$who/;    # cheap fix.
 463         s/(\S+)?\s*<\S+>/$1 /;
 464         s/\s+/ /g;
 465     }
 466
 467     if ( $cookiemsg =~ s/^ACTION //i ) {
 468         &action( $target, $cookiemsg );
 469     }
 470     else {
 471         &msg( $target, $cookiemsg );
 472     }
 473 }
 474
 475 sub convert {
 476     my $arg = join( ' ', @_ );
 477     my ( $from, $to ) = ( '', '' );
 478
 479     ( $from, $to ) = ( $1, $2 ) if ( $arg =~ /^(.*?) to (.*)$/i );
 480     ( $from, $to ) = ( $2, $1 ) if ( $arg =~ /^(.*?) from (.*)$/i );
 481
 482     if ( !$to or !$from ) {
 483         &msg( $who, 'Invalid format!' );
 484         &help('convert');
 485         return;
 486     }
 487
 488     &Units::convertUnits( $from, $to );
 489
 490     return;
 491 }
 492
 493 sub lart {
 494     my ($target) = &fixString( $_[0] );
 495     my $extra    = 0;
 496     my $chan     = $talkchannel;
 497     my ($for);
 498     my $mynick = $conn->nick();
 499
 500     if ( $msgType eq 'private' ) {
 501         if ( $target =~ /^($mask{chan})\s+(.*)$/ ) {
 502             $chan   = $1;
 503             $target = $2;
 504             $extra  = 1;
 505         }
 506         else {
 507             &msg( $who, 'error: invalid format or missing arguments.' );
 508             &help('lart');
 509             return;
 510         }
 511     }
 512     if ( $target =~ /^(.*)(\s+for\s+.*)$/ ) {
 513         $target = $1;
 514         $for    = $2;
 515     }
 516
 517     my $line = &getRandomLineFromFile( $bot_data_dir . '/infobot.lart' );
 518     if ( defined $line ) {
 519         if ( $target =~ /^(me|you|itself|\Q$mynick\E)$/i ) {
 520             $line =~ s/WHO/$who/g;
 521         }
 522         else {
 523             $line =~ s/WHO/$target/g;
 524         }
 525         $line .= $for if ($for);
 526         $line .= ", courtesy of $who" if ($extra);
 527
 528         &action( $chan, $line );
 529     }
 530     else {
 531         &status('lart: error reading file?');
 532     }
 533 }
 534
 535 sub DebianNew {
 536     my $idx   = 'debian/Packages-sid.idx';
 537     my $error = 0;
 538     my %pkg;
 539     my @new;
 540
 541     $error++ unless ( -e $idx );
 542     $error++ unless ( -e "$idx-old" );
 543
 544     if ($error) {
 545         $error = 'no sid/sid-old index file found.';
 546         &ERROR("Debian: $error");
 547         &msg( $who, $error );
 548         return;
 549     }
 550
 551     open( IDX1, $idx );
 552     open( IDX2, "$idx-old" );
 553
 554     while (<IDX2>) {
 555         chop;
 556         next if (/^\*/);
 557
 558         $pkg{$_} = 1;
 559     }
 560     close IDX2;
 561
 562     open( IDX1, $idx );
 563     while (<IDX1>) {
 564         chop;
 565         next if (/^\*/);
 566         next if ( exists $pkg{$_} );
 567
 568         push( @new, $_ );
 569     }
 570     close IDX1;
 571
 572     &::performStrictReply(
 573         &::formListReply( 0, 'New debian packages:', @new ) );
 574 }
 575
 576 sub do_verstats {
 577     my ($chan) = @_;
 578
 579     if ( !defined $chan ) {
 580         &help('verstats');
 581         return;
 582     }
 583
 584     if ( !&validChan($chan) ) {
 585         &msg( $who, "chan $chan is invalid." );
 586         return;
 587     }
 588
 589     if ( scalar @vernick > scalar( keys %{ $channels{ lc $chan }{''} } ) / 4 ) {
 590         &msg( $who, 'verstats already in progress for someone else.' );
 591         return;
 592     }
 593
 594     &msg( $who,  "Sending CTCP VERSION to $chan; results in 60s." );
 595     &msg( $chan, "WARNING: $who has forced me to CTCP VERSION the channel!" );
 596
 597     # Workaround for bug in Net::Irc, provided by quin@freenode. Details at:
 598     # http://rt.cpan.org/Public/Bug/Display.html?id=11421
 599     # $conn->ctcp( 'VERSION', $chan );
 600     $conn->sl("PRIVMSG $chan :\001VERSION\001");
 601
 602     $cache{verstats}{chan}    = $chan;
 603     $cache{verstats}{who}     = $who;
 604     $cache{verstats}{msgType} = $msgType;
 605
 606     $conn->schedule(
 607         30,
 608         sub {
 609             my $c = lc $cache{verstats}{chan};
 610             @vernicktodo = ();
 611
 612             foreach ( keys %{ $channels{$c}{''} } ) {
 613                 next if ( grep /^\Q$_\E$/i, @vernick );
 614                 push( @vernicktodo, $_ );
 615             }
 616
 617             &verstats_flush();
 618         }
 619     );
 620
 621     $conn->schedule(
 622         60,
 623         sub {
 624             my $vtotal = 0;
 625             my $c      = lc $cache{verstats}{chan};
 626             my $total  = keys %{ $channels{$c}{''} };
 627             $who     = $cache{verstats}{who};
 628             $msgType = $cache{verstats}{msgType};
 629             delete $cache{verstats};    # sufficient?
 630
 631             foreach ( keys %ver ) {
 632                 $vtotal += scalar keys %{ $ver{$_} };
 633             }
 634
 635             my %sorted;
 636             my $unknown = $total - $vtotal;
 637             my $perc = sprintf( '%.1f', $unknown * 100 / $total );
 638             $perc =~ s/.0$//;
 639             $sorted{$perc}{'unknown/cloak'} = "$unknown ($perc%)" if ($unknown);
 640
 641             foreach ( keys %ver ) {
 642                 my $count = scalar keys %{ $ver{$_} };
 643                 $perc = sprintf( '%.01f', $count * 100 / $total );
 644                 $perc =~ s/.0$//;    # lame compression.
 645
 646                 $sorted{$perc}{$_} = "$count ($perc%)";
 647             }
 648
 649             ### can be compressed to a map?
 650             my @list;
 651             foreach ( sort { $b <=> $a } keys %sorted ) {
 652                 my $perc = $_;
 653                 foreach ( sort keys %{ $sorted{$perc} } ) {
 654                     push( @list, "$_ - $sorted{$perc}{$_}" );
 655                 }
 656             }
 657
 658             # hack. this is one major downside to scheduling.
 659             &msg($c,
 660                 &formListReply( 0, "IRC Client versions for $c ", @list ) );
 661
 662             # clean up not-needed data structures.
 663             undef %ver;
 664             undef @vernick;
 665         }
 666     );
 667
 668     return;
 669 }
 670
 671 sub verstats_flush {
 672     for ( 1 .. 5 ) {
 673         last unless ( scalar @vernicktodo );
 674
 675         my $n = shift(@vernicktodo);
 676         #$conn->ctcp( 'VERSION', $n );
 677         # See do_verstats $conn->sl for explantaion
 678         $conn->sl("PRIVMSG $n :\001VERSION\001");
 679     }
 680
 681     return unless ( scalar @vernicktodo );
 682
 683     $conn->schedule( 3, \&verstats_flush() );
 684 }
 685
 686 sub do_text_counters {
 687     my ($itc) = @_;
 688     $itc =~ s/([^\w\s])/\\$1/g;
 689     my $z = join '|', split ' ', $itc;
 690
 691     if ( $msgType eq 'privmsg' and $message =~ / ($mask{chan})$/ ) {
 692         &DEBUG("ircTC: privmsg detected; chan = $1");
 693         $chan = $1;
 694     }
 695
 696     my ( $type, $arg );
 697     if ( $message =~ /^($z)stats(\s+(\S+))?$/i ) {
 698         $type = $1;
 699         $arg  = $3;
 700     }
 701     else {
 702         return 0;
 703     }
 704
 705     my $c = $chan || 'PRIVATE';
 706
 707     # Define various types of stats in one place.
 708     # Note: sqlSelectColHash has built in sqlQuote
 709     my $where_chan_type = { channel => $c, type => $type };
 710     my $where_chan_type_nick = { channel => $c, type => $type, nick => $arg };
 711
 712     my $sum = ( &sqlSelect( 'stats', 'SUM(counter)', $where_chan_type ) )[0];
 713
 714     if ( !defined $arg or $arg =~ /^\s*$/ ) {
 715
 716         # get top 3 stats of $type in $chan
 717         my %hash =
 718           &sqlSelectColHash( 'stats', 'nick,counter', $where_chan_type,
 719             'ORDER BY counter DESC LIMIT 3', 1 );
 720         my $i;
 721         my @top;
 722
 723         # unfortunately we have to sort it again!
 724         my $tp = 0;
 725         foreach $i ( sort { $b <=> $a } keys %hash ) {
 726             foreach ( keys %{ $hash{$i} } ) {
 727                 my $p = sprintf( '%.01f', 100 * $i / $sum );
 728                 $tp += $p;
 729                 push( @top, "\002$_\002 -- $i ($p%)" );
 730             }
 731         }
 732         my $topstr = '';
 733         if ( scalar @top ) {
 734             $topstr = '.  Top ' . scalar(@top) . ': ' . join( ', ', @top );
 735         }
 736
 737         if ( defined $sum ) {
 738             &performStrictReply(
 739                 "total count of \037$type\037 on \002$c\002: $sum$topstr");
 740         }
 741         else {
 742             &performStrictReply("zero counter for \037$type\037.");
 743         }
 744     }
 745     else {
 746         my $x =
 747           ( &sqlSelect( 'stats', 'SUM(counter)', $where_chan_type_nick ) )[0];
 748
 749         if ( !defined $x ) {    # If no stats were found
 750             &performStrictReply("$arg has not said $type yet.");
 751             return 1;
 752         }
 753
 754         # Get list of all nicks for channel $c and $type
 755         my @array =
 756           &sqlSelectColArray( 'stats', 'nick', $where_chan_type,
 757             'ORDER BY counter DESC' );
 758
 759         my $total = scalar(@array);
 760         my $rank;
 761
 762         # Find position of nick $arg in the list
 763         for ( my $i = 0 ; $i < $total ; $i++ ) {
 764             next unless ( $array[$i] =~ /^\Q$arg\E$/ );
 765             $rank = $i + 1;
 766             last;
 767         }
 768
 769         my $xtra;
 770         if ( $total and $rank ) {
 771             my $pct = sprintf( '%.01f', 100 * ($rank) / $total );
 772             $xtra =
 773               ", ranked $rank\002/\002$total (percentile: \002$pct\002 %)";
 774         }
 775
 776         my $pct1 = sprintf( '%.01f', 100 * $x / $sum );
 777         &performStrictReply(
 778 "\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"
 779         );
 780     }
 781
 782     return 1;
 783 }
 784
 785 %cmdhooks=();
 786 ###
 787 ### START ADDING HOOKS.
 788 ###
 789 &addCmdHook('(babel(fish)?|x|xlate|translate)', ('CODEREF' => 'babelfish::babelfish', 'Identifier' => 'babelfish', 'Cmdstats' => 'babelfish', 'Forker' => 1, 'Help' => 'babelfish', 'Module' => 'babelfish') );
 790 &addCmdHook('(botmail|message)', ('CODEREF' => 'botmail::parse', 'Identifier' => 'botmail', 'Cmdstats' => 'botmail') );
 791 &addCmdHook('bzflist17', ('CODEREF' => 'BZFlag::list17', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 792 &addCmdHook('bzflist', ('CODEREF' => 'BZFlag::list', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 793 &addCmdHook('bzfquery', ('CODEREF' => 'BZFlag::query', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 794 &addCmdHook('chan(stats|info)', ('CODEREF' => 'chaninfo', ) );
 795 &addCmdHook('cmd(stats|info)', ('CODEREF' => 'cmdstats', ) );
 796 &addCmdHook('convert', ('CODEREF' => 'convert', 'Forker' => 1, 'Identifier' => 'Units', 'Help' => 'convert') );
 797 &addCmdHook('(cookie|random)', ('CODEREF' => 'cookie', 'Forker' => 1, 'Identifier' => 'Factoids') );
 798 &addCmdHook('countdown', ('CODEREF' => 'countdown', 'Module' => 'countdown', 'Identifier' => 'countdown', 'Cmdstats' => 'countdown') );
 799 &addCmdHook('countrystats', ('CODEREF' => 'countryStats') );
 800 &addCmdHook('dauthor', ('CODEREF' => 'Debian::searchAuthor', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Author Search', 'Help' => 'dauthor' ) );
 801 &addCmdHook('d?bugs', ('CODEREF' => 'DebianExtra::Parse', 'Forker' => 1, 'Identifier' => 'DebianExtra', 'Cmdstats' => 'Debian Bugs') );
 802 &addCmdHook('d?contents', ('CODEREF' => 'Debian::searchContents', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Contents Search', 'Help' => 'contents' ) );
 803 &addCmdHook('d?find', ('CODEREF' => 'Debian::DebianFind', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Search', 'Help' => 'find' ) );
 804 &addCmdHook('dice', ('CODEREF' => 'dice::dice', 'Identifier' => 'dice', 'Cmdstats' => 'dice', 'Forker' => 1, 'Module' => 'dice') );
 805 &addCmdHook('Dict', ('CODEREF' => 'Dict::Dict', 'Identifier' => 'Dict', 'Help' => 'dict', 'Forker' => 1, 'Cmdstats' => 'Dict') );
 806 &addCmdHook('dincoming', ('CODEREF' => 'Debian::generateIncoming', 'Forker' => 1, 'Identifier' => 'Debian' ) );
 807 &addCmdHook('dnew', ('CODEREF' => 'DebianNew', 'Identifier' => 'Debian' ) );
 808 &addCmdHook('dns|d?nslookup', ('CODEREF' => 'dns::query', 'Identifier' => 'dns', 'Cmdstats' => 'dns', 'Forker' => 1, 'Help' => 'dns') );
 809 &addCmdHook('(d|search)desc', ('CODEREF' => 'Debian::searchDescFE', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Desc Search', 'Help' => 'ddesc' ) );
 810 &addCmdHook('dstats', ('CODEREF' => 'Debian::infoStats', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Statistics' ) );
 811 &addCmdHook('(ex)?change', ('CODEREF' => 'Exchange::query', 'Identifier' => 'Exchange', 'Cmdstats' => 'Exchange', 'Forker' => 1) );
 812 &addCmdHook('factinfo', ('CODEREF' => 'factinfo', 'Cmdstats' => 'Factoid Info', Module => 'Factoids', ) );
 813 &addCmdHook('factstats?', ('CODEREF' => 'factstats', 'Cmdstats' => 'Factoid Stats', Help => 'factstats', Forker => 1, 'Identifier' => 'Factoids', ) );
 814 &addCmdHook('help', ('CODEREF' => 'help', 'Cmdstats' => 'Help', ) );
 815 &addCmdHook('hex2ip', ('CODEREF' => 'hex2ip::query', 'Forker' => 1, 'Identifier' => 'hex2ip', 'Cmdstats' => 'hex2ip', 'Help' => 'hex2ip') );
 816 &addCmdHook('HTTPDtype', ('CODEREF' => 'HTTPDtype::HTTPDtype', 'Identifier' => 'HTTPDtype', 'Cmdstats' => 'HTTPDtype', 'Forker' => 1) );
 817 &addCmdHook('[ia]?spell', ('CODEREF' => 'spell::query', 'Identifier' => 'spell', 'Cmdstats' => 'spell', 'Forker' => 1, 'Help' => 'spell') );
 818 &addCmdHook('insult', ('CODEREF' => 'Insult::Insult', 'Forker' => 1, 'Identifier' => 'insult', 'Help' => 'insult' ) );
 819 &addCmdHook('karma', ('CODEREF' => 'karma', ) );
 820 &addCmdHook('kernel', ('CODEREF' => 'Kernel::Kernel', 'Forker' => 1, 'Identifier' => 'Kernel', 'Cmdstats' => 'Kernel', 'NoArgs' => 1) );
 821 &addCmdHook('lart', ('CODEREF' => 'lart', 'Identifier' => 'lart', 'Help' => 'lart') );
 822 &addCmdHook('lc', ('CODEREF' => 'case::lower', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') );
 823 &addCmdHook('listauth', ('CODEREF' => 'CmdListAuth', 'Identifier' => 'Search', Module => 'Factoids', 'Help' => 'listauth') );
 824 &addCmdHook('md5(sum)?', ('CODEREF' => 'md5::md5', 'Identifier' => 'md5', 'Cmdstats' => 'md5', 'Forker' => 1, 'Module' => 'md5') );
 825 &addCmdHook('metar', ('CODEREF' => 'Weather::Metar', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1) );
 826 &addCmdHook('News', ('CODEREF' => 'News::Parse', Module => 'News', 'Cmdstats' => 'News', 'Identifier' => 'News' ) );
 827 &addCmdHook('(?:nick|lame)ometer(?: for)?', ('CODEREF' => 'nickometer::query', 'Identifier' => 'nickometer', 'Cmdstats' => 'nickometer', 'Forker' => 1) );
 828 &addCmdHook('OnJoin', ('CODEREF' => 'Cmdonjoin', 'Identifier' => 'OnJoin', 'Module' => 'OnJoin') );
 829 &addCmdHook('page', ('CODEREF' => 'pager::page', 'Identifier' => 'pager', 'Cmdstats' => 'pager', 'Forker' => 1, 'Help' => 'page') );
 830 &addCmdHook('piglatin', ('CODEREF' => 'piglatin::piglatin', 'Identifier' => 'piglatin', 'Cmdstats' => 'piglatin', 'Forker' => 1) );
 831 &addCmdHook('Plug', ('CODEREF' => 'Plug::Plug', 'Identifier' => 'Plug', 'Forker' => 1, 'Cmdstats' => 'Plug') );
 832 &addCmdHook('quote', ('CODEREF' => 'Quote::Quote', 'Forker' => 1, 'Identifier' => 'Quote', 'Help' => 'quote', 'Cmdstats' => 'Quote') );
 833 &addCmdHook('reverse', ('CODEREF' => 'reverse::reverse', 'Identifier' => 'reverse', 'Cmdstats' => 'reverse', 'Forker' => 1, 'Module' => 'reverse') );
 834 &addCmdHook('RootWarn', ('CODEREF' => 'CmdrootWarn', 'Identifier' => 'RootWarn', 'Module' => 'RootWarn') );
 835 &addCmdHook('Rss', ('CODEREF' => 'Rss::Rss', 'Identifier' => 'Rss', 'Cmdstats' => 'Rss', 'Forker' => 1, 'Help' => 'rss') );
 836 &addCmdHook('RSSFeeds',('CODEREF' => 'RSSFeeds::RSS', 'Identifier' => 'RSSFeeds', 'Forker' => 1, 'Help' => 'rssfeeds', 'Cmdstats' => 'RSSFeeds', 'Module' => 'RSSFeeds') );
 837 &addCmdHook('sched(stats|info)', ('CODEREF' => 'scheduleList', ) );
 838 &addCmdHook('scramble', ('CODEREF' => 'scramble::scramble', 'Identifier' => 'scramble', 'Cmdstats' => 'scramble', 'Forker' => 1, 'Module' => 'scramble') );
 839 &addCmdHook('seen', ('CODEREF' => 'seen', 'Identifier' => 'seen') );
 840 &addCmdHook('slashdot', ('CODEREF' => 'Slashdot::Slashdot', 'Identifier' => 'slashdot', 'Forker' => 1, 'Cmdstats' => 'slashdot') );
 841 &addCmdHook('tell|explain', ('CODEREF' => 'tell', Help => 'tell', Identifier => 'allowTelling', Cmdstats => 'Tell') );
 842 &addCmdHook('uc', ('CODEREF' => 'case::upper', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') );
 843 &addCmdHook('upsidedown', ('CODEREF' => 'upsidedown::upsidedown', 'Identifier' => 'upsidedown', 'Cmdstats' => 'upsidedown', 'Forker' => 1, 'Module' => 'upsidedown') );
 844 &addCmdHook('Uptime', ('CODEREF' => 'uptime', 'Identifier' => 'Uptime', 'Cmdstats' => 'Uptime') );
 845 &addCmdHook('u(ser)?info', ('CODEREF' => 'userinfo', 'Identifier' => 'UserInfo', 'Help' => 'userinfo', 'Module' => 'UserInfo') );
 846 &addCmdHook('verstats', ('CODEREF' => 'do_verstats', 'Identifier' => 'verstats', 'Help' => 'verstats', 'Cmdstats' => 'verstats') );
 847 &addCmdHook('Weather', ('CODEREF' => 'Weather::Weather', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1, 'Module' => 'Weather') );
 848 &addCmdHook('wiki(pedia)?', ('CODEREF' => 'wikipedia::wikipedia', 'Identifier' => 'wikipedia', 'Cmdstats' => 'wikipedia', 'Forker' => 1, 'Help' => 'wikipedia', 'Module' => 'wikipedia') );
 849 &addCmdHook('wtf', ('CODEREF' => 'wtf::query', 'Identifier' => 'wtf', 'Cmdstats' => 'wtf', 'Forker' => 1, 'Help' => 'wtf', 'Module' => 'wtf') );
 850 &addCmdHook('zfi', ('CODEREF' => 'zfi::query', 'Identifier' => 'zfi', 'Cmdstats' => 'zfi', 'Forker' => 1, 'Module' => 'zfi') );
 851 &addCmdHook('(zippy|yow)', ('CODEREF' => 'zippy::get', 'Identifier' => 'Zippy', 'Cmdstats' => 'Zippy', 'Forker' => 1, 'Module' => 'Zippy') );
 852 &addCmdHook('zsi', ('CODEREF' => 'zsi::query', 'Identifier' => 'zsi', 'Cmdstats' => 'zsi', 'Forker' => 1, 'Module' => 'zsi') );
 853 ###
 854 ### END OF ADDING HOOKS.
 855 ###
 856
 857 &status( 'loaded ' . scalar( keys %cmdhooks ) . ' command hooks.' );
 858
 859 1;
 860
 861 # vim:ts=4:sw=4:expandtab:tw=80