src/UserExtra.pl

   1 #
   2 # UserExtra.pl: User Commands, Public.
   3 #       Author: dms
   4 #
   5
   6 use strict;
   7 use vars qw($message $arg $qWord $verb $lobotomized $who $result $chan
   8   $conn $msgType $query $talkchannel $ident $memusage);
   9 use vars qw(%channels %chanstats %cmdstats %count %forked %ircstats %param
  10   %cache %mask %userstats);
  11
  12 ### hooks get added in CommandHooks.pl.
  13
  14 ###
  15 ### Start of commands for hooks.
  16 ###
  17
  18 sub chaninfo {
  19     my $chan = lc shift(@_);
  20     my $mode;
  21
  22     if ( $chan eq '' ) {    # all channels.
  23         my $i = keys %channels;
  24         my $reply = "I'm on \002$i\002 " . &fixPlural( 'channel', $i );
  25         my $tucount = 0;    # total user count.
  26         my $uucount = 0;    # unique user count.
  27         my %chans;
  28         my @array;
  29
  30         ### line 1.
  31         foreach ( keys %channels ) {
  32             if ( /^\s*$/ or / / ) {
  33                 &status('chanstats: fe channels: chan == NULL.');
  34
  35                 #&ircCheck();
  36                 next;
  37             }
  38             next if (/^_default$/);
  39
  40             $chans{$_} = scalar( keys %{ $channels{$_}{''} } );
  41         }
  42         foreach $chan ( sort { $chans{$b} <=> $chans{$a} } keys %chans ) {
  43             push( @array, "$chan/" . $chans{$chan} );
  44         }
  45         &performStrictReply( $reply . ': ' . join( ', ', @array ) );
  46
  47         ### total user count.
  48         foreach $chan ( keys %channels ) {
  49             $tucount += scalar( keys %{ $channels{$chan}{''} } );
  50         }
  51
  52         ### unique user count.
  53         my %nicks = ();
  54         foreach $chan ( keys %channels ) {
  55             my $nick;
  56             foreach $nick ( keys %{ $channels{$chan}{''} } ) {
  57                 $nicks{$nick}++;
  58             }
  59         }
  60         $uucount = scalar( keys %nicks );
  61
  62         my $chans = scalar( keys %channels );
  63         &performStrictReply( "i've cached \002$tucount\002 "
  64               . &fixPlural( 'user', $tucount )
  65               . ", \002$uucount\002 unique "
  66               . &fixPlural( 'user', $uucount )
  67               . ", distributed over \002$chans\002 "
  68               . &fixPlural( 'channel', $chans )
  69               . '.' );
  70         &ircCheck();
  71
  72         return;
  73     }
  74
  75     # channel specific.
  76
  77     if ( &validChan($chan) == 0 ) {
  78         &msg( $who, "error: invalid channel \002$chan\002" );
  79         return;
  80     }
  81
  82     # Step 1:
  83     my @array;
  84     foreach ( sort keys %{ $chanstats{$chan} } ) {
  85         my $int = $chanstats{$chan}{$_};
  86         next unless ($int);
  87
  88         push( @array, "\002$int\002 " . &fixPlural( $_, $int ) );
  89     }
  90     my $reply =
  91         "On \002$chan\002, there "
  92       . &fixPlural( 'has', scalar(@array) )
  93       . ' been '
  94       . &IJoin(@array);
  95
  96     # Step 1b: check channel inconstencies.
  97     $chanstats{$chan}{'Join'}    ||= 0;
  98     $chanstats{$chan}{'SignOff'} ||= 0;
  99     $chanstats{$chan}{'Part'}    ||= 0;
 100
 101     my $delta_stats = $chanstats{$chan}{'Join'} - $chanstats{$chan}{'SignOff'} -
 102       $chanstats{$chan}{'Part'};
 103
 104     if ($delta_stats) {
 105         my $total = scalar( keys %{ $channels{$chan}{''} } );
 106         &status(
 107             "chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."
 108         );
 109
 110         if ( $delta_stats > $total ) {
 111             &ERROR('chaninfo: delta_stats exceeds total users.');
 112         }
 113     }
 114
 115     # Step 2:
 116     undef @array;
 117     my $type;
 118     foreach ( 'v', 'o', '' ) {
 119         my $int = scalar( keys %{ $channels{$chan}{$_} } );
 120         next unless ($int);
 121
 122         $type = 'Voice' if ( $_ eq 'v' );
 123         $type = 'Opped' if ( $_ eq 'o' );
 124         $type = 'Total' if ( $_ eq '' );
 125
 126         push( @array, "\002$int\002 $type" );
 127     }
 128     $reply .= '.  At the moment, ' . &IJoin(@array);
 129
 130     # Step 3:
 131     my %new;
 132     foreach ( keys %userstats ) {
 133         next unless ( exists $userstats{$_}{'Count'} );
 134         if ( $userstats{$_}{'Count'} =~ /^\D+$/ ) {
 135             &WARN("userstats{$_}{Count} is non-digit.");
 136             next;
 137         }
 138
 139         $new{$_} = $userstats{$_}{'Count'};
 140     }
 141
 142     # TODO: show top 3 with percentages?
 143     my ($count) = ( sort { $new{$b} <=> $new{$a} } keys %new )[0];
 144     if ($count) {
 145         $reply .=
 146 ".  \002$count\002 has said the most with a total of \002$new{$count}\002 messages";
 147     }
 148     &performStrictReply("$reply.");
 149 }
 150
 151 # Command statistics.
 152 sub cmdstats {
 153     my @array;
 154
 155     if ( !scalar( keys %cmdstats ) ) {
 156         &performReply('no-one has run any commands yet');
 157         return;
 158     }
 159
 160     my %countstats;
 161     foreach ( keys %cmdstats ) {
 162         $countstats{ $cmdstats{$_} }{$_} = 1;
 163     }
 164
 165     foreach ( sort { $b <=> $a } keys %countstats ) {
 166         my $int = $_;
 167         next unless ($int);
 168
 169         foreach ( keys %{ $countstats{$int} } ) {
 170             push( @array, "\002$int\002 of $_" );
 171         }
 172     }
 173     &performStrictReply( 'command usage includes ' . &IJoin(@array) . '.' );
 174 }
 175
 176 # Command statistics.
 177 sub conninfo {
 178     my $reply = 'conninfo:';
 179     my $key;
 180     foreach $key ( sort keys %::conns ) {
 181         my $myconn = $::conns{$key};
 182         $reply .= " $key/";
 183         next if (!defined $myconn);
 184         my $mynick = $myconn->nick();
 185         $reply .= "$mynick";
 186     }
 187     &performStrictReply( "conninfo: $reply.");
 188 }
 189
 190 # Factoid extension info. xk++
 191 sub factinfo {
 192     my $faqtoid = lc shift(@_);
 193     my $query   = '';
 194
 195     if ( $faqtoid =~ /^\-(\S+)(\s+(.*))$/ ) {
 196         &msg( $who,
 197             'error: individual factoid info queries not supported as yet.' );
 198         &msg( $who,
 199             "it's possible that the factoid mistakenly begins with '-'." );
 200         return;
 201
 202         $query   = lc $1;
 203         $faqtoid = lc $3;
 204     }
 205
 206     &CmdFactInfo( $faqtoid, $query );
 207 }
 208
 209 sub factstats {
 210     my $type = shift(@_);
 211
 212     &Forker(
 213         'Factoids',
 214         sub {
 215             &performStrictReply( &CmdFactStats($type) );
 216         }
 217     );
 218 }
 219
 220 sub karma {
 221     my $target = lc( shift || $who );
 222     my $karma =
 223       &sqlSelect( 'stats', 'counter', { nick => $target, type => 'karma' } )
 224       || 0;
 225
 226     if ( $karma != 0 ) {
 227         &performStrictReply("$target has karma of $karma");
 228     }
 229     else {
 230         &performStrictReply("$target has neutral karma");
 231     }
 232 }
 233
 234 sub tell {
 235     my $args = shift;
 236     my ( $target, $tell_obj ) = ( '', '' );
 237     my $dont_tell_me = 0;
 238     my $reply;
 239
 240     ### is this fixed elsewhere?
 241     $args =~ s/\s+/ /g;         # fix up spaces.
 242     $args =~ s/^\s+|\s+$//g;    # again.
 243
 244     # this one catches most of them
 245     if ( $args =~ /^(\S+) (-?)about (.*)$/i ) {
 246         $target       = $1;
 247         $tell_obj     = $3;
 248         $dont_tell_me = ($2) ? 1 : 0;
 249
 250         $tell_obj = $who if ( $tell_obj =~ /^(me|myself)$/i );
 251         $query = $tell_obj;
 252     }
 253     elsif ( $args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i ) {
 254
 255         # i'm sure this could all be nicely collapsed
 256         $target   = $1;
 257         $tell_obj = $4;
 258         $query    = $tell_obj;
 259
 260     }
 261     elsif ( $args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i ) {
 262         $target   = $1;
 263         $qWord    = $2;
 264         $tell_obj = $3;
 265         $verb     = $4;
 266         $query    = "$qWord $verb $tell_obj";
 267
 268     }
 269     elsif ( $args =~ /^(.*?) to (\S+)$/i ) {
 270         $target   = $3;
 271         $tell_obj = $2;
 272         $query    = $tell_obj;
 273     }
 274
 275     # check target type. Deny channel targets.
 276     if ( $target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/ ) {
 277         &msg( $who, "No, $who, I won't. (target invalid?)" );
 278         return;
 279     }
 280
 281     $target = $talkchannel if ( $target =~ /^us$/i );
 282     $target = $who         if ( $target =~ /^(me|myself)$/i );
 283
 284     &status("tell: target = $target, query = $query");
 285
 286     # 'intrusive'.
 287     #    if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
 288     #   &msg($who, "No, $target is not in any of my chans.");
 289     #   return;
 290     #    }
 291
 292     # self.
 293     if ( $target =~ /^\Q$ident\E$/i ) {
 294         &msg( $who, "Isn't that a bit silly?" );
 295         return;
 296     }
 297
 298     my $oldwho   = $who;
 299     my $oldmtype = $msgType;
 300     $who = $target;
 301     my $result = &doQuestion($tell_obj);
 302
 303     # ^ returns '0' if nothing was found.
 304     $who = $oldwho;
 305
 306     # no such factoid.
 307     if ( !defined $result || $result =~ /^0?$/ ) {
 308         $who     = $target;
 309         $msgType = 'private';
 310
 311         # support command redirection.
 312         # recursive cmdHooks aswell :)
 313         my $done = 0;
 314         $done++ if &parseCmdHook($tell_obj);
 315         $message = $tell_obj;
 316         $done++ unless ( &Modules() );
 317
 318         &VERB( 'tell: setting old values of who and msgType.', 2 );
 319         $who     = $oldwho;
 320         $msgType = $oldmtype;
 321
 322         if ($done) {
 323             &msg( $who, "told $target about CMD '$tell_obj'" );
 324         }
 325         else {
 326             &msg( $who, "i dunno what is '$tell_obj'." );
 327         }
 328
 329         return;
 330     }
 331
 332     # success.
 333     &status("tell: <$who> telling $target about $tell_obj.");
 334     if ( $who ne $target ) {
 335         if ($dont_tell_me) {
 336             &msg( $who, "told $target about $tell_obj." );
 337         }
 338         else {
 339             &msg( $who, "told $target about $tell_obj ($result)" );
 340         }
 341
 342         $reply = "$who wants you to know: $result";
 343     }
 344     else {
 345         $reply = "telling yourself: $result";
 346     }
 347
 348     &msg( $target, $reply );
 349 }
 350
 351 sub countryStats {
 352     if ( exists $cache{countryStats} ) {
 353         &msg( $who, 'countrystats is already running!' );
 354         return;
 355     }
 356
 357     if ( $chan eq '' ) {
 358         $chan = $_[0];
 359     }
 360
 361     if ( $chan eq '' ) {
 362         &help('countrystats');
 363         return;
 364     }
 365
 366     $conn->who($chan);
 367     $cache{countryStats}{chan}  = $chan;
 368     $cache{countryStats}{mtype} = $msgType;
 369     $cache{countryStats}{who}   = $who;
 370     $cache{on_who_Hack}         = 1;
 371 }
 372
 373 sub do_countrystats {
 374     $chan    = $cache{countryStats}{chan};
 375     $msgType = $cache{countryStats}{mtype};
 376     $who     = $cache{countryStats}{who};
 377
 378     my $total = 0;
 379     my %cstats;
 380     foreach ( keys %{ $cache{nuhInfo} } ) {
 381         my $h = $cache{nuhInfo}{$_}{Host};
 382
 383         if ( $h =~ /^.*\.(\D+)$/ ) {    # host
 384             $cstats{$1}++;
 385         }
 386         else {                          # ip
 387             $cstats{unresolve}++;
 388         }
 389         $total++;
 390     }
 391     my %count;
 392     foreach ( keys %cstats ) {
 393         $count{ $cstats{$_} }{$_} = 1;
 394     }
 395
 396     my @list;
 397     foreach ( sort { $b <=> $a } keys %count ) {
 398         my $str = join( ', ', sort keys %{ $count{$_} } );
 399
 400         #       push(@list, "$str ($_)");
 401         my $perc = sprintf( '%.01f', 100 * $_ / $total );
 402         $perc =~ s/\.0+$//;
 403         push( @list, "$str ($_, $perc %)" );
 404     }
 405
 406     # TODO: move this into a scheduler
 407     $msgType = 'private';
 408     &performStrictReply( &formListReply( 0, 'Country Stats ', @list ) );
 409
 410     delete $cache{countryStats};
 411     delete $cache{on_who_Hack};
 412 }
 413
 414 ###
 415 ### amalgamated commands.
 416 ###
 417
 418 sub userCommands {
 419
 420     # conversion: ascii.
 421     if ( $message =~ /^(asci*|chr) (\d+)$/ ) {
 422         &DEBUG('ascii/chr called ...');
 423         return unless ( &IsChanConfOrWarn('allowConv') );
 424
 425         &DEBUG('ascii/chr called');
 426
 427         $arg    = $2;
 428         $result = chr($arg);
 429         $result = 'NULL' if ( $arg == 0 );
 430
 431         &performReply( sprintf( "ascii %s is '%s'", $arg, $result ) );
 432
 433         return;
 434     }
 435
 436     # conversion: ord.
 437     if ( $message =~ /^ord(\s+(.*))$/ ) {
 438         return unless ( &IsChanConfOrWarn('allowConv') );
 439
 440         $arg = $2;
 441
 442         if ( !defined $arg or length $arg != 1 ) {
 443             &help('ord');
 444             return;
 445         }
 446
 447         if ( ord($arg) < 32 ) {
 448             $arg = chr( ord($arg) + 64 );
 449             if ( $arg eq chr(64) ) {
 450                 $arg = 'NULL';
 451             }
 452             else {
 453                 $arg = '^' . $arg;
 454             }
 455         }
 456
 457         &performReply( sprintf( "'%s' is ascii %s", $arg, ord $arg ) );
 458         return;
 459     }
 460
 461     # hex.
 462     if ( $message =~ /^hex(\s+(.*))?$/i ) {
 463         return unless ( &IsChanConfOrWarn('allowConv') );
 464         my $arg = $2;
 465
 466         if ( !defined $arg ) {
 467             &help('hex');
 468             return;
 469         }
 470
 471         if ( length $arg > 80 ) {
 472             &msg( $who, 'Too long.' );
 473             return;
 474         }
 475
 476         my $retval;
 477         foreach ( split //, $arg ) {
 478             $retval .= sprintf( ' %X', ord($_) );
 479         }
 480
 481         &performStrictReply("$arg is$retval");
 482
 483         return;
 484     }
 485
 486     # crypt.
 487     if ( $message =~ /^crypt\s+(\S*)?\s*(.*)?$/i ) {
 488         &status("crypt: $1:$2:$3");
 489         if ( "$2" ne '' ) {
 490             &performStrictReply( crypt( $2, $1 ) );
 491         }
 492         else {
 493             &performStrictReply( &mkcrypt($1) );
 494         }
 495         return;
 496     }
 497
 498     # cycle.
 499     if ( $message =~ /^(cycle)(\s+(\S+))?$/i ) {
 500         return unless ( &hasFlag('o') );
 501         my $chan = lc $3;
 502
 503         if ( $chan eq '' ) {
 504             if ( $msgType =~ /public/ ) {
 505                 $chan = $talkchannel;
 506                 &DEBUG("cycle: setting chan to '$chan'.");
 507             }
 508             else {
 509                 &help('cycle');
 510                 return;
 511             }
 512         }
 513
 514         if ( &validChan($chan) == 0 ) {
 515             &msg( $who, "error: invalid channel \002$chan\002" );
 516             return;
 517         }
 518
 519         &msg( $chan, "I'm coming back. (courtesy of $who)" );
 520         &part($chan);
 521 ###     &ScheduleThis(5, 'getNickInUse') if (@_);
 522         &status("Schedule rejoin in 5secs to $chan by $who.");
 523         $conn->schedule( 5, sub { &joinchan($chan); } );
 524
 525         return;
 526     }
 527
 528     # reload.
 529     if ( $message =~ /^reload$/i ) {
 530         return unless ( &hasFlag('n') );
 531
 532         &status("USER reload $who");
 533         &performStrictReply('reloading...');
 534         &readUserFile();
 535         &readChanFile();
 536         my $modules = &reloadAllModules();
 537         &performStrictReply("reloaded:$modules");
 538         return;
 539     }
 540
 541     # redir.
 542     if ( $message =~ /^redir(\s+(.*))?/i ) {
 543         return unless ( &hasFlag('o') );
 544         my $factoid = $2;
 545
 546         if ( !defined $factoid ) {
 547             &help('redir');
 548             return;
 549         }
 550
 551         my $val = &getFactInfo( $factoid, 'factoid_value' );
 552         if ( !defined $val or $val eq '' ) {
 553             &msg( $who, "error: '$factoid' does not exist." );
 554             return;
 555         }
 556         &DEBUG("val => '$val'.");
 557         my @list =
 558           &searchTable( 'factoids', 'factoid_key', 'factoid_value', "^$val\$" );
 559
 560         if ( scalar @list == 1 ) {
 561             &msg( $who, "hrm... '$factoid' is unique." );
 562             return;
 563         }
 564         if ( scalar @list > 5 ) {
 565             &msg( $who, 'A bit too many factoids to be redirected, hey?' );
 566             return;
 567         }
 568
 569         my @redir;
 570         &status( "Redirect '$factoid' (" . ($#list) . ')...' );
 571         for (@list) {
 572             my $x = $_;
 573             next if (/^\Q$factoid\E$/i);
 574
 575             &status("  Redirecting '$_'.");
 576             my $was = &getFactoid($_);
 577             if ( $was =~ /<REPLY> see/i ) {
 578                 &status('warn: not redirecting a redirection.');
 579                 next;
 580             }
 581
 582             &DEBUG("  was '$was'.");
 583             push( @redir, $x );
 584             &setFactInfo( $x, 'factoid_value', "<REPLY> see $factoid" );
 585         }
 586         &status('Done.');
 587
 588         &msg( $who,
 589             &formListReply( 0, "'$factoid' is redirected to by '", @redir ) );
 590
 591         return;
 592     }
 593
 594     # rot13 it.
 595     if ( $message =~ /^rot([0-9]*)(\s+(.*))?/i ) {
 596         my $reply = $3;
 597
 598         if ( !defined $reply ) {
 599             &help('rot13');
 600             return;
 601         }
 602         my $num   = $1 % 26;
 603         my $upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
 604         my $lower = 'abcdefghijklmnopqrstuvwxyz';
 605         my $to =
 606             substr( $upper, $num )
 607           . substr( $upper, 0, $num )
 608           . substr( $lower, $num )
 609           . substr( $lower, 0, $num );
 610         eval "\$reply =~ tr/$upper$lower/$to/;";
 611
 612         #$reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
 613         &performStrictReply($reply);
 614
 615         return;
 616     }
 617
 618     # cpustats.
 619     if ( $message =~ /^cpustats$/i ) {
 620         if ( $^O !~ /linux/ ) {
 621             &ERROR('cpustats: your OS is not supported yet.');
 622             return;
 623         }
 624
 625         ### poor method to get info out of file, please fix.
 626         open( STAT, "/proc/$$/stat" );
 627         my $line = <STAT>;
 628         chop $line;
 629         my @data = split( / /, $line );
 630         close STAT;
 631
 632         # utime(13) + stime(14).
 633         my $cpu_usage = sprintf( '%.01f', ( $data[13] + $data[14] ) / 100 );
 634
 635         # cutime(15) + cstime (16).
 636         my $cpu_usage2 = sprintf( '%.01f', ( $data[15] + $data[16] ) / 100 );
 637         my $time       = time() - $^T;
 638         my $raw_perc   = $cpu_usage * 100 / $time;
 639         my $raw_perc2  = $cpu_usage2 * 100 / $time;
 640         my $perc;
 641         my $perc2;
 642         my $total;
 643         my $ratio;
 644
 645         if ( $raw_perc > 1 ) {
 646             $perc  = sprintf( '%.01f', $raw_perc );
 647             $perc2 = sprintf( '%.01f', $raw_perc2 );
 648             $total = sprintf( '%.01f', $raw_perc + $raw_perc2 );
 649         }
 650         elsif ( $raw_perc > 0.1 ) {
 651             $perc  = sprintf( '%.02f', $raw_perc );
 652             $perc2 = sprintf( '%.02f', $raw_perc2 );
 653             $total = sprintf( '%.02f', $raw_perc + $raw_perc2 );
 654         }
 655         else {    # <=0.1
 656             $perc  = sprintf( '%.03f', $raw_perc );
 657             $perc2 = sprintf( '%.03f', $raw_perc2 );
 658             $total = sprintf( '%.03f', $raw_perc + $raw_perc2 );
 659         }
 660         $ratio = sprintf( '%.01f', 100 * $perc / ( $perc + $perc2 ) );
 661
 662         &performStrictReply( "Total CPU usage: \002$cpu_usage\002 s ... "
 663               . "Total used: \002$total\002 % "
 664               . "(parent/child ratio: $ratio %)" );
 665
 666         return;
 667     }
 668
 669     # ircstats.
 670     if ( $message =~ /^ircstats?$/i ) {
 671         $ircstats{'TotalTime'} ||= 0;
 672         $ircstats{'OffTime'}   ||= 0;
 673
 674         my $count       = $ircstats{'ConnectCount'};
 675         my $format_time = &Time2String( time() - $ircstats{'ConnectTime'} );
 676         my $total_time =
 677           time() - $ircstats{'ConnectTime'} + $ircstats{'TotalTime'};
 678         my $reply;
 679
 680         my $connectivity =
 681           100 * ( $total_time - $ircstats{'OffTime'} ) / $total_time;
 682         my $p = sprintf( '%.03f', $connectivity );
 683         $p =~ s/(\.\d*)0+$/$1/;
 684         if ( $p =~ s/\.0$// ) {
 685
 686             # this should not happen... but why...
 687         }
 688         else {
 689             $p =~ s/\.$//;
 690         }
 691
 692         if ( $total_time != ( time() - $ircstats{'ConnectTime'} ) ) {
 693             my $tt_format = &Time2String($total_time);
 694             &DEBUG("tt_format => $tt_format");
 695         }
 696
 697         ### RECONNECT COUNT.
 698         if ( $count == 1 ) {    # good.
 699             $reply =
 700                 "I'm connected to $ircstats{'Server'} and have been so"
 701               . " for $format_time";
 702         }
 703         else {
 704             $reply =
 705                 "Currently I'm hooked up to $ircstats{'Server'} but only"
 706               . " for $format_time.  "
 707               . "I had to reconnect \002$count\002 times."
 708               . "   Connectivity: $p %";
 709         }
 710
 711         ### REASON.
 712         my $reason = $ircstats{'DisconnectReason'};
 713         if ( defined $reason ) {
 714             $reply .= ".  I was last disconnected for '$reason'.";
 715         }
 716
 717         &performStrictReply($reply);
 718
 719         return;
 720     }
 721
 722     # status.
 723     if ( $message =~ /^statu?s$/i ) {
 724         my $startString = scalar( gmtime $^T );
 725         my $upString    = &Time2String( time() - $^T );
 726         my ( $puser, $psystem, $cuser, $csystem ) = times;
 727         my $factoids = &countKeys('factoids');
 728         my $forks    = 0;
 729         foreach ( keys %forked ) {
 730             $forks += scalar keys %{ $forked{$_} };
 731         }
 732         $forks /= 2;
 733         $count{'Commands'} = 0;
 734         foreach ( keys %cmdstats ) {
 735             $count{'Commands'} += $cmdstats{$_};
 736         }
 737
 738         &performStrictReply( "Since $startString, there have been"
 739               . " \002$count{'Update'}\002 "
 740               . &fixPlural( 'modification', $count{'Update'} )
 741               . ", \002$count{'Question'}\002 "
 742               . &fixPlural( 'question', $count{'Question'} )
 743               . ", \002$count{'Dunno'}\002 "
 744               . &fixPlural( 'dunno', $count{'Dunno'} )
 745               . ", \002$count{'Moron'}\002 "
 746               . &fixPlural( 'moron', $count{'Moron'} )
 747               . " and \002$count{'Commands'}\002 "
 748               . &fixPlural( 'command', $count{'Commands'} )
 749               . ".  I have been awake for $upString this session, and "
 750               . "currently reference \002$factoids\002 factoids.  "
 751               . "I'm using about \002$memusage\002 "
 752               . "kB of memory. With \002$forks\002 active "
 753               . &fixPlural( 'fork', $forks )
 754               . ". Process time user/system $puser/$psystem child $cuser/$csystem"
 755         );
 756
 757         return;
 758     }
 759
 760     # wantNick. xk++
 761     # FIXME does not try to get nick 'back', just switches nicks
 762     if ( $message =~ /^wantNick\s(.*)?$/i ) {
 763         return unless ( &hasFlag('o') );
 764         my $wantnick = lc $1;
 765         my $mynick   = $conn->nick();
 766
 767         if ( $mynick eq $wantnick ) {
 768             &msg( $who,
 769 "I hope you're right. I'll try anyway (mynick=$mynick, wantnick=$wantnick)."
 770             );
 771         }
 772
 773         # fallback check, I guess.  needed?
 774         if ( !&IsNickInAnyChan($wantnick) ) {
 775             my $str = "attempting to change nick from $mynick to $wantnick";
 776             &status($str);
 777             &msg( $who, $str );
 778             &nick($wantnick);
 779             return;
 780         }
 781
 782         # idea from dondelecarlo :)
 783         # TODO: use cache{nickserv}
 784         if ( $param{'nickServ_pass'} ) {
 785             my $str = "someone is using nick $wantnick; GHOSTing";
 786             &status($str);
 787             &msg( $who, $str );
 788             &msg( 'NickServ', "GHOST $wantnick $param{'nickServ_pass'}" );
 789
 790             $conn->schedule(
 791                 5,
 792                 sub {
 793                     &status(
 794 "going to change nick from $mynick to $wantnick after GHOST."
 795                     );
 796                     &nick($wantnick);
 797                 }
 798             );
 799
 800             return;
 801         }
 802
 803         return;
 804     }
 805
 806     return 'CONTINUE';
 807 }
 808
 809 1;
 810
 811 # vim:ts=4:sw=4:expandtab:tw=80