X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FUserExtra.pl;h=24134088410f3f221e10b9e35f3be5dd9ba865f8;hb=b0ed64e5f19d957102c6e73fc79b06801c1a4ecc;hp=be48b367b41568bc9382e934588710bf272569fb;hpb=79ddec2f34e07300f6fdb0803b56746b8399c0f4;p=infobot.git diff --git a/src/UserExtra.pl b/src/UserExtra.pl index be48b36..2413408 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -5,10 +5,11 @@ # Created: 20000107 # -if (&IsParam("useStrict")) { use strict; } - -use vars qw($message $arg $qWord $verb $lobotomized); -use vars qw(%channels %chanstats %cmdstats); +use strict; +use vars qw($message $arg $qWord $verb $lobotomized $who $result $chan + $conn $msgType $query $talkchannel $ident $memusage); +use vars qw(%channels %chanstats %cmdstats %count %ircstats %param + %cache %mask %userstats %hooks_main); ### ### Start of command hooks for UserExtra. @@ -19,7 +20,7 @@ use vars qw(%channels %chanstats %cmdstats); &addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo', 'Cmdstats' => 'Factoid Info', Module => 'factoids', ) ); &addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats', - 'Cmdstats' => 'Factoid Statistics', Help => "factstats", + 'Cmdstats' => 'Factoid Stats', Help => "factstats", Forker => 1, 'Identifier' => 'factoids', ) ); &addCmdHook("main", 'help', ('CODEREF' => 'help', 'Cmdstats' => 'Help', ) ); @@ -33,7 +34,10 @@ use vars qw(%channels %chanstats %cmdstats); Help => 'tell', Identifier => 'allowTelling', Cmdstats => 'Tell') ); &addCmdHook("main", 'news', ('CODEREF' => 'News::Parse', - Module => 'news', Identifier => 'news') ); + Module => 'news', 'Cmdstats' => 'News' ) ); +&addCmdHook("main", 'countrystats', ('CODEREF' => 'countryStats', +# Forker => "NULL", + ) ); &status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks."); @@ -59,13 +63,13 @@ sub chaninfo { &ircCheck(); next; } - push(@array, "$_ (".scalar(keys %{$channels{$_}{''}}).")"); + push(@array, "$_ (".scalar(keys %{ $channels{$_}{''} }).")"); } &pSReply($reply.": ".join(' ', @array)); ### total user count. foreach $chan (keys %channels) { - $tucount += scalar(keys %{$channels{$chan}{''}}); + $tucount += scalar(keys %{ $channels{$chan}{''} }); } ### unique user count. @@ -102,7 +106,7 @@ sub chaninfo { # Step 1: my @array; - foreach (sort keys %{$chanstats{$chan}}) { + foreach (sort keys %{ $chanstats{$chan} }) { my $int = $chanstats{$chan}{$_}; next unless ($int); @@ -122,7 +126,7 @@ sub chaninfo { - $chanstats{$chan}{'Part'}; if ($delta_stats) { - my $total = scalar(keys %{$channels{$chan}{''}}); + my $total = scalar(keys %{ $channels{$chan}{''} }); &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."); if ($delta_stats > $total) { @@ -134,7 +138,7 @@ sub chaninfo { undef @array; my $type; foreach ("v","o","") { - my $int = scalar(keys %{$channels{$chan}{$_}}); + my $int = scalar(keys %{ $channels{$chan}{$_} }); next unless ($int); $type = "Voice" if ($_ eq "v"); @@ -146,11 +150,21 @@ sub chaninfo { $reply .= ". At the moment, ". &IJoin(@array); # Step 3: - ### TODO: what's wrong with the following? - my %new = map { $userstats{$_}{'Count'} => $_ } keys %userstats; - my($count) = (sort { $b <=> $a } keys %new)[0]; + my %new; + foreach (keys %userstats) { + next unless (exists $userstats{$_}{'Count'}); + if ($userstats{$_}{'Count'} =~ /^\D+$/) { + &WARN("userstats{$_}{Count} is non-digit."); + next; + } + + $new{$_} = $userstats{$_}{'Count'}; + } + + # todo: show top 3 with percentages? + my($count) = (sort { $new{$a} <=> $new{$b} } keys %new)[0]; if ($count) { - $reply .= ". \002$new{$count}\002 has said the most with a total of \002$count\002 messages"; + $reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages"; } &pSReply("$reply."); } @@ -166,14 +180,14 @@ sub cmdstats { my %countstats; foreach (keys %cmdstats) { - $countstats{$cmdstats{$_}}{$_} = 1; + $countstats{ $cmdstats{$_} }{$_} = 1; } foreach (sort {$b <=> $a} keys %countstats) { my $int = $_; next unless ($int); - foreach (keys %{$countstats{$int}}) { + foreach (keys %{ $countstats{$int} }) { push(@array, "\002$int\002 of $_"); } } @@ -207,7 +221,8 @@ sub factstats { sub karma { my $target = lc( shift || $who ); - my $karma = &dbGet("karma", "nick",$target,"karma") || 0; + my $karma = &dbGet("stats", "counter", "nick=". + &dbQuote($target)." AND type='karma'") || 0; if ($karma != 0) { &pSReply("$target has karma of $karma"); @@ -219,7 +234,7 @@ sub karma { sub ispell { my $query = shift; - if (! -x "/usr/bin/spell") { + if (! -x "/usr/bin/ispell") { &msg($who, "no binary found."); return; } @@ -249,6 +264,9 @@ sub ispell { } elsif (/^\+/) { &DEBUG("spell: '+' found => '$_'."); last; + } elsif (/^# (.*?) 0$/) { + # none found. + last; } else { &DEBUG("spell: unknown: '$_'."); } @@ -275,7 +293,7 @@ sub tell { # this one catches most of them if ($args =~ /^(\S+) (-?)about (.*)$/i) { - $target = lc $1; + $target = $1; $tell_obj = $3; $dont_tell_me = ($2) ? 1 : 0; @@ -283,19 +301,19 @@ sub tell { $query = $tell_obj; } elsif ($args =~ /^(\S+) where (\S+) can (\S+) (.*)$/i) { # i'm sure this could all be nicely collapsed - $target = lc $1; + $target = $1; $tell_obj = $4; $query = $tell_obj; } elsif ($args =~ /^(\S+) (what|where) (.*?) (is|are)[.?!]*$/i) { - $target = lc $1; + $target = $1; $qWord = $2; $tell_obj = $3; $verb = $4; $query = "$qWord $verb $tell_obj"; } elsif ($args =~ /^(.*?) to (\S+)$/i) { - $target = lc $3; + $target = $3; $tell_obj = $2; $query = $tell_obj; } @@ -312,15 +330,13 @@ sub tell { &status("tell: target = $target, query = $query"); # "intrusive". - if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { - &msg($who, "No, $target is not in any of my chans."); - return; - } - - ### TODO: don't "tell" if sender is not in target's channel. +# if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { +# &msg($who, "No, $target is not in any of my chans."); +# return; +# } # self. - if ($target eq $ident) { # lc? + if ($target =~ /^\Q$ident\E$/i) { &msg($who, "Isn't that a bit silly?"); return; } @@ -333,7 +349,7 @@ sub tell { $who = $oldwho; # no such factoid. - if ($result =~ /^0?$/) { + if (!defined $result || $result =~ /^0?$/) { $who = $target; $msgType = "private"; @@ -345,7 +361,7 @@ sub tell { $message = $tell_obj; $done++ unless (&Modules()); - &DEBUG("setting old values of who and msgType."); + &VERB("tell: setting old values of who and msgType.",2); $who = $oldwho; $msgType = $oldmtype; @@ -379,10 +395,17 @@ sub DNS { my $dns = shift; my($match, $x, $y, $result); my $pid; + $dns =~ s/^\s+|\s+$//g; + + if (!defined $dns or $dns =~ /^\s*$/ or $dns =~ / /) { + &help("dns"); + return; + } if ($dns =~ /(\d+\.\d+\.\d+\.\d+)/) { - &status("DNS query by IP address: $in"); $match = $1; + &status("DNS query by IP address: $match"); + $y = pack('C4', split(/\./, $match)); $x = (gethostbyaddr($y, &AF_INET)); @@ -391,12 +414,14 @@ sub DNS { } else { $result = "I can't seem to find that address in DNS"; } + } else { - &status("DNS query by name: $in"); - $x = join('.',unpack('C4',(gethostbyname($in))[4])); + + &status("DNS query by name: $dns"); + $x = join('.',unpack('C4',(gethostbyname($dns))[4])); if ($x !~ /^\s*$/) { - $result = $in." is ".$x; + $result = $dns." is ".$x; } else { $result = "I can\'t find that machine name"; } @@ -405,6 +430,66 @@ sub DNS { &performReply($result); } +sub countryStats { + if (exists $cache{countryStats}) { + &msg($who,"countrystats is already running!"); + return; + } + + if ($chan eq "") { + $chan = $_[0]; + } + + if ($chan eq "") { + &help("countrystats"); + return; + } + + $conn->who($chan); + $cache{countryStats}{chan} = $chan; + $cache{countryStats}{mtype} = $msgType; + $cache{countryStats}{who} = $who; + $cache{on_who_Hack} = 1; +} + +sub do_countrystats { + $chan = $cache{countryStats}{chan}; + $msgType = $cache{countryStats}{mtype}; + $who = $cache{countryStats}{who}; + + my $total = 0; + my %cstats; + foreach (keys %{ $cache{nuhInfo} }) { + my $h = $cache{nuhInfo}{$_}{Host}; + + if ($h =~ /^.*\.(\D+)$/) { # host + $cstats{$1}++; + } else { # ip + $cstats{unresolve}++; + } + $total++; + } + my %count; + foreach (keys %cstats) { + $count{ $cstats{$_} }{$_} = 1; + } + + my @list; + foreach (sort {$b <=> $a} keys %count) { + my $str = join(", ", sort keys %{ $count{$_} }); +# push(@list, "$str ($_)"); + my $perc = sprintf("%.01f", 100 * $_ / $total); + $perc =~ s/\.0+$//; + push(@list, "$str ($_, $perc %)"); + } + + # todo: move this into a scheduler like nickometer + $msgType = "private"; + &pSReply( &formListReply(0, "Country Stats ", @list) ); + + delete $cache{countryStats}; + delete $cache{on_who_Hack}; +} ### ### amalgamated commands. @@ -413,7 +498,10 @@ sub DNS { sub userCommands { # conversion: ascii. if ($message =~ /^(asci*|chr) (\d+)$/) { - return unless (&IsParam("allowConv")); + &DEBUG("ascii/chr called ..."); + return unless (&hasParam("allowConv")); + + &DEBUG("ascii/chr called"); $arg = $2; $result = chr($arg); @@ -425,10 +513,16 @@ sub userCommands { } # conversion: ord. - if ($message =~ /^ord (.)$/) { - return unless (&IsParam("allowConv")); + if ($message =~ /^ord(\s+(.*))$/) { + return unless (&hasParam("allowConv")); + + $arg = $2; + + if (!defined $arg or length $arg != 1) { + &help("ord"); + return; + } - $arg = $1; if (ord($arg) < 32) { $arg = chr(ord($arg) + 64); if ($arg eq chr(64)) { @@ -444,7 +538,7 @@ sub userCommands { # hex. if ($message =~ /^hex(\s+(.*))?$/i) { - return unless (&IsParam("allowConv")); + return unless (&hasParam("allowConv")); my $arg = $2; if (!defined $arg) { @@ -519,6 +613,17 @@ sub userCommands { return; } + # reload. + if ($message =~ /^reload$/i) { + return unless (&hasFlag("n")); + + &status("USER reload $who"); + &pSReply("reloading..."); + &reloadAllModules(); + &pSReply("reloaded."); + return; + } + # redir. if ($message =~ /^redir(\s+(.*))?/i) { return unless (&hasFlag("o")); @@ -602,21 +707,35 @@ sub userCommands { # utime(13) + stime(14). my $cpu_usage = sprintf("%.01f", ($data[13]+$data[14]) / 100 ); + # cutime(15) + cstime (16). + my $cpu_usage2 = sprintf("%.01f", ($data[15]+$data[16]) / 100 ); my $time = time() - $^T; my $raw_perc = $cpu_usage*100/$time; + my $raw_perc2 = $cpu_usage2*100/$time; my $perc; + my $perc2; + my $total; + my $ratio; if ($raw_perc > 1) { $perc = sprintf("%.01f", $raw_perc); + $perc2 = sprintf("%.01f", $raw_perc2); + $total = sprintf("%.01f", $raw_perc+$raw_perc2); } elsif ($raw_perc > 0.1) { $perc = sprintf("%.02f", $raw_perc); + $perc2 = sprintf("%.02f", $raw_perc2); + $total = sprintf("%.02f", $raw_perc+$raw_perc2); } else { # <=0.1 $perc = sprintf("%.03f", $raw_perc); + $perc2 = sprintf("%.03f", $raw_perc2); + $total = sprintf("%.03f", $raw_perc+$raw_perc2); } + $ratio = sprintf("%.01f", 100*$perc/($perc+$perc2) ); - &pSReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc %"); - &DEBUG("15 => $data[15] (cutime)"); - &DEBUG("16 => $data[16] (cstime)"); + &pSReply("Total CPU usage: \002$cpu_usage\002 s ... ". + "Total used: \002$total\002 % ". + "(parent/child ratio: $ratio %)" + ); return; } @@ -634,16 +753,14 @@ sub userCommands { my $connectivity = 100 * ($total_time - $ircstats{'OffTime'}) / $total_time; - my $p = sprintf("%.02f", $connectivity); + my $p = sprintf("%.03f", $connectivity); $p =~ s/(\.\d*)0+$/$1/; if ($p =~ s/\.0$//) { - &DEBUG("p sar not working properly :("); + # this should not happen... but why... } else { $p =~ s/\.$// } - &DEBUG("connectivity => $p %"); - if ($total_time != (time() - $ircstats{'ConnectTime'}) ) { my $tt_format = &Time2String($total_time); &DEBUG("tt_format => $tt_format"); @@ -656,13 +773,14 @@ sub userCommands { } else { $reply = "Currently I'm hooked up to $ircstats{'Server'} but only". " for $format_time. ". - "I had to reconnect \002$count\002 times."; + "I had to reconnect \002$count\002 times.". + " Connectivity: $p %"; } ### REASON. my $reason = $ircstats{'DisconnectReason'}; if (defined $reason) { - $reply .= " I was last disconnected for '$reason'."; + $reply .= ". I was last disconnected for '$reason'."; } &pSReply($reply); @@ -672,10 +790,15 @@ sub userCommands { # status. if ($message =~ /^statu?s$/i) { - my $startString = scalar(localtime $^T); + my $startString = scalar(gmtime $^T); my $upString = &Time2String(time() - $^T); my $count = &countKeys("factoids"); + $count{'Commands'} = 0; + foreach (keys %cmdstats) { + $count{'Commands'} += $cmdstats{$_}; + } + &pSReply( "Since $startString, there have been". " \002$count{'Update'}\002 ". @@ -686,12 +809,29 @@ sub userCommands { &fixPlural("dunno",$count{'Dunno'}). " and \002$count{'Moron'}\002 ". &fixPlural("moron",$count{'Moron'}). + " and \002$count{'Commands'}\002 ". + &fixPlural("command",$count{'Commands'}). ". I have been awake for $upString this session, and ". "currently reference \002$count\002 factoids. ". "I'm using about \002$memusage\002 ". "kB of memory." ); + # todo: use dbGetColNiceHash(). + my %hash = &dbGetCol("stats", "nick,counter", "type='cmdstats'". +# " ORDER BY counter DESC LIMIT 3", 1); + " ORDER BY counter DESC", 1); + +if (0) { + foreach (keys %hash) { + my $i = $_; + foreach (keys %{ $hash{$i} }) { + &DEBUG("cmdstats: $hash{$i}{$_} = $_"); + } + } + &DEBUG("end of cmdstats."); +} + return; } @@ -700,6 +840,8 @@ sub userCommands { if ($param{'ircNick'} eq $ident) { &msg($who, "I hope you're right. I'll try anyway."); } + &DEBUG("ircNick => $param{'ircNick'}"); + &DEBUG("ident => $ident"); if (! &IsNickInAnyChan( $param{ircNick} ) ) { my $str = "attempting to change nick to $param{'ircNick'}"; @@ -707,8 +849,9 @@ sub userCommands { &msg($who, $str); &nick($param{'ircNick'}); } else { - &msg($who, "hrm... can't do it"); + &msg($who, "hrm.. I shouldn't do it (BUG?) but doing it anyway!"); &DEBUG("wN: nick is somewhere... should try later."); + &nick($param{'ircNick'}); } return;