2 # UserExtra.pl: User Commands, Public.
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);
12 ### hooks get added in CommandHooks.pl.
15 ### Start of commands for hooks.
19 my $chan = lc shift(@_);
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.
31 foreach ( keys %channels ) {
32 if ( /^\s*$/ or / / ) {
33 &status('chanstats: fe channels: chan == NULL.');
38 next if (/^_default$/);
40 $chans{$_} = scalar( keys %{ $channels{$_}{''} } );
42 foreach $chan ( sort { $chans{$b} <=> $chans{$a} } keys %chans ) {
43 push( @array, "$chan/" . $chans{$chan} );
45 &performStrictReply( $reply . ': ' . join( ', ', @array ) );
48 foreach $chan ( keys %channels ) {
49 $tucount += scalar( keys %{ $channels{$chan}{''} } );
52 ### unique user count.
54 foreach $chan ( keys %channels ) {
56 foreach $nick ( keys %{ $channels{$chan}{''} } ) {
60 $uucount = scalar( keys %nicks );
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 )
77 if ( &validChan($chan) == 0 ) {
78 &msg( $who, "error: invalid channel \002$chan\002" );
84 foreach ( sort keys %{ $chanstats{$chan} } ) {
85 my $int = $chanstats{$chan}{$_};
88 push( @array, "\002$int\002 " . &fixPlural( $_, $int ) );
91 "On \002$chan\002, there "
92 . &fixPlural( 'has', scalar(@array) )
96 # Step 1b: check channel inconstencies.
97 $chanstats{$chan}{'Join'} ||= 0;
98 $chanstats{$chan}{'SignOff'} ||= 0;
99 $chanstats{$chan}{'Part'} ||= 0;
101 my $delta_stats = $chanstats{$chan}{'Join'} - $chanstats{$chan}{'SignOff'} -
102 $chanstats{$chan}{'Part'};
105 my $total = scalar( keys %{ $channels{$chan}{''} } );
107 "chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."
110 if ( $delta_stats > $total ) {
111 &ERROR('chaninfo: delta_stats exceeds total users.');
118 foreach ( 'v', 'o', '' ) {
119 my $int = scalar( keys %{ $channels{$chan}{$_} } );
122 $type = 'Voice' if ( $_ eq 'v' );
123 $type = 'Opped' if ( $_ eq 'o' );
124 $type = 'Total' if ( $_ eq '' );
126 push( @array, "\002$int\002 $type" );
128 $reply .= '. At the moment, ' . &IJoin(@array);
132 foreach ( keys %userstats ) {
133 next unless ( exists $userstats{$_}{'Count'} );
134 if ( $userstats{$_}{'Count'} =~ /^\D+$/ ) {
135 &WARN("userstats{$_}{Count} is non-digit.");
139 $new{$_} = $userstats{$_}{'Count'};
142 # TODO: show top 3 with percentages?
143 my ($count) = ( sort { $new{$b} <=> $new{$a} } keys %new )[0];
146 ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages";
148 &performStrictReply("$reply.");
151 # Command statistics.
155 if ( !scalar( keys %cmdstats ) ) {
156 &performReply('no-one has run any commands yet');
161 foreach ( keys %cmdstats ) {
162 $countstats{ $cmdstats{$_} }{$_} = 1;
165 foreach ( sort { $b <=> $a } keys %countstats ) {
169 foreach ( keys %{ $countstats{$int} } ) {
170 push( @array, "\002$int\002 of $_" );
173 &performStrictReply( 'command usage includes ' . &IJoin(@array) . '.' );
176 # Command statistics.
178 my $reply = 'conninfo:';
180 foreach $key ( sort keys %::conns ) {
181 my $myconn = $::conns{$key};
183 next if (!defined $myconn);
184 my $mynick = $myconn->nick();
187 &performStrictReply( "conninfo: $reply.");
190 # Factoid extension info. xk++
192 my $faqtoid = lc shift(@_);
195 if ( $faqtoid =~ /^\-(\S+)(\s+(.*))$/ ) {
197 'error: individual factoid info queries not supported as yet.' );
199 "it's possible that the factoid mistakenly begins with '-'." );
206 &CmdFactInfo( $faqtoid, $query );
210 my $type = shift(@_);
215 &performStrictReply( &CmdFactStats($type) );
221 my $target = lc( shift || $who );
223 &sqlSelect( 'stats', 'counter', { nick => $target, type => 'karma' } )
227 &performStrictReply("$target has karma of $karma");
230 &performStrictReply("$target has neutral karma");
236 my ( $target, $tell_obj ) = ( '', '' );
237 my $dont_tell_me = 0;
240 ### is this fixed elsewhere?
241 $args =~ s/\s+/ /g; # fix up spaces.
242 $args =~ s/^\s+|\s+$//g; # again.
244 # this one catches most of them
245 if ( $args =~ /^(\S+) (-?)about (.*)$/i ) {
248 $dont_tell_me = ($2) ? 1 : 0;
250 $tell_obj = $who if ( $tell_obj =~ /^(me|myself)$/i );
253 elsif ( $args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i ) {
255 # i'm sure this could all be nicely collapsed
261 elsif ( $args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i ) {
266 $query = "$qWord $verb $tell_obj";
269 elsif ( $args =~ /^(.*?) to (\S+)$/i ) {
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?)" );
281 $target = $talkchannel if ( $target =~ /^us$/i );
282 $target = $who if ( $target =~ /^(me|myself)$/i );
284 &status("tell: target = $target, query = $query");
287 # if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
288 # &msg($who, "No, $target is not in any of my chans.");
293 if ( $target =~ /^\Q$ident\E$/i ) {
294 &msg( $who, "Isn't that a bit silly?" );
299 my $oldmtype = $msgType;
301 my $result = &doQuestion($tell_obj);
303 # ^ returns '0' if nothing was found.
307 if ( !defined $result || $result =~ /^0?$/ ) {
309 $msgType = 'private';
311 # support command redirection.
312 # recursive cmdHooks aswell :)
314 $done++ if &parseCmdHook($tell_obj);
315 $message = $tell_obj;
316 $done++ unless ( &Modules() );
318 &VERB( 'tell: setting old values of who and msgType.', 2 );
320 $msgType = $oldmtype;
323 &msg( $who, "told $target about CMD '$tell_obj'" );
326 &msg( $who, "i dunno what is '$tell_obj'." );
333 &status("tell: <$who> telling $target about $tell_obj.");
334 if ( $who ne $target ) {
336 &msg( $who, "told $target about $tell_obj." );
339 &msg( $who, "told $target about $tell_obj ($result)" );
342 $reply = "$who wants you to know: $result";
345 $reply = "telling yourself: $result";
348 &msg( $target, $reply );
352 if ( exists $cache{countryStats} ) {
353 &msg( $who, 'countrystats is already running!' );
362 &help('countrystats');
367 $cache{countryStats}{chan} = $chan;
368 $cache{countryStats}{mtype} = $msgType;
369 $cache{countryStats}{who} = $who;
370 $cache{on_who_Hack} = 1;
373 sub do_countrystats {
374 $chan = $cache{countryStats}{chan};
375 $msgType = $cache{countryStats}{mtype};
376 $who = $cache{countryStats}{who};
380 foreach ( keys %{ $cache{nuhInfo} } ) {
381 my $h = $cache{nuhInfo}{$_}{Host};
383 if ( $h =~ /^.*\.(\D+)$/ ) { # host
387 $cstats{unresolve}++;
392 foreach ( keys %cstats ) {
393 $count{ $cstats{$_} }{$_} = 1;
397 foreach ( sort { $b <=> $a } keys %count ) {
398 my $str = join( ', ', sort keys %{ $count{$_} } );
400 # push(@list, "$str ($_)");
401 my $perc = sprintf( '%.01f', 100 * $_ / $total );
403 push( @list, "$str ($_, $perc %)" );
406 # TODO: move this into a scheduler
407 $msgType = 'private';
408 &performStrictReply( &formListReply( 0, 'Country Stats ', @list ) );
410 delete $cache{countryStats};
411 delete $cache{on_who_Hack};
415 ### amalgamated commands.
421 if ( $message =~ /^(asci*|chr) (\d+)$/ ) {
422 &DEBUG('ascii/chr called ...');
423 return unless ( &IsChanConfOrWarn('allowConv') );
425 &DEBUG('ascii/chr called');
429 $result = 'NULL' if ( $arg == 0 );
431 &performReply( sprintf( "ascii %s is '%s'", $arg, $result ) );
437 if ( $message =~ /^ord(\s+(.*))$/ ) {
438 return unless ( &IsChanConfOrWarn('allowConv') );
442 if ( !defined $arg or length $arg != 1 ) {
447 if ( ord($arg) < 32 ) {
448 $arg = chr( ord($arg) + 64 );
449 if ( $arg eq chr(64) ) {
457 &performReply( sprintf( "'%s' is ascii %s", $arg, ord $arg ) );
462 if ( $message =~ /^hex(\s+(.*))?$/i ) {
463 return unless ( &IsChanConfOrWarn('allowConv') );
466 if ( !defined $arg ) {
471 if ( length $arg > 80 ) {
472 &msg( $who, 'Too long.' );
477 foreach ( split //, $arg ) {
478 $retval .= sprintf( ' %X', ord($_) );
481 &performStrictReply("$arg is$retval");
487 if ( $message =~ /^crypt\s+(\S*)?\s*(.*)?$/i ) {
488 &status("crypt: $1:$2:$3");
490 &performStrictReply( crypt( $2, $1 ) );
493 &performStrictReply( &mkcrypt($1) );
499 if ( $message =~ /^(cycle)(\s+(\S+))?$/i ) {
500 return unless ( &hasFlag('o') );
504 if ( $msgType =~ /public/ ) {
505 $chan = $talkchannel;
506 &DEBUG("cycle: setting chan to '$chan'.");
514 if ( &validChan($chan) == 0 ) {
515 &msg( $who, "error: invalid channel \002$chan\002" );
519 &msg( $chan, "I'm coming back. (courtesy of $who)" );
521 ### &ScheduleThis(5, 'getNickInUse') if (@_);
522 &status("Schedule rejoin in 5secs to $chan by $who.");
523 $conn->schedule( 5, sub { &joinchan($chan); } );
529 if ( $message =~ /^reload$/i ) {
530 return unless ( &hasFlag('n') );
532 &status("USER reload $who");
533 &performStrictReply('reloading...');
536 my $modules = &reloadAllModules();
537 &performStrictReply("reloaded:$modules");
542 if ( $message =~ /^redir(\s+(.*))?/i ) {
543 return unless ( &hasFlag('o') );
546 if ( !defined $factoid ) {
551 my $val = &getFactInfo( $factoid, 'factoid_value' );
552 if ( !defined $val or $val eq '' ) {
553 &msg( $who, "error: '$factoid' does not exist." );
556 &DEBUG("val => '$val'.");
558 &searchTable( 'factoids', 'factoid_key', 'factoid_value', "^$val\$" );
560 if ( scalar @list == 1 ) {
561 &msg( $who, "hrm... '$factoid' is unique." );
564 if ( scalar @list > 5 ) {
565 &msg( $who, 'A bit too many factoids to be redirected, hey?' );
570 &status( "Redirect '$factoid' (" . ($#list) . ')...' );
573 next if (/^\Q$factoid\E$/i);
575 &status(" Redirecting '$_'.");
576 my $was = &getFactoid($_);
577 if ( $was =~ /<REPLY> see/i ) {
578 &status('warn: not redirecting a redirection.');
582 &DEBUG(" was '$was'.");
584 &setFactInfo( $x, 'factoid_value', "<REPLY> see $factoid" );
589 &formListReply( 0, "'$factoid' is redirected to by '", @redir ) );
595 if ( $message =~ /^rot([0-9]*)(\s+(.*))?/i ) {
598 if ( !defined $reply ) {
603 my $upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
604 my $lower = 'abcdefghijklmnopqrstuvwxyz';
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/;";
612 #$reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
613 &performStrictReply($reply);
619 if ( $message =~ /^cpustats$/i ) {
620 if ( $^O !~ /linux/ ) {
621 &ERROR('cpustats: your OS is not supported yet.');
625 ### poor method to get info out of file, please fix.
626 open( STAT, "/proc/$$/stat" );
629 my @data = split( / /, $line );
632 # utime(13) + stime(14).
633 my $cpu_usage = sprintf( '%.01f', ( $data[13] + $data[14] ) / 100 );
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;
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 );
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 );
656 $perc = sprintf( '%.03f', $raw_perc );
657 $perc2 = sprintf( '%.03f', $raw_perc2 );
658 $total = sprintf( '%.03f', $raw_perc + $raw_perc2 );
660 $ratio = sprintf( '%.01f', 100 * $perc / ( $perc + $perc2 ) );
662 &performStrictReply( "Total CPU usage: \002$cpu_usage\002 s ... "
663 . "Total used: \002$total\002 % "
664 . "(parent/child ratio: $ratio %)" );
670 if ( $message =~ /^ircstats?$/i ) {
671 $ircstats{'TotalTime'} ||= 0;
672 $ircstats{'OffTime'} ||= 0;
674 my $count = $ircstats{'ConnectCount'};
675 my $format_time = &Time2String( time() - $ircstats{'ConnectTime'} );
677 time() - $ircstats{'ConnectTime'} + $ircstats{'TotalTime'};
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$// ) {
686 # this should not happen... but why...
692 if ( $total_time != ( time() - $ircstats{'ConnectTime'} ) ) {
693 my $tt_format = &Time2String($total_time);
694 &DEBUG("tt_format => $tt_format");
698 if ( $count == 1 ) { # good.
700 "I'm connected to $ircstats{'Server'} and have been so"
701 . " for $format_time";
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 %";
712 my $reason = $ircstats{'DisconnectReason'};
713 if ( defined $reason ) {
714 $reply .= ". I was last disconnected for '$reason'.";
717 &performStrictReply($reply);
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');
729 foreach ( keys %forked ) {
730 $forks += scalar keys %{ $forked{$_} };
733 $count{'Commands'} = 0;
734 foreach ( keys %cmdstats ) {
735 $count{'Commands'} += $cmdstats{$_};
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"
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();
767 if ( $mynick eq $wantnick ) {
769 "I hope you're right. I'll try anyway (mynick=$mynick, wantnick=$wantnick)."
773 # fallback check, I guess. needed?
774 if ( !&IsNickInAnyChan($wantnick) ) {
775 my $str = "attempting to change nick from $mynick to $wantnick";
782 # idea from dondelecarlo :)
783 # TODO: use cache{nickserv}
784 if ( $param{'nickServ_pass'} ) {
785 my $str = "someone is using nick $wantnick; GHOSTing";
788 &msg( 'NickServ', "GHOST $wantnick $param{'nickServ_pass'}" );
794 "going to change nick from $mynick to $wantnick after GHOST."
811 # vim:ts=4:sw=4:expandtab:tw=80