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 -- thanks Brett Cave
 186     if ( $message =~
 187         /^(\s+)?google\s+['"]?(.*?)["']?\s*\?*$/i
 188       )
 189     {
 190         return unless ( &IsChanConfOrWarn('Google') );
 191
 192         &Forker( 'Google', sub { &Google::GoogleSearch( $2 ); } );
 193
 194         $cmdstats{'Google'}++;
 195         return;
 196     }
 197
 198     # text counters. (eg: hehstats)
 199     my $itc;
 200     $itc = &getChanConf('ircTextCounters');
 201     $itc = &findChanConf('ircTextCounters') unless ($itc);
 202     return if ( $itc && &do_text_counters($itc) == 1 );
 203
 204     # end of text counters.
 205
 206     # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
 207     if ( $message =~ /^list(\S+)(\s+(.*))?$/i ) {
 208         return unless ( &IsChanConfOrWarn('Search') );
 209
 210         my $thiscmd = lc $1;
 211         my $args = $3 || '';
 212
 213         $thiscmd =~ s/^vals$/values/;
 214         return if ( $thiscmd ne 'keys' && $thiscmd ne 'values' );
 215
 216         # Usage:
 217         if ( !defined $args or $args =~ /^\s*$/ ) {
 218             &help( 'list' . $thiscmd );
 219             return;
 220         }
 221
 222         # suggested by asuffield and \broken.
 223         if ( $args =~ /^["']/ and $args =~ /["']$/ ) {
 224             &DEBUG('list*: removed quotes.');
 225             $args =~ s/^["']|["']$//g;
 226         }
 227
 228         if ( length $args < 2 && &IsFlag('o') ne 'o' ) {
 229             &msg( $who, 'search string is too short.' );
 230             return;
 231         }
 232
 233         &Forker( 'Search', sub { &Search::Search( $thiscmd, $args ); } );
 234
 235         $cmdstats{'Factoid Search'}++;
 236         return;
 237     }
 238
 239     # Topic management. xk++
 240     # may want to add a userflags for topic. -xk
 241     if ( $message =~ /^topic(\s+(.*))?$/i ) {
 242         return unless ( &IsChanConfOrWarn('Topic') );
 243
 244         my $chan = $talkchannel;
 245         my @args = split / /, $2 || '';
 246
 247         if ( !scalar @args ) {
 248             &msg( $who, "Try 'help topic'" );
 249             return;
 250         }
 251
 252         $chan = lc( shift @args ) if ( $msgType eq 'private' );
 253         my $thiscmd = shift @args;
 254
 255         # topic over public:
 256         if ( $msgType eq 'public' && $thiscmd =~ /^#/ ) {
 257             &msg( $who, 'error: channel argument is not required.' );
 258             &msg( $who, "\002Usage\002: topic <CMD>" );
 259             return;
 260         }
 261
 262         # topic over private:
 263         if ( $msgType eq 'private' && $chan !~ /^#/ ) {
 264             &msg( $who, 'error: channel argument is required.' );
 265             &msg( $who, "\002Usage\002: topic #channel <CMD>" );
 266             return;
 267         }
 268
 269         if ( &validChan($chan) == 0 ) {
 270             &msg( $who, "error: invalid channel \002$chan\002" );
 271             return;
 272         }
 273
 274         # for semi-outsiders.
 275         if ( !&IsNickInChan( $who, $chan ) ) {
 276             &msg( $who, "Failed. You ($who) are not in $chan, hey?" );
 277             return;
 278         }
 279
 280         # now lets do it.
 281         &loadMyModule('Topic');
 282         &Topic( $chan, $thiscmd, join( ' ', @args ) );
 283         $cmdstats{'Topic'}++;
 284         return;
 285     }
 286
 287     # wingate.
 288     if ( $message =~ /^wingate$/i ) {
 289         return unless ( &IsChanConfOrWarn('Wingate') );
 290
 291         my $reply =
 292             "Wingate statistics: scanned \002"
 293           . scalar( keys %wingateToDo )
 294           . "\002 hosts";
 295         my $queue = scalar( keys %wingateToDo );
 296         if ($queue) {
 297             $reply .= ".  I have \002$queue\002 hosts in the queue";
 298             $reply .=
 299               '.  Started the scan '
 300               . &Time2String( time() - $wingaterun ) . ' ago';
 301         }
 302
 303         &performStrictReply("$reply.");
 304
 305         return;
 306     }
 307
 308     # do nothing and let the other routines have a go
 309     return 'CONTINUE';
 310 }
 311
 312 # Uptime. xk++
 313 sub uptime {
 314     my $count = 1;
 315     &msg( $who, "- Uptime for $ident -" );
 316     &msg( $who,
 317         'Now: ' . &Time2String( &uptimeNow() ) . " running $bot_version" );
 318
 319     foreach ( &uptimeGetInfo() ) {
 320         /^(\d+)\.\d+ (.*)/;
 321         my $time = &Time2String($1);
 322         my $info = $2;
 323
 324         &msg( $who, "$count: $time $2" );
 325         $count++;
 326     }
 327 }
 328
 329 # seen.
 330 sub seen {
 331     my ($person) = lc shift;
 332     $person =~ s/\?*$//;
 333
 334     if ( !defined $person or $person =~ /^$/ ) {
 335         &help('seen');
 336
 337         my $i = &countKeys('seen');
 338         &msg( $who,
 339                 'there '
 340               . &fixPlural( 'is', $i )
 341               . " \002$i\002 " . 'seen '
 342               . &fixPlural( 'entry', $i )
 343               . ' that I know of.' );
 344
 345         return;
 346     }
 347
 348     my @seen;
 349
 350     &seenFlush();    # very evil hack. oh well, better safe than sorry.
 351
 352     # TODO: convert to &sqlSelectRowHash();
 353     my $select = 'nick,time,channel,host,message';
 354     if ( $person eq 'random' ) {
 355         @seen = &randKey( 'seen', $select );
 356     }
 357     else {
 358         @seen = &sqlSelect( 'seen', $select, { nick => $person } );
 359     }
 360
 361     if ( scalar @seen < 2 ) {
 362         foreach (@seen) {
 363             &DEBUG("seen: _ => '$_'.");
 364         }
 365         &performReply("i haven't seen '$person'");
 366         return;
 367     }
 368
 369     # valid seen.
 370     my $reply;
 371     ### TODO: multi channel support. may require &IsNick() to return
 372     ### all channels or something.
 373
 374     my @chans = &getNickInChans( $seen[0] );
 375     if ( scalar @chans ) {
 376         $reply = "$seen[0] is currently on";
 377
 378         foreach (@chans) {
 379             $reply .= ' ' . $_;
 380             next unless ( exists $userstats{ lc $seen[0] }{'Join'} );
 381             $reply .= ' ('
 382               . &Time2String( time() - $userstats{ lc $seen[0] }{'Join'} )
 383               . ')';
 384         }
 385
 386         if ( &IsChanConf('seenStats') > 0 ) {
 387             my $i;
 388             $i = $userstats{ lc $seen[0] }{'Count'};
 389             $reply .= ". Has said a total of \002$i\002 messages"
 390               if ( defined $i );
 391             $i = $userstats{ lc $seen[0] }{'Time'};
 392             $reply .= '. Is idling for ' . &Time2String( time() - $i )
 393               if ( defined $i );
 394         }
 395         $reply .= ", last said\002:\002 '$seen[4]'.";
 396     }
 397     else {
 398         my $howlong = &Time2String( time() - $seen[1] );
 399         $reply =
 400             "$seen[0] <$seen[3]> was last seen on IRC "
 401           . "in channel $seen[2], $howlong ago, "
 402           . "saying\002:\002 '$seen[4]'.";
 403     }
 404
 405     &performStrictReply($reply);
 406     return;
 407 }
 408
 409 # User Information Services. requested by Flugh.
 410 sub userinfo {
 411     my ($arg) = join( ' ', @_ );
 412
 413     if ( $arg =~ /^set(\s+(.*))?$/i ) {
 414         $arg = $2;
 415         if ( !defined $arg ) {
 416             &help('userinfo set');
 417             return;
 418         }
 419
 420         &UserInfoSet( split /\s+/, $arg, 2 );
 421     }
 422     elsif ( $arg =~ /^unset(\s+(.*))?$/i ) {
 423         $arg = $2;
 424         if ( !defined $arg ) {
 425             &help('userinfo unset');
 426             return;
 427         }
 428
 429         &UserInfoSet( $arg, '' );
 430     }
 431     else {
 432         &UserInfoGet($arg);
 433     }
 434 }
 435
 436 # cookie (random). xk++
 437 sub cookie {
 438     my ($arg) = @_;
 439
 440     # lets find that secret cookie.
 441     my $target = ( $msgType ne 'public' ) ? $who : $talkchannel;
 442     my $cookiemsg = &getRandom( keys %{ $lang{'cookie'} } );
 443     my ( $key, $value );
 444
 445     ### WILL CHEW TONS OF MEM.
 446     ### TODO: convert this to a Forker function!
 447     if ($arg) {
 448         my @list =
 449           &searchTable( 'factoids', 'factoid_key', 'factoid_value', $arg );
 450         $key = &getRandom(@list);
 451         $value = &getFactInfo( $key, 'factoid_value' );
 452     }
 453     else {
 454         ( $key, $value ) = &randKey( 'factoids', 'factoid_key,factoid_value' );
 455     }
 456
 457     for ($cookiemsg) {
 458         s/##KEY/\002$key\002/;
 459         s/##VALUE/$value/;
 460         s/##WHO/$who/;
 461         s/\$who/$who/;    # cheap fix.
 462         s/(\S+)?\s*<\S+>/$1 /;
 463         s/\s+/ /g;
 464     }
 465
 466     if ( $cookiemsg =~ s/^ACTION //i ) {
 467         &action( $target, $cookiemsg );
 468     }
 469     else {
 470         &msg( $target, $cookiemsg );
 471     }
 472 }
 473
 474 sub convert {
 475     my $arg = join( ' ', @_ );
 476     my ( $from, $to ) = ( '', '' );
 477
 478     ( $from, $to ) = ( $1, $2 ) if ( $arg =~ /^(.*?) to (.*)$/i );
 479     ( $from, $to ) = ( $2, $1 ) if ( $arg =~ /^(.*?) from (.*)$/i );
 480
 481     if ( !$to or !$from ) {
 482         &msg( $who, 'Invalid format!' );
 483         &help('convert');
 484         return;
 485     }
 486
 487     &Units::convertUnits( $from, $to );
 488
 489     return;
 490 }
 491
 492 sub lart {
 493     my ($target) = &fixString( $_[0] );
 494     my $extra    = 0;
 495     my $chan     = $talkchannel;
 496     my ($for);
 497     my $mynick = $conn->nick();
 498
 499     if ( $msgType eq 'private' ) {
 500         if ( $target =~ /^($mask{chan})\s+(.*)$/ ) {
 501             $chan   = $1;
 502             $target = $2;
 503             $extra  = 1;
 504         }
 505         else {
 506             &msg( $who, 'error: invalid format or missing arguments.' );
 507             &help('lart');
 508             return;
 509         }
 510     }
 511     if ( $target =~ /^(.*)(\s+for\s+.*)$/ ) {
 512         $target = $1;
 513         $for    = $2;
 514     }
 515
 516     my $line = &getRandomLineFromFile( $bot_data_dir . '/infobot.lart' );
 517     if ( defined $line ) {
 518         if ( $target =~ /^(me|you|itself|\Q$mynick\E)$/i ) {
 519             $line =~ s/WHO/$who/g;
 520         }
 521         else {
 522             $line =~ s/WHO/$target/g;
 523         }
 524         $line .= $for if ($for);
 525         $line .= ", courtesy of $who" if ($extra);
 526
 527         &action( $chan, $line );
 528     }
 529     else {
 530         &status('lart: error reading file?');
 531     }
 532 }
 533
 534 sub DebianNew {
 535     my $idx   = 'debian/Packages-sid.idx';
 536     my $error = 0;
 537     my %pkg;
 538     my @new;
 539
 540     $error++ unless ( -e $idx );
 541     $error++ unless ( -e "$idx-old" );
 542
 543     if ($error) {
 544         $error = 'no sid/sid-old index file found.';
 545         &ERROR("Debian: $error");
 546         &msg( $who, $error );
 547         return;
 548     }
 549
 550     open( IDX1, $idx );
 551     open( IDX2, "$idx-old" );
 552
 553     while (<IDX2>) {
 554         chop;
 555         next if (/^\*/);
 556
 557         $pkg{$_} = 1;
 558     }
 559     close IDX2;
 560
 561     open( IDX1, $idx );
 562     while (<IDX1>) {
 563         chop;
 564         next if (/^\*/);
 565         next if ( exists $pkg{$_} );
 566
 567         push( @new, $_ );
 568     }
 569     close IDX1;
 570
 571     &::performStrictReply(
 572         &::formListReply( 0, 'New debian packages:', @new ) );
 573 }
 574
 575 sub do_verstats {
 576     my ($chan) = @_;
 577
 578     if ( !defined $chan ) {
 579         &help('verstats');
 580         return;
 581     }
 582
 583     if ( !&validChan($chan) ) {
 584         &msg( $who, "chan $chan is invalid." );
 585         return;
 586     }
 587
 588     if ( scalar @vernick > scalar( keys %{ $channels{ lc $chan }{''} } ) / 4 ) {
 589         &msg( $who, 'verstats already in progress for someone else.' );
 590         return;
 591     }
 592
 593     &msg( $who,  "Sending CTCP VERSION to $chan; results in 60s." );
 594     &msg( $chan, "WARNING: $who has forced me to CTCP VERSION the channel!" );
 595
 596     # Workaround for bug in Net::Irc, provided by quin@freenode. Details at:
 597     # http://rt.cpan.org/Public/Bug/Display.html?id=11421
 598     # $conn->ctcp( 'VERSION', $chan );
 599     $conn->sl("PRIVMSG $chan :\001VERSION\001");
 600
 601     $cache{verstats}{chan}    = $chan;
 602     $cache{verstats}{who}     = $who;
 603     $cache{verstats}{msgType} = $msgType;
 604
 605     $conn->schedule(
 606         30,
 607         sub {
 608             my $c = lc $cache{verstats}{chan};
 609             @vernicktodo = ();
 610
 611             foreach ( keys %{ $channels{$c}{''} } ) {
 612                 next if ( grep /^\Q$_\E$/i, @vernick );
 613                 push( @vernicktodo, $_ );
 614             }
 615
 616             &verstats_flush();
 617         }
 618     );
 619
 620     $conn->schedule(
 621         60,
 622         sub {
 623             my $vtotal = 0;
 624             my $c      = lc $cache{verstats}{chan};
 625             my $total  = keys %{ $channels{$c}{''} };
 626             $who     = $cache{verstats}{who};
 627             $msgType = $cache{verstats}{msgType};
 628             delete $cache{verstats};    # sufficient?
 629
 630             foreach ( keys %ver ) {
 631                 $vtotal += scalar keys %{ $ver{$_} };
 632             }
 633
 634             my %sorted;
 635             my $unknown = $total - $vtotal;
 636             my $perc = sprintf( '%.1f', $unknown * 100 / $total );
 637             $perc =~ s/.0$//;
 638             $sorted{$perc}{'unknown/cloak'} = "$unknown ($perc%)" if ($unknown);
 639
 640             foreach ( keys %ver ) {
 641                 my $count = scalar keys %{ $ver{$_} };
 642                 $perc = sprintf( '%.01f', $count * 100 / $total );
 643                 $perc =~ s/.0$//;    # lame compression.
 644
 645                 $sorted{$perc}{$_} = "$count ($perc%)";
 646             }
 647
 648             ### can be compressed to a map?
 649             my @list;
 650             foreach ( sort { $b <=> $a } keys %sorted ) {
 651                 my $perc = $_;
 652                 foreach ( sort keys %{ $sorted{$perc} } ) {
 653                     push( @list, "$_ - $sorted{$perc}{$_}" );
 654                 }
 655             }
 656
 657             # hack. this is one major downside to scheduling.
 658             &msg($c,
 659                 &formListReply( 0, "IRC Client versions for $c ", @list ) );
 660
 661             # clean up not-needed data structures.
 662             undef %ver;
 663             undef @vernick;
 664         }
 665     );
 666
 667     return;
 668 }
 669
 670 sub verstats_flush {
 671     for ( 1 .. 5 ) {
 672         last unless ( scalar @vernicktodo );
 673
 674         my $n = shift(@vernicktodo);
 675         #$conn->ctcp( 'VERSION', $n );
 676         # See do_verstats $conn->sl for explantaion
 677         $conn->sl("PRIVMSG $n :\001VERSION\001");
 678     }
 679
 680     return unless ( scalar @vernicktodo );
 681
 682     $conn->schedule( 3, \&verstats_flush() );
 683 }
 684
 685 sub do_text_counters {
 686     my ($itc) = @_;
 687     $itc =~ s/([^\w\s])/\\$1/g;
 688     my $z = join '|', split ' ', $itc;
 689
 690     if ( $msgType eq 'privmsg' and $message =~ / ($mask{chan})$/ ) {
 691         &DEBUG("ircTC: privmsg detected; chan = $1");
 692         $chan = $1;
 693     }
 694
 695     my ( $type, $arg );
 696     if ( $message =~ /^($z)stats(\s+(\S+))?$/i ) {
 697         $type = $1;
 698         $arg  = $3;
 699     }
 700     else {
 701         return 0;
 702     }
 703
 704     my $c = $chan || 'PRIVATE';
 705
 706     # Define various types of stats in one place.
 707     # Note: sqlSelectColHash has built in sqlQuote
 708     my $where_chan_type = { channel => $c, type => $type };
 709     my $where_chan_type_nick = { channel => $c, type => $type, nick => $arg };
 710
 711     my $sum = ( &sqlSelect( 'stats', 'SUM(counter)', $where_chan_type ) )[0];
 712
 713     if ( !defined $arg or $arg =~ /^\s*$/ ) {
 714
 715         # get top 3 stats of $type in $chan
 716         my %hash =
 717           &sqlSelectColHash( 'stats', 'nick,counter', $where_chan_type,
 718             'ORDER BY counter DESC LIMIT 3', 1 );
 719         my $i;
 720         my @top;
 721
 722         # unfortunately we have to sort it again!
 723         my $tp = 0;
 724         foreach $i ( sort { $b <=> $a } keys %hash ) {
 725             foreach ( keys %{ $hash{$i} } ) {
 726                 my $p = sprintf( '%.01f', 100 * $i / $sum );
 727                 $tp += $p;
 728                 push( @top, "\002$_\002 -- $i ($p%)" );
 729             }
 730         }
 731         my $topstr = '';
 732         if ( scalar @top ) {
 733             $topstr = '.  Top ' . scalar(@top) . ': ' . join( ', ', @top );
 734         }
 735
 736         if ( defined $sum ) {
 737             &performStrictReply(
 738                 "total count of \037$type\037 on \002$c\002: $sum$topstr");
 739         }
 740         else {
 741             &performStrictReply("zero counter for \037$type\037.");
 742         }
 743     }
 744     else {
 745         my $x =
 746           ( &sqlSelect( 'stats', 'SUM(counter)', $where_chan_type_nick ) )[0];
 747
 748         if ( !defined $x ) {    # If no stats were found
 749             &performStrictReply("$arg has not said $type yet.");
 750             return 1;
 751         }
 752
 753         # Get list of all nicks for channel $c and $type
 754         my @array =
 755           &sqlSelectColArray( 'stats', 'nick', $where_chan_type,
 756             'ORDER BY counter DESC' );
 757
 758         my $total = scalar(@array);
 759         my $rank;
 760
 761         # Find position of nick $arg in the list
 762         for ( my $i = 0 ; $i < $total ; $i++ ) {
 763             next unless ( $array[$i] =~ /^\Q$arg\E$/ );
 764             $rank = $i + 1;
 765             last;
 766         }
 767
 768         my $xtra;
 769         if ( $total and $rank ) {
 770             my $pct = sprintf( '%.01f', 100 * ($rank) / $total );
 771             $xtra =
 772               ", ranked $rank\002/\002$total (percentile: \002$pct\002 %)";
 773         }
 774
 775         my $pct1 = sprintf( '%.01f', 100 * $x / $sum );
 776         &performStrictReply(
 777 "\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"
 778         );
 779     }
 780
 781     return 1;
 782 }
 783
 784 %cmdhooks=();
 785 ###
 786 ### START ADDING HOOKS.
 787 ###
 788 &addCmdHook('(x|xlate|translate)', ('CODEREF' => 'translate::translate', 'Identifier' => 'translate', 'Cmdstats' => 'translate', 'Forker' => 1, 'Help' => 'translate', 'Module' => 'translate') );
 789 &addCmdHook('(botmail|message)', ('CODEREF' => 'botmail::parse', 'Identifier' => 'botmail', 'Cmdstats' => 'botmail') );
 790 &addCmdHook('bzflist17', ('CODEREF' => 'BZFlag::list17', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 791 &addCmdHook('bzflist', ('CODEREF' => 'BZFlag::list', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 792 &addCmdHook('bzfquery', ('CODEREF' => 'BZFlag::query', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') );
 793 &addCmdHook('chan(stats|info)', ('CODEREF' => 'chaninfo', ) );
 794 &addCmdHook('conn(stats|info)', ('CODEREF' => 'conninfo', ) );
 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