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.");
37 next if (/^_default$/);
39 $chans{$_} = scalar(keys %{ $channels{$_}{''} });
40 #my $str = sprintf("%s/%d", $_, scalar(keys %{ $channels{$_}{''} }));
43 foreach $chan (sort {$chans{$b} <=> $chans{$a}} keys %chans) {
44 push(@array, "$chan/" . $chans{$chan});
46 &performStrictReply($reply.": ".join(', ', @array));
49 foreach $chan (keys %channels) {
50 $tucount += scalar(keys %{ $channels{$chan}{''} });
53 ### unique user count.
55 foreach $chan (keys %channels) {
57 foreach $nick (keys %{ $channels{$chan}{''} }) {
61 $uucount = scalar(keys %nicks);
63 my $chans = scalar(keys %channels);
65 "i've cached \002$tucount\002 ". &fixPlural("user",$tucount).
66 ", \002$uucount\002 unique ". &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));
90 my $reply = "On \002$chan\002, there ".
91 &fixPlural("has",scalar(@array)). " been ".
94 # Step 1b: check channel inconstencies.
95 $chanstats{$chan}{'Join'} ||= 0;
96 $chanstats{$chan}{'SignOff'} ||= 0;
97 $chanstats{$chan}{'Part'} ||= 0;
99 my $delta_stats = $chanstats{$chan}{'Join'}
100 - $chanstats{$chan}{'SignOff'}
101 - $chanstats{$chan}{'Part'};
104 my $total = scalar(keys %{ $channels{$chan}{''} });
105 &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total).");
107 if ($delta_stats > $total) {
108 &ERROR("chaninfo: delta_stats exceeds total users.");
115 foreach ("v","o","") {
116 my $int = scalar(keys %{ $channels{$chan}{$_} });
119 $type = "Voice" if ($_ eq "v");
120 $type = "Opped" if ($_ eq "o");
121 $type = "Total" if ($_ eq "");
123 push(@array,"\002$int\002 $type");
125 $reply .= ". At the moment, ". &IJoin(@array);
129 foreach (keys %userstats) {
130 next unless (exists $userstats{$_}{'Count'});
131 if ($userstats{$_}{'Count'} =~ /^\D+$/) {
132 &WARN("userstats{$_}{Count} is non-digit.");
136 $new{$_} = $userstats{$_}{'Count'};
139 # TODO: show top 3 with percentages?
140 my($count) = (sort { $new{$b} <=> $new{$a} } keys %new)[0];
142 $reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages";
144 &performStrictReply("$reply.");
147 # Command statistics.
151 if (!scalar(keys %cmdstats)) {
152 &performReply("no-one has run any commands yet");
157 foreach (keys %cmdstats) {
158 $countstats{ $cmdstats{$_} }{$_} = 1;
161 foreach (sort {$b <=> $a} keys %countstats) {
165 foreach (keys %{ $countstats{$int} }) {
166 push(@array, "\002$int\002 of $_");
169 &performStrictReply("command usage include ". &IJoin(@array).".");
172 # Factoid extension info. xk++
174 my $faqtoid = lc shift(@_);
177 if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) {
178 &msg($who,"error: individual factoid info queries not supported as yet.");
179 &msg($who,"it's possible that the factoid mistakenly begins with '-'.");
186 &CmdFactInfo($faqtoid, $query);
190 my $type = shift(@_);
192 &Forker("Factoids", sub {
193 &performStrictReply( &CmdFactStats($type) );
198 my $target = lc( shift || $who );
199 my $karma = &sqlSelect("stats", "counter",
200 { nick => $target, type => "karma", channel => $chan }) || 0;
203 &performStrictReply("$target has karma of $karma");
205 &performStrictReply("$target has neutral karma");
211 my ($target, $tell_obj) = ('','');
212 my $dont_tell_me = 0;
215 ### is this fixed elsewhere?
216 $args =~ s/\s+/ /g; # fix up spaces.
217 $args =~ s/^\s+|\s+$//g; # again.
219 # this one catches most of them
220 if ($args =~ /^(\S+) (-?)about (.*)$/i) {
223 $dont_tell_me = ($2) ? 1 : 0;
225 $tell_obj = $who if ($tell_obj =~ /^(me|myself)$/i);
227 } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) {
228 # i'm sure this could all be nicely collapsed
233 } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) {
238 $query = "$qWord $verb $tell_obj";
240 } elsif ($args =~ /^(.*?) to (\S+)$/i) {
246 # check target type. Deny channel targets.
247 if ($target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/) {
248 &msg($who,"No, $who, I won't. (target invalid?)");
252 $target = $talkchannel if ($target =~ /^us$/i);
253 $target = $who if ($target =~ /^(me|myself)$/i);
255 &status("tell: target = $target, query = $query");
258 # if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
259 # &msg($who, "No, $target is not in any of my chans.");
264 if ($target =~ /^\Q$ident\E$/i) {
265 &msg($who, "Isn't that a bit silly?");
270 my $oldmtype = $msgType;
272 my $result = &doQuestion($tell_obj);
273 # ^ returns '0' if nothing was found.
277 if (!defined $result || $result =~ /^0?$/) {
279 $msgType = "private";
281 # support command redirection.
282 # recursive cmdHooks aswell :)
284 $done++ if &parseCmdHook($tell_obj);
285 $message = $tell_obj;
286 $done++ unless (&Modules());
288 &VERB("tell: setting old values of who and msgType.",2);
290 $msgType = $oldmtype;
293 &msg($who, "told $target about CMD '$tell_obj'");
295 &msg($who, "i dunno what is '$tell_obj'.");
302 &status("tell: <$who> telling $target about $tell_obj.");
303 if ($who ne $target) {
305 &msg($who, "told $target about $tell_obj.");
307 &msg($who, "told $target about $tell_obj ($result)");
310 $reply = "$who wants you to know: $result";
312 $reply = "telling yourself: $result";
315 &msg($target, $reply);
319 if (exists $cache{countryStats}) {
320 &msg($who,"countrystats is already running!");
329 &help("countrystats");
334 $cache{countryStats}{chan} = $chan;
335 $cache{countryStats}{mtype} = $msgType;
336 $cache{countryStats}{who} = $who;
337 $cache{on_who_Hack} = 1;
340 sub do_countrystats {
341 $chan = $cache{countryStats}{chan};
342 $msgType = $cache{countryStats}{mtype};
343 $who = $cache{countryStats}{who};
347 foreach (keys %{ $cache{nuhInfo} }) {
348 my $h = $cache{nuhInfo}{$_}{Host};
350 if ($h =~ /^.*\.(\D+)$/) { # host
353 $cstats{unresolve}++;
358 foreach (keys %cstats) {
359 $count{ $cstats{$_} }{$_} = 1;
363 foreach (sort {$b <=> $a} keys %count) {
364 my $str = join(", ", sort keys %{ $count{$_} });
365 # push(@list, "$str ($_)");
366 my $perc = sprintf("%.01f", 100 * $_ / $total);
368 push(@list, "$str ($_, $perc %)");
371 # TODO: move this into a scheduler
372 $msgType = "private";
373 &performStrictReply( &formListReply(0, "Country Stats ", @list) );
375 delete $cache{countryStats};
376 delete $cache{on_who_Hack};
380 ### amalgamated commands.
385 if ($message =~ /^(asci*|chr) (\d+)$/) {
386 &DEBUG("ascii/chr called ...");
387 return unless (&IsChanConfOrWarn("allowConv"));
389 &DEBUG("ascii/chr called");
393 $result = "NULL" if ($arg == 0);
395 &performReply( sprintf("ascii %s is '%s'", $arg, $result) );
401 if ($message =~ /^ord(\s+(.*))$/) {
402 return unless (&IsChanConfOrWarn("allowConv"));
406 if (!defined $arg or length $arg != 1) {
411 if (ord($arg) < 32) {
412 $arg = chr(ord($arg) + 64);
413 if ($arg eq chr(64)) {
420 &performReply( sprintf("'%s' is ascii %s", $arg, ord $arg) );
425 if ($message =~ /^hex(\s+(.*))?$/i) {
426 return unless (&IsChanConfOrWarn("allowConv"));
434 if (length $arg > 80) {
435 &msg($who, "Too long.");
440 foreach (split //, $arg) {
441 $retval .= sprintf(" %X", ord($_));
444 &performStrictReply("$arg is$retval");
450 if ($message =~ /^crypt\s+(\S*)?\s*(.*)?$/i) {
451 &status("crypt: $1:$2:$3");
453 &performStrictReply(crypt($2, $1));
455 &performStrictReply(&mkcrypt($1));
461 if ($message =~ /^(cycle)(\s+(\S+))?$/i) {
462 return unless (&hasFlag("o"));
466 if ($msgType =~ /public/) {
467 $chan = $talkchannel;
468 &DEBUG("cycle: setting chan to '$chan'.");
475 if (&validChan($chan) == 0) {
476 &msg($who,"error: invalid channel \002$chan\002");
480 &msg($chan, "I'm coming back. (courtesy of $who)");
482 ### &ScheduleThis(5, "getNickInUse") if (@_);
483 &status("Schedule rejoin in 5secs to $chan by $who.");
484 $conn->schedule(5, sub { &joinchan($chan); });
490 if ($message =~ /^reload$/i) {
491 return unless (&hasFlag("n"));
493 &status("USER reload $who");
494 &performStrictReply("reloading...");
495 my $modules = &reloadAllModules();
496 &performStrictReply("reloaded:$modules");
501 if ($message =~ /^redir(\s+(.*))?/i) {
502 return unless (&hasFlag("o"));
505 if (!defined $factoid) {
510 my $val = &getFactInfo($factoid, "factoid_value");
511 if (!defined $val or $val eq "") {
512 &msg($who, "error: '$factoid' does not exist.");
515 &DEBUG("val => '$val'.");
516 my @list = &searchTable("factoids", "factoid_key",
517 "factoid_value", "^$val\$");
519 if (scalar @list == 1) {
520 &msg($who, "hrm... '$factoid' is unique.");
523 if (scalar @list > 5) {
524 &msg($who, "A bit too many factoids to be redirected, hey?");
529 &status("Redirect '$factoid' (". ($#list) .")...");
532 next if (/^\Q$factoid\E$/i);
534 &status(" Redirecting '$_'.");
535 my $was = &getFactoid($_);
536 if ($was =~ /<REPLY> see/i) {
537 &status("warn: not redirecting a redirection.");
541 &DEBUG(" was '$was'.");
543 &setFactInfo($x, "factoid_value", "<REPLY> see $factoid");
547 &msg($who, &formListReply(0, "'$factoid' is redirected to by '", @redir));
553 if ($message =~ /^rot([0-9]*)(\s+(.*))?/i) {
556 if (!defined $reply) {
561 my $upper="ABCDEFGHIJKLMNOPQRSTUVWXYZ";
562 my $lower="abcdefghijklmnopqrstuvwxyz";
563 my $to=substr($upper,$num).substr($upper,0,$num).substr($lower,$num).substr($lower,0,$num);
564 eval "\$reply =~ tr/$upper$lower/$to/;";
566 #$reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
567 &performStrictReply($reply);
573 if ($message =~ /^cpustats$/i) {
574 if ($^O !~ /linux/) {
575 &ERROR("cpustats: your OS is not supported yet.");
579 ### poor method to get info out of file, please fix.
580 open(STAT,"/proc/$$/stat");
583 my @data = split(/ /, $line);
586 # utime(13) + stime(14).
587 my $cpu_usage = sprintf("%.01f", ($data[13]+$data[14]) / 100 );
588 # cutime(15) + cstime (16).
589 my $cpu_usage2 = sprintf("%.01f", ($data[15]+$data[16]) / 100 );
590 my $time = time() - $^T;
591 my $raw_perc = $cpu_usage*100/$time;
592 my $raw_perc2 = $cpu_usage2*100/$time;
599 $perc = sprintf("%.01f", $raw_perc);
600 $perc2 = sprintf("%.01f", $raw_perc2);
601 $total = sprintf("%.01f", $raw_perc+$raw_perc2);
602 } elsif ($raw_perc > 0.1) {
603 $perc = sprintf("%.02f", $raw_perc);
604 $perc2 = sprintf("%.02f", $raw_perc2);
605 $total = sprintf("%.02f", $raw_perc+$raw_perc2);
607 $perc = sprintf("%.03f", $raw_perc);
608 $perc2 = sprintf("%.03f", $raw_perc2);
609 $total = sprintf("%.03f", $raw_perc+$raw_perc2);
611 $ratio = sprintf("%.01f", 100*$perc/($perc+$perc2) );
613 &performStrictReply("Total CPU usage: \002$cpu_usage\002 s ... ".
614 "Total used: \002$total\002 % ".
615 "(parent/child ratio: $ratio %)"
622 if ($message =~ /^ircstats?$/i) {
623 $ircstats{'TotalTime'} ||= 0;
624 $ircstats{'OffTime'} ||= 0;
626 my $count = $ircstats{'ConnectCount'};
627 my $format_time = &Time2String(time() - $ircstats{'ConnectTime'});
628 my $total_time = time() - $ircstats{'ConnectTime'} +
629 $ircstats{'TotalTime'};
632 my $connectivity = 100 * ($total_time - $ircstats{'OffTime'}) /
634 my $p = sprintf("%.03f", $connectivity);
635 $p =~ s/(\.\d*)0+$/$1/;
636 if ($p =~ s/\.0$//) {
637 # this should not happen... but why...
642 if ($total_time != (time() - $ircstats{'ConnectTime'}) ) {
643 my $tt_format = &Time2String($total_time);
644 &DEBUG("tt_format => $tt_format");
648 if ($count == 1) { # good.
649 $reply = "I'm connected to $ircstats{'Server'} and have been so".
652 $reply = "Currently I'm hooked up to $ircstats{'Server'} but only".
653 " for $format_time. ".
654 "I had to reconnect \002$count\002 times.".
655 " Connectivity: $p %";
659 my $reason = $ircstats{'DisconnectReason'};
660 if (defined $reason) {
661 $reply .= ". I was last disconnected for '$reason'.";
664 &performStrictReply($reply);
670 if ($message =~ /^statu?s$/i) {
671 my $startString = scalar(gmtime $^T);
672 my $upString = &Time2String(time() - $^T);
673 my ($puser,$psystem,$cuser,$csystem) = times;
674 my $factoids = &countKeys("factoids");
676 foreach (keys %forked) {
677 $forks += scalar keys %{ $forked{$_} };
680 $count{'Commands'} = 0;
681 foreach (keys %cmdstats) {
682 $count{'Commands'} += $cmdstats{$_};
686 "Since $startString, there have been".
687 " \002$count{'Update'}\002 ".
688 &fixPlural("modification", $count{'Update'}).
689 ", \002$count{'Question'}\002 ".
690 &fixPlural("question",$count{'Question'}).
691 ", \002$count{'Dunno'}\002 ".
692 &fixPlural("dunno",$count{'Dunno'}).
693 ", \002$count{'Moron'}\002 ".
694 &fixPlural("moron",$count{'Moron'}).
695 " and \002$count{'Commands'}\002 ".
696 &fixPlural("command",$count{'Commands'}).
697 ". I have been awake for $upString this session, and ".
698 "currently reference \002$factoids\002 factoids. ".
699 "I'm using about \002$memusage\002 ".
700 "kB of memory. With \002$forks\002 active ".
701 &fixPlural("fork",$forks).
702 ". Process time user/system $puser/$psystem child $cuser/$csystem"
709 # FIXME does not try to get nick "back", just switches nicks
710 if ($message =~ /^wantNick\s(.*)?$/i) {
711 return unless (&hasFlag("o"));
712 my $wantnick = lc $1;
713 my $mynick = $conn->nick();
715 if ($mynick eq $wantnick) {
716 &msg($who, "I hope you're right. I'll try anyway (mynick=$mynick, wantnick=$wantnick).");
719 # fallback check, I guess. needed?
720 if (! &IsNickInAnyChan( $wantnick ) ) {
721 my $str = "attempting to change nick from $mynick to $wantnick";
728 # idea from dondelecarlo :)
729 # TODO: use cache{nickserv}
730 if ($param{'nickServ_pass'}) {
731 my $str = "someone is using nick $wantnick; GHOSTing";
734 &msg("NickServ", "GHOST $wantnick $param{'nickServ_pass'}");
736 $conn->schedule(5, sub {
737 &status("going to change nick from $mynick to $wantnick after GHOST.");